How to get the count of the same parts in assembly

Question

I got the XML code to output the properties of parts and assembly using VBA macro in SOlidworks. In my assembly , there are 3 parts. This is some part of my VBA code in assembly.

            .....
            Set swAssembly = swModel            
            Set swCustPropMgr = swAssembly.Extension.CustomPropertyManager("")
            Dim components As Variant
            components = swAssembly.GetComponents(False)
            
            ' Check if the components array is not empty
            If Not IsEmpty(components) Then
                ' Get the count of components
                partsCount = UBound(components) - LBound(components) + 1
            Else
                ' Handle the case where there are no components in the assembly
            End If                    
            ' Loop through all the components in the assembly and add their properties to the XML code
            For i = 0 To partsCount - 1
                Set swComp = swAssembly.GetComponents(False)(i)
                Debug.Print "component:" & swComp.Name
                
                If Not swComp Is Nothing Then
                    Set swPart = swComp.GetModelDoc2
                    
                    ' Get the custom property manager for the component
                    Set swCustPropMgr = swPart.Extension.CustomPropertyManager("")
                    
                    ' Get the value of a specific property by name
                    partNum = swComp.Name
                    partNum = Left(partNum, Len(partNum) - 2)
                    qty = 1
                    Dim Color As String
                    Color = swCustPropMgr.Get("Color")
                    Material = swCustPropMgr.Get("Material")
                    finish = swCustPropMgr.Get("Finish")
                    Process = swCustPropMgr.Get("Process")
                    .....

Here, qty is the count of the same parts in assembly and I am trying to get the count but I didn't yet. I want the vba code to get it. Also, in above code, when i = 0, current swComp indicates the third part in assembly, not first part. But I have to indicate the first part. If I add the forth part in assembly, the part is located in forth position exactly in the outputted XML code. The names of parts is like this. Part_A, Part_B, Part_C(current vba code indicate Part_C when i = 0 and Part_A when i = 1, and then Part_B when i=2) I want to know why this happened. Thanks for your time Kostiantyn

Answer 1

To get the components in the Feature tree order with their quantity, you will need to get them from the assembly features, like so:

Option Explicit
Dim MyItems As Collection
Dim Item As Class1

Sub main()
    Dim swApp As SldWorks.SldWorks
    Dim swAssy As SldWorks.ModelDoc2
    Set swApp = Application.SldWorks
    Set swAssy = swApp.ActiveDoc
    Set MyItems = New Collection
    TraverseFeatures swAssy

    For Each Item In MyItems
        Debug.Print Item.Qty & vbTab & Item.PartNum & vbTab & Item.Color
    Next
End Sub
 
Sub TraverseFeatures(swModel As SldWorks.ModelDoc2)
    Dim FilePath As String
    FilePath = swModel.GetPathName
    Dim MyItem As New Class1
    
    MyItem.PartNum = Mid(FilePath, InStrRev(FilePath, "\") + 1, InStrRev(FilePath, ".") - InStrRev(FilePath, "\") - 1)
    Dim swChildModel As SldWorks.ModelDoc2
    Dim swChildComp As SldWorks.Component2
    For Each Item In MyItems
        If Item.PartNum = MyItem.PartNum Then
            Item.Qty = Item.Qty + 1
            Exit Sub
        End If
    Next
    
    Set MyItem.swModel = swModel
    MyItem.Qty = 1
    GetProps MyItem
    MyItems.Add MyItem

    If swModel.GetType = swDocumentTypes_e.swDocPART Then Exit Sub

    Dim vFeats As Variant
    Dim vFeat As Variant
    Dim swFeat As SldWorks.Feature
    vFeats = swModel.FeatureManager.GetFeatures(False)
    If IsEmpty(vFeats) Then Exit Sub
    Dim swSelMgr As SldWorks.SelectionMgr
    Set swSelMgr = swModel.SelectionManager

    For Each vFeat In vFeats
    Set swFeat = vFeat
        If InStr(swFeat.GetTypeName2, "Reference") > 0 Then
            swModel.ClearSelection2 (True)
            swFeat.Select2 False, 0
            Set swChildComp = swSelMgr.GetSelectedObject6(1, -1)
            If Not swChildComp Is Nothing Then
                Set swChildModel = swChildComp.GetModelDoc2
                If Not swChildModel Is Nothing Then
                    If Not swChildComp.ExcludeFromBOM Then TraverseFeatures swChildModel
                End If
            End If
        End If
    Next
End Sub

Sub GetProps(MyItem As Class1)
    Dim swCustPropMgr As SldWorks.CustomPropertyManager
    Set swCustPropMgr = MyItem.swModel.Extension.CustomPropertyManager("")

    MyItem.Color = swCustPropMgr.Get("Color")
    'Material = swCustPropMgr.Get("Material")
    'finish = swCustPropMgr.Get("Finish")
    'Process = swCustPropMgr.Get("Process")
End Sub

Create a new class with: Insert > Class Module

Public PartNum As String
Public Qty As Long
Public swModel As SldWorks.ModelDoc2
Public Color As String