MACRO_NAME =	"BillOfMaterial"
MACRO_VERS =	"V0.4"

'VER:	0.4 FIXED BUG FOR ASSEMBLY PARAMETERS EXTRACTION - CHILD PARTS PARAMETERS ARE PLACED HIGHER IN PARAMETER COLLECTION AND CATIA USES FIRST FOUND VALUE
'		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:	09/09/2013

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


dim objXL As Object
dim oAWBook As Object
dim oDict1 As Object


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

'----------------------------------------
Sub setUpExcel()
	' Exel Öffnen
	Set objXL = CreateObject("Excel.Application")
	objXL.Visible = True
	Set oAWBook = objxl.Workbooks.Add

	'Spaltentitel
	objXL.Cells(1,1).Value = ("EinbaueEbene")
	objXL.Cells(1,2).Value = ("Pos_Nr.")
	objXL.Cells(1,3).Value = ("Menge")
	objXL.Cells(1,4).Value = ("Bezeichnung")
	objXL.Cells(1,5).Value = ("Material")
	objXL.Cells(1,6).Value = ("Masse")
	objXL.Cells(1,7).Value = ("Durchmesser")
	objXL.Cells(1,8).Value = ("Länge")
	objXL.Cells(1,9).Value = ("Breite")
	objXL.Cells(1,10).Value = ("Höhe")
	objXL.Cells(1,11).Value = ("DIN EN ISO")
	objXL.Cells(1,12).Value = ("Produktart")

	'Spaltentitel_Bold
	objXL.Cells(1,1).Font.Bold = True
	objXL.Cells(1,2).Font.Bold = True
	objXL.Cells(1,3).Font.Bold = True
	objXL.Cells(1,4).Font.Bold = True
	objXL.Cells(1,5).Font.Bold = True
	objXL.Cells(1,6).Font.Bold = True
	objXL.Cells(1,7).Font.Bold = True
	objXL.Cells(1,8).Font.Bold = True
	objXL.Cells(1,9).Font.Bold = True
	objXL.Cells(1,10).Font.Bold = True
	objXL.Cells(1,11).Font.Bold = True
	objXL.Cells(1,12).Font.Bold = True

	'Spaltenbreite
	objXL.Range("A1").ColumnWidth = 14
	objXL.Range("B1").ColumnWidth = 10
	objXL.Range("C1").ColumnWidth = 10
	objXL.Range("D1").ColumnWidth = 38
	objXL.Range("E1").ColumnWidth = 14
	objXL.Range("F1").ColumnWidth = 11
	objXL.Range("G1").ColumnWidth = 14
	objXL.Range("H1").ColumnWidth = 14
	objXL.Range("I1").ColumnWidth = 14
	objXL.Range("J1").ColumnWidth = 14
	objXL.Range("K1").ColumnWidth = 25
	objXL.Range("L1").ColumnWidth = 10
End Sub
'----------------------------------------

'----------------------------------------
Sub WriteToExcel(byVal prod As product, byVal excelRow As Integer, byVal quantity As Integer, byVal instalLvl as Integer)
	dim i as integer
	dim paraFullName As String
	objXL.Cells(3+ excelRow,1).Value = instalLvl
	objXL.Cells(3+ excelRow,3).Value = quantity
	objXL.Cells(3+ excelRow,4).Value = prod.PartNumber

	On error resume next
	for i = 1 To prod.Parameters.Count
		paraFullName = prod.Parameters.Item(i).Name
		if Left(paraFullName, LEN(prod.PartNumber)) = prod.PartNumber then
			If InStr(paraFullName ,"Pos_Nr.") then 		objXL.Cells(3+ excelRow,2).Value = prod.Parameters.Item(i).ValueAsString
			If InStr(paraFullName ,"Material") then 		objXL.Cells(3+ excelRow,5).Value = prod.Parameters.Item(i).ValueAsString
			If InStr(paraFullName ,"Masse") then 		objXL.Cells(3+ excelRow,6).Value = prod.Parameters.Item(i).ValueAsString
			If InStr(paraFullName ,"Durchmesser") then 	objXL.Cells(3+ excelRow,7).Value = prod.Parameters.Item(i).ValueAsString
			If InStr(paraFullName ,"Laenge") then 		objXL.Cells(3+ excelRow,8).Value = prod.Parameters.Item(i).ValueAsString
			If InStr(paraFullName ,"Breite") then		objXL.Cells(3+ excelRow,9).Value = prod.Parameters.Item(i).ValueAsString
			If InStr(paraFullName ,"Hoehe") then 		objXL.Cells(3+ excelRow,10).Value = prod.Parameters.Item(i).ValueAsString
			If InStr(paraFullName ,"DIN EN ISO") then 	objXL.Cells(3+ excelRow,11).Value = prod.Parameters.Item(i).ValueAsString
			If InStr(paraFullName ,"Produktart") then 	objXL.Cells(3+ excelRow,12).Value = prod.Parameters.Item(i).ValueAsString
		end if
	next
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

	WriteToExcel oProd, excelRow, assyCount, instalLvl

	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)
			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
			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@p3-group.com" , vbyes, MACRO_NAME & " " & MACRO_VERS
end sub
'----------------------------------------