MACRO_NAME =	"BillOfMaterial"
MACRO_VERS =	"V0.5"

'VER:	0.5 FIXED BUG FOR ASSEMBLIES PARA: PARTS AND ASSEMBLIES PARAMETERS ARE ACCESSED DIFFERENTLY
'		0.4 CLEANED CODE BASED ON INPUT XLS
'		0.3 IMPLEMENTS THE REQUEST TO EXTRACT THE USER PARAMETERS ON THE ASSEMBLIES
'		0.2 IMPLEMENTS THE REQUEST TO COUNT ALSO ASSEMBLIES AND ONLY PRINT THEM ONCE
'DESC:	SCANS THE SPEC TREE OF OPENED DOCUMENT AND GENERATES A BOM INCLUDING USER DEFINED PARAMETERS
'PREP:	OPEN DOCUMENT MUST BE OF TYPE CATPRODUCT
'LANG:	CATSCRIPT
'DATE:	29/09/2013

'CREA: dean.broughall@p3voith.com
'-------------------------------------------

dim objXL As Object
dim sPath As String 
sPath = "C:\Users\" & CATIA.SystemService.Environ("USERNAME") & "\Desktop\Stueckliste_Vorlage.xlt"
CONST xlsStartRow As Integer = 11

'----------------------------------------
Sub CATMain()
	setUpExcel
	CATIA.ActiveDocument.Product.ApplyWorkMode DESIGN_MODE
	' product,  excelRow, instalLvl, assyCount
	TreeWalk CATIA.ActiveDocument.Product, xlsStartRow , 0, 1 
	END_MESSAGE
End Sub
'----------------------------------------

'----------------------------------------
Sub setUpExcel()
	dim inString As String
	
	'Exel Öffnen
	Set objXL = CreateObject("Excel.Application")
	objXL.Workbooks.Open(sPath)
	objXL.Visible = True
	
	'Eingabeaufforderungen für den Schriftkopf
	'angabe 1 von 8
		objXL.Cells(6,4).Value = CATIA.SystemService.Environ("USERNAME")
	'angabe 2 von 8
		objXL.Cells(7,4).Value = CStr(Date)
	'angabe 3 von 8
		inString = InputBox ("Bitte geben Sie Auftragsnummer ein.", "Eingabe: Auftragsnummer", "XXXXXXXX-Y-CC")
		objXL.Cells(4,6).Value = inString
		objXL.Cells(6,6).Value = inString
		objXL.Cells(5,11).Value = inString
	'angabe 4 von 8
		objXL.Cells(5,6).Value = CATIA.ActiveDocument.Product.Nomenclature
	'angabe 5 von 8
		objXL.Cells(6,9).Value = InputBox ("Bitte geben Sie den Kunden ein.", "Eingabe: Kunde", "Kunde")
	'angabe 6 von 8
		objXL.Cells(7,9).Value = CATIA.ActiveDocument.Product.PartNumber
	'angabe 7 von 8
		objXL.Cells(7,6).Value = InputBox ("Bitte geben Sie den Gerätetyp ein.", "Eingabe: Gerätetyp", "Gerätetyp")
	'angabe 8 von 8
		objXL.Cells(4,11).Value = InputBox ("Bitte geben Sie den Kostenträgere ein.", "Eingabe: Kostenträger", "Kostenträger")
End Sub
'----------------------------------------

