Bill of Materials export to Template by material

Bill of Materials export to Template by material

skyleWX4C5
Contributor Contributor
354 Views
7 Replies
Message 1 of 8

Bill of Materials export to Template by material

skyleWX4C5
Contributor
Contributor

Hello all.

I've run into a bit of an issue trying to get my Bill of Materials to export to different sheets depending on material. I've attached my attempt at this. We use a custom property for "Material" and I'm looking to have it export to the template I have based on the custom material property. I got it to export with the designated parameters, but have been unsuccessful in separating by material.

 

One more thing, This line: oGaugeProperty = oCustomPropertySet.Item("GAUGE")

Errors out, but still successfully brings the custom property "GAUGE" to the document. I like that it still brings the information, but don't like the error. Any help greatly appreciated!

 

Dim oDoc As AssemblyDocument
oDoc = ThisApplication.ActiveDocument

Dim oBOM As BOM
oBOM = oDoc.ComponentDefinition.BOM

oBOM.PartsOnlyViewEnabled = True

Dim oBOMView As BOMView
oBOMView = oBOM.BOMViews.Item("Parts Only")

xlApp = CreateObject("Excel.Application")

xlApp.Visible = True 
xlWorkbook = xlApp.Workbooks.Open("C:\Temp\Test.xlsx")

xlWorksheet = xlWorkbook.Worksheets.Item("Components")

Dim row As Integer
row = 9


bRows = oBOMView.BOMRows
For Each bRow In bRows
	
	Dim oMatType As String
	oMatType = iProperties.Value("Custom", "Material")
	If oMatType = "GLASTIC" Or "STEEL" Or "GALV." Or "304 STAINLESS" Or "LEXAN" Or "ALUMINUM"
		xlWorksheet = xlWorkbook.Worksheets.Item("Sheet Metal")
		
	Else If oMatType = "CU"
		xlWorksheet = xlWorkbook.Worksheets.Item("Copper Bar")
	End If
	
		
	Dim rDoc As Document
	rDoc = bRow.ComponentDefinitions.Item(1).Document
	
	Dim docPropertySet As PropertySet
	docPropertySet = rDoc.PropertySets.Item("Design Tracking Properties")
	
	Dim oPropSets As PropertySets
	oPropSets = rDoc.PropertySets
	
	oInventorSummaryPropertySet = oPropSets.Item("Inventor Summary Information")
	oRevNumberProperty = oInventorSummaryPropertySet.Item("Revision Number")
	oCustomPropertySet = oPropSets.Item("Inventor User defined Properties")
	oGaugeProperty = oCustomPropertySet.Item("GAUGE")


	xlWorksheet.Range("B" & row).Value = oRevNumberProperty.Value
	xlWorksheet.Range("C" & row).Value = docPropertySet.Item("Part Number").Value
	xlWorksheet.Range("D" & row).Value = docPropertySet.Item("Description").Value
	xlWorksheet.Range("H" & row).Value = bRow.ItemQuantity
	xlWorksheet.Range("E" & row).Value = oGaugeProperty.Value

	
	row = row + 1
	
Next

oNow = DateString & "_" & TimeString
oNow = oNow.Replace("/","_")
oNow = oNow.Replace(":","_")
xlWorkbook.SaveAs(Filename:="C:\Temp\SampleNew_" & oNow & ".xlsx")

xlWorkbook.Close (False)
xlApp.Quit

 

0 Likes
355 Views
7 Replies
Replies (7)
Message 2 of 8

a.brusamolino
Enthusiast
Enthusiast

Hi @skyleWX4C5 !


Can you show us an example of what you want to achieve? Your program currently uses the material only to distinguish between SheetMetal and CopperBar, but that's it. It doesn’t sort the properties based on the actual material.

 

As for the error, can you report what it says? Maybe it can’t find the property in the document, but that would be strange… in that case, it shouldn’t export anything at all...

 

Many thanks!

0 Likes
Message 3 of 8

skyleWX4C5
Contributor
Contributor

skyleWX4C5_0-1743682850886.png

This is the error message I get when I run the code. What I want to achieve is for each part, I want it to determine the sheet to export to based on the material type. Furthermore, I want it to export the part properties: Revision, Part Number, Description, and Gauge (A custom property).

