SOLIDWORKS VBA macro to compose flat BOM table using API

Edit ArticleEdit Article

Bill Of Materials
Bill Of Materials

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:

BOM Table printed in the immediate window
BOM Table printed in the immediate window

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
        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)
                    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
                bom(bomPos).Quantity = bom(bomPos).Quantity + 1
            End If
        End If
    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
    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

Product of Xarial Product of Xarial