'----------------------------------------
Sub WriteToExcel(byVal prod As product, byVal excelRow As Integer, byVal quantity As Integer, byVal instalLvl as Integer, byVal passedType As String)
	Dim sDurchmesser As String
	Dim sLaenge As String
	Dim sBreite As String
	Dim sHoehe As String
	
	objXL.Cells(excelRow,1).Value = instalLvl
	objXL.Cells(excelRow,3).Value = quantity
	objXL.Cells(excelRow,4).Value = prod.PartNumber

	'Fehlerbehandlung abschalten
    On Error Resume Next
	Select Case passedType
		case "Product"
			objXL.Cells(excelRow,2).Value = prod.Parameters.RootParameterSet.DirectParameters.Item("Pos_Nr.").ValueAsString
			objXL.Cells(excelRow,8).Value = prod.Parameters.RootParameterSet.DirectParameters.Item("DIN EN ISO").ValueAsString
			objXL.Cells(excelRow,10).Value = prod.Parameters.RootParameterSet.DirectParameters.Item("Produktart").ValueAsString
		case "Part"
			'collect dimension parameters
			sDurchmesser=  	prod.Parameters.Item("Durchmesser").ValueAsString
			sLaenge =  		prod.Parameters.Item("Laenge").ValueAsString
			sBreite =  		prod.Parameters.Item("Breite").ValueAsString
			sHoehe = 		prod.Parameters.Item("Hoehe").ValueAsString
			'Parameter auslesen und in Excel eintragen
			objXL.Cells(excelRow,2).Value = prod.Parameters.Item("Pos_Nr.").ValueAsString
			objXL.Cells(excelRow,7).Value = prod.Parameters.Item("Material").ValueAsString
			objXL.Cells(excelRow,9).Value = "d" & sDurchmesser & "x" & sLaenge  & "x" & sBreite  & "x" & sHoehe
			objXL.Cells(excelRow,8).Value = prod.Parameters.Item("DIN EN ISO").ValueAsString
			objXL.Cells(excelRow,10).Value = prod.Parameters.Item("Produktart").ValueAsString
			objXL.Cells(excelRow,11).Value = prod.Parameters.Item("Masse").ValueAsString
	End Select
    'Fehlerbehandlung einschalten
    On Error GoTo 0
	
End Sub
'----------------------------------------

'----------------------------------------
Sub treewalk(byVal oProd As Product, byref excelRow As integer, byref instalLvl as Integer, byVal assyCount As Integer)
	dim oChild as Product
	dim oDict1 as Object
	dim oDict2 as Object
	Set oDict1 = CreateObject("Scripting.Dictionary") 'keeps item quantity
	Set oDict2 = CreateObject("Scripting.Dictionary") 'keeps part item print state
	
	dim oDict3 as Object
	Set oDict3 = CreateObject("Scripting.Dictionary") 'keeps part item print state of prod

	' gets components count
	for each oChildCount in oProd.Products
		if oDict1.Exists(oChildCount.PartNumber) then
			oDict1.Item(oChildCount.PartNumber) = oDict1.Item(oChildCount.PartNumber) +1
		else
			oDict1.Add(oChildCount.PartNumber), 1
		End If
	Next

	' write the parameters of the assembly to excel
	WriteToExcel oProd, excelRow, assyCount, instalLvl, "Product"
	objXL.Cells(excelRow,4).Font.Bold = True
	
	' loop through all children and wrtie to excel
	for each oChild in oProd.Products
		excelRow = excelRow + 1
		if oChild.Products.Count > 0 then
			'product has children
			if oDict3.Exists(oChild.PartNumber) = false then 
				oDict3.Add(oChild.PartNumber), "printed"
				TreeWalk oChild, excelRow, instalLvl +1, oDict1.Item(oChild.PartNumber)
			else
				excelRow = excelRow - 1
			end if
		else
			if oDict2.Exists(oChild.PartNumber) then
				excelRow = excelRow - 1
			else
				oDict2.Add(oChild.PartNumber), true
				WriteToExcel oChild, excelRow, oDict1.Item(oChild.PartNumber), instalLvl +1, "Part"
			end if
		end if
	next
End Sub
'----------------------------------------

'----------------------------------------
sub END_MESSAGE()
	MSGBOX MACRO_NAME & " " & MACRO_VERS & " finished." _ 
	& CHR(10) & "Please check results"	& CHR(10) & _
	"-----------------------------------" & CHR(10) & _
	"-----------------------------------" & CHR(10) & _
	"macro written by:" & CHR(10) & _
	"dean.broughall@p3voith.com" , vbyes, MACRO_NAME & " " & MACRO_VERS
end sub
'----------------------------------------