Language="VBSCRIPT"

public DokAnzahl
public strPartNumberArray()
public DoppelteRausArray()
public Fehler As Sting
'----------------------------------------

'----------------------------------------
Sub CATMain()
	'Fehlerbehandlung / Abfrage des aktiven Dokuments
		If CATIA.Windows.Count = 0 Then
			Box = MsgBox("Es wurde kein aktives Dokument identifiziert!!!"  & vbLF & _
									"---------------------------------------------------------"   & vbLF & _
									"Bitte öffnen Sie zuerst ein Dokument und starten Sie"  & vbLF & _
									"dann BOM_Check erneut.", 16, "Termination")
    			Exit Sub
		End If

		Set oDoc = CATIA.ActiveDocument

		If TypeName(oDoc) <> "ProductDocument" Then
			Box = MsgBox("Es wurde kein aktives Product identifiziert!!!" & vbLF & _
									"---------------------------------------------------------"  & vbLF & _
									"BOM_Check wurde abgebrochen.", 16, "Termination")
			Exit Sub
		End If

	CatiaBaumInArray
	DoppeltArrayRaus
	ArrayUntersuchUndInTxtDatei
End Sub
'----------------------------------------

'----------------------------------------
Sub CatiaBaumInArray()
	EingabeSuchMode = 1
		Call GetElements(EingabeSuchMode)  '1 = Parts und Products; 2 = nur Parts; 3 = nur Products
End Sub

'----------------------------------------

'----------------------------------------
Sub GetElements(SearchMode)
	' Eingabewerte: 1 = Parts und Products; 2 = nur Parts; 3 = nur Products
		If SearchMode = 1 Then SuchString = "Type=Product,all"
		If SearchMode = 2 Then SuchString = "(CATProductSearch.Part),all"
		If SearchMode = 3 Then SuchString = "(CATProductSearch.Assembly),all"

	Set Selection1 = CATIA.ActiveDocument.Selection
		Selection1.Search SuchString
		DokAnzahl = Selection1.Count

	For n = 1 To DokAnzahl
		On Error Resume Next
			sPartNumber = Selection1.Item(n).Value.ReferenceProduct.Name 'PartNumber
			'DateiName = Selection1.Item(n).Value.ReferenceProduct.Parent.Name
			'DateiPfad = Selection1.Item(n).Value.ReferenceProduct.Parent.Fullname
			ReDim Preserve strPartNumberArray(n)
			strPartNumberArray(n) = sPartNumber
	Next
		Selection1.Clear
End Sub

'----------------------------------------

'----------------------------------------
Sub DoppeltArrayRaus()
	'Doppelte Elemente aus der Array entfernen
		For Count1 = 1 To UBound(strPartNumberArray)
			Varic = strPartNumberArray(Count1)

		If InStr(VariN, Varic) > 0 Then
		Else
				VariN = CStr(VariN) & "," & CStr(Varic)
				VariNAnz = VariNAnz + 1
		If Left(VariN, 1) = "," Then
				VariN = Right(VariN, Len(VariN) - 1)
			End If
		End If
	Next

		ReDim Preserve DoppelteRausArray(VariNAnz - 1)

		For Count2 = 0 To VariNAnz - 1
			If InStr(VariN, ",") > 0 Then
			DoppelteRausArray(Count2) = Left(VariN, InStr(VariN, ",") - 1)
			VariN = Right(VariN, Len(VariN) - InStr(VariN, ","))
		Else
			DoppelteRausArray(Count2) = VariN
		End If
	Next
End Sub

'----------------------------------------

'----------------------------------------
Sub ArrayUntersuchUndInTxtDatei()
	'Elemente untersuchen und die mit Fehlern in .txt-Datei schreiben
				Counter = 0
		For i = LBound(DoppelteRausArray) to UBound(DoppelteRausArray)
				Error = 0

			Check01 = Mid(DoppelteRausArray(i), 9, 1)="-" AND _
							 Mid(DoppelteRausArray(i), 11, 1)="-" AND _
							 Mid(DoppelteRausArray(i), 14, 1)="_" AND _
							 Mid(DoppelteRausArray(i), 17, 1)="_" AND _
							 Mid(DoppelteRausArray(i), 22, 1)="_"

			Check02 = Mid(DoppelteRausArray(i), 9, 1)="-" AND _
							 Mid(DoppelteRausArray(i), 11, 1)="-" AND _
							 Mid(DoppelteRausArray(i), 14, 4)="____" AND _
							 Mid(DoppelteRausArray(i), 17, 1)="_" AND _
							 Mid(DoppelteRausArray(i), 22, 1)="_"

			If Check01 = True OR Check02 = True Then
				DoppelteRausArray(i) = DoppelteRausArray(i-1)
			End If
			If Check01 = False OR Check02 = False Then
				Error = 1
				Counter = Counter + 1
			End If
		Next

		If Error <> 0 Then
			strPath = CATIA.ActiveDocument.Path
			sFileName = strPath & "\ErrorLog" & ".txt"
				Set oFSO = CreateObject("Scripting.FileSystemObject")
				Set oFile = oFSO.CreateTextFile(sFileName, True)

	'Schriftkopf erstellen
				oDocName = CATIA.ActiveDocument.Product.PartNumber
			oFile.WriteBlankLines 1
			oFile.WriteLine "==============================================================ErrorLog======================================================================="
			oFile.WriteLine "    Projekt:   " & oDocName
			oFile.WriteLine "      Datum:   " & CStr(Date)
			oFile.WriteLine "    Uhrzeit:   " & CStr(Time)
			oFile.WriteLine "  Ersteller:   " & CATIA.SystemService.Environ("USERNAME")
			oFile.WriteLine "============================================================================================================================================="
			oFile.WriteBlankLines 2
			oFile.WriteLine "============================================================================================================================================="
			oFile.WriteLine "= Folgende Fehler sind in der Struktur enthalten:                       					                            = "
			oFile.WriteLine "============================================================================================================================================="
			oFile.WriteBlankLines 1
End If

		For i = LBound(DoppelteRausArray) to UBound(DoppelteRausArray)
			oFile.WriteLine "  ***  " & DoppelteRausArray(i)
		Next

		If Error <> 0 Then
			Box = MsgBox("Es befinden sich " & Counter & " Bennungsfehler in der Konstruktion." & vbLF & _
				     "Korrigieren Sie die Benennungen nach den OEM-Richtlinien."  & vbLF & _
				     "----------------------------------------------------------------"  & vbLF & _
				     "Das ErrorLog befindet sich im Projektverzeichnis.", 48, "Warning")
		Else
			Box = MsgBox("Die Benennungen in der Konstruktion enthalten keine Fehler.", 64, "Note")
		End If

End Sub
'----------------------------------------