SOLIDWORKS VBA macro to compose flat BOM table using API
{ width=250 }
This example demonstrates how to compose flat (top level only) Bill Of Materials table from the assembly tree using SOLIDWORKS API.
Bill Of Materials position includes the following columns:
- Model Path
- Model Configuration
- Description (custom property)
- Price (custom property)
- Quantity (calculated)
The composed BOM is output to the immediate window of VBA editor:
{ width=250 }
It is not required to have a BOM Table inserted for this macro to work.
Type BomPosition
ModelPath As String
Configuration As String
Quantity As Double
Description As String
Price As Double
End Type
Dim swApp As SldWorks.SldWorks
Sub Main()
Set swApp = Application.SldWorks
Dim swAssy As SldWorks.AssemblyDoc
Set swAssy = swApp.ActiveDoc
If Not swAssy Is Nothing Then
swAssy.ResolveAllLightWeightComponents True
Dim bom() As BomPosition
bom = GetFlatBom(swAssy)
Dim i As Integer
Debug.Print "Path" & vbTab & "Configuration" & vbTab & "Description" & vbTab & "Price" & vbTab & "Qty"
For i = 0 To UBound(bom)
Debug.Print bom(i).ModelPath & vbTab & bom(i).Configuration & vbTab & bom(i).Description & vbTab & bom(i).Price & vbTab & bom(i).Quantity
Next
Else
MsgBox "Please open assembly"
End If
End Sub
Function GetFlatBom(assy As SldWorks.AssemblyDoc) As BomPosition()
Dim bom() As BomPosition
Dim vComps As Variant
vComps = assy.GetComponents(False)
Dim i As Integer
For i = 0 To UBound(vComps)
Dim swComp As SldWorks.Component2
Set swComp = vComps(i)
If swComp.GetSuppression() <> swComponentSuppressionState_e.swComponentSuppressed And Not swComp.ExcludeFromBOM Then
Dim bomPos As Integer
bomPos = FindBomPosition(bom, swComp)
If bomPos = -1 Then
If (Not bom) = -1 Then
ReDim bom(0)
Else
ReDim Preserve bom(UBound(bom) + 1)
End If
bomPos = UBound(bom)
bom(bomPos).ModelPath = swComp.GetPathName()
bom(bomPos).Configuration = swComp.ReferencedConfiguration
bom(bomPos).Quantity = 1
GetProperties swComp, bom(bomPos).Description, bom(bomPos).Price
Else
bom(bomPos).Quantity = bom(bomPos).Quantity + 1
End If
End If
Next
GetFlatBom = bom
End Function
Function FindBomPosition(bom() As BomPosition, comp As SldWorks.Component2) As Integer
FindBomPosition = -1
If (Not bom) <> -1 Then
Dim i As Integer
For i = 0 To UBound(bom)
If LCase(bom(i).ModelPath) = LCase(comp.GetPathName()) And LCase(bom(i).Configuration) = LCase(comp.ReferencedConfiguration) Then
FindBomPosition = i
Exit Function
End If
Next
End If
End Function
Sub GetProperties(comp As SldWorks.Component2, ByRef desc As String, ByRef prc As Double)
Dim swCompModel As SldWorks.ModelDoc2
Set swCompModel = comp.GetModelDoc2()
If swCompModel Is Nothing Then
Err.Raise vbError, "", "Failed to get model from the component"
End If
desc = GetPropertyValue(swCompModel, comp.ReferencedConfiguration, "Description")
Dim prcTxt As String
prcTxt = GetPropertyValue(swCompModel, comp.ReferencedConfiguration, "Price")
If prcTxt <> "" Then
prc = CDbl(prcTxt)
End If
End Sub
Function GetPropertyValue(model As SldWorks.ModelDoc2, conf As String, prpName As String) As String
Dim confSpecPrpMgr As SldWorks.CustomPropertyManager
Dim genPrpMgr As SldWorks.CustomPropertyManager
Set confSpecPrpMgr = model.Extension.CustomPropertyManager(conf)
Set genPrpMgr = model.Extension.CustomPropertyManager("")
Dim prpVal As String
Dim prpResVal As String
confSpecPrpMgr.Get3 prpName, False, "", prpVal
If prpVal = "" Then
genPrpMgr.Get3 prpName, False, prpVal, prpResVal
End If
GetPropertyValue = prpResVal
End Function