0 Likes
Message 4 of 8

a.brusamolino
Enthusiast
Enthusiast

Ok, I was hoping for more of a visual example. Nevertheless, if I understand correctly, I suggest switching from an IF statement to a SELECT statement. This way, you can list all your materials and choose the appropriate worksheet (which means you need to create them in your template beforehand). Additionally, you should store the row increment separately to avoid blank rows in the sheets.

 

Dim N As Integer = # of materials
Dim rows(N-1) As Integer
For i As Integer = 0 To rows.Length - 1
    rows(i) = 8
Next

Select oMatType
	Case "GLASTIC"
		xlWorksheet = xlWorkbook.Worksheets.Item("GLASTIC")
		row(0) += 1
	Case "STEEL"
		xlWorksheet = xlWorkbook.Worksheets.Item("STEEL")
		row(1) += 1
	Case
		[...]
End Select

 

It’s very strange that the code continues running after that error. It really seems like it can't find the custom property "GAUGE" in a specific document. Most likely, the parameters you see being exported are the ones from before the error occurred. Try checking that all documents contain that property using a Try and Catch block.

 

Try
	oGaugeProperty = oCustomPropertySet.Item("GAUGE")
Catch
	MsgBox(rDoc.DisplayName)
End Try

 

0 Likes
Message 5 of 8

skyleWX4C5
Contributor
Contributor

I think I added the change correctly, but I'm still relatively new to coding. This is the updated:

Dim oDoc As AssemblyDocument
oDoc = ThisApplication.ActiveDocument

Dim oBOM As BOM
oBOM = oDoc.ComponentDefinition.BOM

oBOM.PartsOnlyViewEnabled = True

Dim oBOMView As BOMView
oBOMView = oBOM.BOMViews.Item("Parts Only")

xlApp = CreateObject("Excel.Application")

xlApp.Visible = True 
xlWorkbook = xlApp.Workbooks.Open("C:\Temp\Test.xlsx")

'xlWorksheet = xlWorkbook.Worksheets.Item("Components")

Dim row As Integer
row = 9


Dim N As Integer = 7
Dim rows(N-1) As Integer
For i As Integer = 0 To rows.Length - 1
    rows(i) = 8
Next


bRows = oBOMView.BOMRows
For Each bRow In bRows
	
	Dim oMatType As String
	oMatType = iProperties.Value("Custom", "Material")
'	If oMatType = "GLASTIC" Or "STEEL" Or "GALV." Or "304 STAINLESS" Or "LEXAN" Or "ALUMINUM"
'		xlWorksheet = xlWorkbook.Worksheets.Item("Sheet Metal")
		
'	Else If oMatType = "CU"
'		xlWorksheet = xlWorkbook.Worksheets.Item("Copper Bar")
'	End If///////////////////////////////////////////////////////////

Select oMatType
	Case "GLASTIC"
		xlWorksheet = xlWorkbook.Worksheets.Item("Sheet Metal")
'		row(0) += 1
	Case "STEEL"
		xlWorksheet = xlWorkbook.Worksheets.Item("Sheet Metal")
'		row(1) += 1
	Case "GALV."
		xlWorksheet = xlWorkbook.Worksheets.Item("Sheet Metal")
'		row(0) += 1
	Case "304 STAINLESS"
		xlWorksheet = xlWorkbook.Worksheets.Item("Sheet Metal")
'		row(0) += 1
	Case "LEXAN"
		xlWorksheet = xlWorkbook.Worksheets.Item("Sheet Metal")
'		row(0) += 1
	Case "ALUMINUM"
		xlWorksheet = xlWorkbook.Worksheets.Item("Sheet Metal")
'		row(0) += 1
	Case "CU"
		xlWorksheet = xlWorkbook.Worksheets.Item("Copper Bar")
'		row(0) += 1
		
	Case Else
		xlWorksheet = xlWorkbook.Worksheets.Item("Components")
'		row(0) += 1
	

