' ****************************************************************************************************
' *	Author:				Shoutz000						     *
' * 	Built:				11.08.2015						     *
' * 	Last Modifikation:		20.09.2015						     *
' *     Macro:				04_BOM_Check		      			             *	
' * 	Version:			V-1.08							     *
' * 	Icon:				I_04_bBOM_Check						     *
' * 	Based of:			CAD.de							     *
' * 												     *
' * 												     *
' ****************************************************************************************************
'
' Beschreibung:		Das Makro prüft die Benennungen einer Konstruktion auf die Übereinstimmung
'			mit den Konstruktionsrichtlinien. Sollten Fehler enthalten sein, so werden diese
'			in eine txt-Datei geschrieben und im Projektverzeichnis gespeichert.
'
'			>>>	Bei Unklarheiten an die Konstruktionsleitung oder den Author wenden.
'
' ****************************************************************************************************

CATIA.StatusBar = "04_BOM_Check , Version 1.08"

Language="VBSCRIPT"

public DocQu
public strPartNumberArray()
public DoubleDell()
'----------------------------------------

'----------------------------------------
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 04_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 & _
					"04_BOM_Check wurde abgebrochen.", 16, "Termination")
			Exit Sub
		End If

	CatiaTreeInArray
	DoubleDellArray
	ArrayCheckAndToTXT(oDoc)
End Sub

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

'----------------------------------------
Sub CatiaTreeInArray()
	InputSearchMode = 1
		Call GetElements(InputSearchMode)  '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 oSel = CATIA.ActiveDocument.Selection
		oSel.Search SuchString
		DocQu = oSel.Count

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

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

'----------------------------------------
Sub DoubleDellArray()
	'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 DoubleDell(VariNAnz - 1)

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

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

'----------------------------------------
Sub ArrayCheckAndToTXT(ByVal oDoc As Document)
	'Elemente untersuchen und die mit Fehlern in .txt-Datei schreiben
				Counter = 0
				n = 0

		For i = LBound(DoubleDell) to UBound(DoubleDell)

		'Check Baugruppe / Schweißteil / Einzelteil / Kaufteil / Normteil
			Check01 = Mid(DoubleDell(i), 9, 1)="-" AND _
				  Mid(DoubleDell(i), 11, 1)="-" AND _
				  Mid(DoubleDell(i), 14, 4)="_ZB_" OR _
				  Mid(DoubleDell(i), 14, 4)="_BG_" OR _
				  Mid(DoubleDell(i), 14, 4)="_AM_" OR _
				  Mid(DoubleDell(i), 14, 4)="_SG_" OR _
				  Mid(DoubleDell(i), 14, 4)="_WP_" OR _
				  Mid(DoubleDell(i), 14, 4)="_ET_" OR _
				  Mid(DoubleDell(i), 14, 4)="_SP_" OR _
				  Mid(DoubleDell(i), 14, 4)="_KT_" OR _
				  Mid(DoubleDell(i), 14, 4)="_PP_" OR _
				  Mid(DoubleDell(i), 14, 4)="_NT_" OR _
				  Mid(DoubleDell(i), 14, 4)="_NP_" AND _
				  Mid(DoubleDell(i), 22, 1)="_" AND _
				  Mid(DoubleDell(i), 23, 1)<>"_" AND _
				  Len(DoubleDell(i))<=70

		'Check Einzelteil Schweißteil
			Check02 = Mid(DoubleDell(i), 9, 1)="-" AND _
				  Mid(DoubleDell(i), 11, 1)="-" AND _
				  Mid(DoubleDell(i), 14, 4)="_ET_" OR _
				  Mid(DoubleDell(i), 14, 4)="_SP_" AND _
				  Mid(DoubleDell(i), 22, 1)="_" AND _
				  Mid(DoubleDell(i), 27, 1)="_" AND _
				  Mid(DoubleDell(i), 28, 1)<>"_" AND _
				  Len(DoubleDell(i))<=70

		'Check Adapter
			Check03 = Mid(DoubleDell(i), 9, 1)="-" AND _
				  Mid(DoubleDell(i), 11, 1)="-" AND _
				  Mid(DoubleDell(i), 14, 4)="____" AND _
				  Mid(DoubleDell(i), 22, 1)="_" AND _
				  Mid(DoubleDell(i), 23, 1)<>"_" AND _
				  Len(DoubleDell(i))<=70

		If Check01 = False AND Check02 = False AND Check03 = False Then
			Counter = Counter + 1

			ReDim Preserve ErrArray(n)
				ErrArray(n) = DoubleDell(i)
				n = n  + 1
		End If
		Next

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

	'Schriftkopf erstellen
			oDocName = oDoc.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.WriteLine "|					    ErrorLog created with 04_BOM_Check Macro V-1.08					            |"
		oFile.WriteLine "============================================================================================================================================="
		oFile.WriteBlankLines 1
		oFile.WriteLine "+-------------------------------------------------------------------------------------------------------------------------------------------+"
		oFile.WriteLine "+-------------------------------------------------------------------------------------------------------------------------------------------+"
		oFile.WriteBlankLines 2
		oFile.WriteLine "============================================================================================================================================="
		oFile.WriteLine "= Folgende Fehler sind in der Struktur enthalten:                       					                            = "
		oFile.WriteLine "============================================================================================================================================="
		oFile.WriteBlankLines 1

			For i = LBound(ErrArray) to UBound(ErrArray)
				oFile.WriteLine "  ***  " & ErrArray(i)
			Next
		End If

		If Counter <> 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
'----------------------------------------