End Select
		
	Dim rDoc As Document
	rDoc = bRow.ComponentDefinitions.Item(1).Document
	
	Dim docPropertySet As PropertySet
	docPropertySet = rDoc.PropertySets.Item("Design Tracking Properties")
	
	Dim oPropSets As PropertySets
	oPropSets = rDoc.PropertySets
	
	oInventorSummaryPropertySet = oPropSets.Item("Inventor Summary Information")
	oRevNumberProperty = oInventorSummaryPropertySet.Item("Revision Number")
	oCustomPropertySet = oPropSets.Item("Inventor User defined Properties")
'	oGaugeProperty = oCustomPropertySet.Item("GAUGE")
Try
	oGaugeProperty = oCustomPropertySet.Item("GAUGE")
Catch
'	MsgBox(rDoc.DisplayName)
End Try


	xlWorksheet.Range("B" & row).Value = oRevNumberProperty.Value
	xlWorksheet.Range("C" & row).Value = docPropertySet.Item("Part Number").Value
	xlWorksheet.Range("D" & row).Value = docPropertySet.Item("Description").Value
	xlWorksheet.Range("H" & row).Value = bRow.ItemQuantity
	xlWorksheet.Range("E" & row).Value = oGaugeProperty.Value

	
	row = row + 1
	
Next

oNow = DateString & "_" & TimeString
oNow = oNow.Replace("/","_")
oNow = oNow.Replace(":","_")
xlWorkbook.SaveAs(Filename:="C:\Temp\SampleNew_" & oNow & ".xlsx")

xlWorkbook.Close (False)
xlApp.Quit

skyleWX4C5_0-1743788757064.png

 

As you can see, Its still placing all gauges onto the same page, however, the try/catch loop did clear the error that was popping up. Any ideas?

0 Likes
Message 6 of 8

a.brusamolino
Enthusiast
Enthusiast

Ok, so if I understood correctly, you don't want to split the components into different sheets, but rather group them on the same sheet only when the material is not CU.

Try this code:

 

Dim oDoc As AssemblyDocument = ThisApplication.ActiveDocument

Dim oBOM As BOM = oDoc.ComponentDefinition.BOM
oBOM.PartsOnlyViewEnabled = True
Dim oBOMView As BOMView = oBOM.BOMViews.Item("Solo parti")
bRows = oBOMView.BOMRows

Dim RevNumber, PartNumber, Description, Material, ItemQuantity, Gauge As String 
Dim oDesignTrackingProperties, oInventorSummaryPropertySet, oCustomPropertySet As PropertySet

Dim listaCopper As New List(Of String())
Dim listaAltri As New List(Of String())

For Each bRow In bRows	
	Dim rDoc As Document = bRow.ComponentDefinitions.Item(1).Document
	oDesignTrackingProperties = rDoc.PropertySets.Item("Design Tracking Properties")
	oInventorSummaryPropertySet = rDoc.PropertySets.Item("Inventor Summary Information")
	oCustomPropertySet = rDoc.PropertySets.Item("Inventor User defined Properties")
	
	RevNumber = oInventorSummaryPropertySet.Item("Revision Number").Value
	PartNumber = oDesignTrackingProperties.Item("Part Number").Value
	Description = oDesignTrackingProperties.Item("Description").Value
	Material = oDesignTrackingProperties.Item("Material").Value
	'Material = oCustomPropertySet.Item("Material").Value
	ItemQuantity = CStr(bRow.ItemQuantity)
	Try
		Gauge = oCustomPropertySet.Item("GAUGE").Value
	Catch
		Gauge = ""
	End Try
	
	Dim riga() As String = {RevNumber, PartNumber, Description, Material, ItemQuantity, Gauge}
	
	' Smista in base al materiale
	If Material.Contains("CU") Then
		listaCopper.Add(riga)
	Else
		listaAltri.Add(riga)
	End If
Next

Dim MaterialIndex As Integer = 3
listaAltri.Sort(Function(x, y) x(MaterialIndex).CompareTo(y(MaterialIndex)))

' Inizializza Excel
xlApp = CreateObject("Excel.Application")
Dim wb = xlApp.Workbooks.Add()

' === FOGLIO 1: ALTRI MATERIALI ===
wsAltri = wb.Sheets(1)
wsAltri.Name = "Altri Materiali"
wsAltri.Cells(1, 1).Value = "Rev Number"
wsAltri.Cells(1, 2).Value = "Part Number"
wsAltri.Cells(1, 3).Value = "Description"
wsAltri.Cells(1, 4).Value = "Material"
wsAltri.Cells(1, 5).Value = "Qty"
wsAltri.Cells(1, 6).Value = "Gauge"
Dim rigaExcel As Integer = 2
Dim materialeCorrente As String = ""

For Each riga In listaAltri
	Dim materiale As String = riga(MaterialIndex)
	' Se cambia materiale, aggiungi riga di intestazione
	If materiale <> materialeCorrente Then
		If materialeCorrente <> "" Then
			rigaExcel += 1 ' Riga vuota tra gruppi
		End If
		wsAltri.Cells(rigaExcel, 1).Value = ">> " & materiale
		wsAltri.Range("A" & rigaExcel.ToString & ":B" & rigaExcel.ToString).Font.Bold = True
		rigaExcel += 1
		materialeCorrente = materiale
	End If

	' Scrivi la riga
	wsAltri.Cells(rigaExcel, 1).Value = riga(0)
	wsAltri.Cells(rigaExcel, 2).Value = riga(1)
	wsAltri.Cells(rigaExcel, 3).Value = riga(2)
	wsAltri.Cells(rigaExcel, 4).Value = riga(3)
	wsAltri.Cells(rigaExcel, 5).Value = riga(4)
	wsAltri.Cells(rigaExcel, 5).Value = riga(5)
	rigaExcel += 1
Next

' === FOGLIO 2: COPPER ===
wsCopper = wb.Sheets.Add(After:=wb.Sheets(wb.Sheets.Count))
wsCopper.Name = "Copper"
wsCopper.Cells(1, 1).Value = "Rev Number"
wsCopper.Cells(1, 2).Value = "Part Number"
wsCopper.Cells(1, 3).Value = "Description"
wsCopper.Cells(1, 4).Value = "Material"
wsCopper.Cells(1, 5).Value = "Qty"
wsCopper.Cells(1, 6).Value = "Gauge"
rigaExcel = 2

For Each riga In listaCopper
	wsCopper.Cells(rigaExcel, 1).Value = riga(0)
	wsCopper.Cells(rigaExcel, 2).Value = riga(1)
	wsCopper.Cells(rigaExcel, 3).Value = riga(2)
	wsCopper.Cells(rigaExcel, 4).Value = riga(3)
	wsCopper.Cells(rigaExcel, 5).Value = riga(4)
	wsCopper.Cells(rigaExcel, 6).Value = riga(5)
	rigaExcel += 1
Next

' Mostra Excel
xlApp.Visible = True

 

(Of course, the Excel part will need to be adapted to your template.)

 

As for the fact that the try-catch doesn't throw an error — it's because not all documents contain the "GAUGE" property. You should check for it and, if needed, add it manually.

 

Hope that helps

0 Likes
Message 7 of 8

skyleWX4C5
Contributor
Contributor

I ran this code, and it was helpful for sure in some ways. It separated the parts down to the actual part material and gave them categories. It didn't move them to different sheets. I did however stumble across the real issue while playing with the code in the meantime. It seems that its not actually identifying the custom "MATERIAL" property as a string. Its evaluating to TRUE or FALSE. Its also, always evaluating to FALSE. So by that logic, it always puts everything on the 

	Case Else
		xlWorksheet = xlWorkbook.Worksheets.Item("Components")

 "Components" sheet. So it seems the issue is a bit more complex. I did confirm that the material itself is a "Text" type.

skyleWX4C5_0-1744729406774.png

 

Thanks for the insight!

0 Likes
Message 8 of 8

a.brusamolino
Enthusiast
Enthusiast

You're welcome!
However, it's very strange that it returns a boolean value. How are you accessing the info?

 

I've tried both of these options, and in my case, they work correctly:

 

Dim oDoc As Document = ThisApplication.ActiveDocument
Dim oCustomPropertySet As PropertySet = oDoc.PropertySets.Item("Inventor User defined Properties")
Dim oMatType1 As String = oCustomPropertySet.Item("Material").Value

Dim oMatType2 As String = iProperties.Value("Custom", "Material")

MsgBox(oMatType1)
MsgBox(oMatType2)
0 Likes