AnsweredAssumed Answered

Count All instances of Assemblies, Parts, & Configurations thereof (Working code but horribly inefficient)

Question asked by James Watson on Mar 13, 2017
Latest reply on Mar 21, 2017 by James Watson

OK so, below you will find my current macro, works nearly flawlessly. alas it is so inefficient it hurts... (as you can see if you watch the debug window).


What it does is it gets all components and configurations of said components in an assembly. It then iterates through them using a duplicate iteration to count the quantities of each configuration of each component. Using this method it overwrites the "MfgQty" custom property again and again every time it encounters a part. Though it still gives the correct result, this is horribly inefficient.

Dim swApp As SldWorks.SldWorks

Dim swModel As SldWorks.ModelDoc2

Dim swAssy As SldWorks.AssemblyDoc

Dim swCmp As SldWorks.Component2

Dim tCmp As SldWorks.Component2

Dim CmpDoc As ModelDoc2

Dim i As Integer

Dim j As Integer

Dim Cfg As String

Dim vCmps As Variant

Dim swCustPropMgr As SldWorks.CustomPropertyManager

Dim nstart As Long

Dim nStatus As Long

Dim config As SldWorks.Configuration

Dim lRetVal As Variant

Dim ValOut As String

Dim ResolvedValOut As String

Dim wasResolved As Boolean

Dim cCnt As Integer


Sub main()

    Set swApp = Application.SldWorks

    Set swModel = swApp.ActiveDoc

    Set swAssy = swModel


' start timer

    nstart = Timer


' load all components into array

    vCmps = swAssy.GetComponents(False)


' resolve all lightweight components

    nStatus = swAssy.ResolveAllLightWeightComponents(False)


'remove duplicates from array


' iterate though array

    For i = 0 To UBound(vCmps)

        Set swCmp = vCmps(i)

        If (swCmp.GetSuppression = 3) Or (swCmp.GetSuppression = 2) Then

        cCnt = 0

        Set CmpDoc = swCmp.GetModelDoc

        Cfg = swCmp.ReferencedConfiguration


' for each component in new array of matching configuration, count instances in original array

            For j = 0 To UBound(vCmps)

            Set tCmp = vCmps(j)

            If tCmp.GetSuppression <> 0 Then

            If tCmp.GetModelDoc2 Is CmpDoc Then

            If tCmp.ReferencedConfiguration = Cfg Then

            cCnt = cCnt + 1

            End If

            End If

            End If

            Next j

        Debug.Print swCmp.Name, swCmp.ReferencedConfiguration, cCnt



' set "MfgQty" custom property to computed value

    Set swCustPropMgr = CmpDoc.Extension.CustomPropertyManager(swCmp.ReferencedConfiguration)

    lRetVal = swCustPropMgr.Delete2("MfgQty")

    lRetVal = swCustPropMgr.Add3("MfgQty", 30, "999", 0)

    lRetVal = swCustPropMgr.Get5("MfgQty", False, ValOut, ResolvedValOut, False)

    lRetVal = swCustPropMgr.Set2("MfgQty", cCnt)

        End If

    Next i



' show elapsed time

    Debug.Print "Time = " & Timer - nstart & " seconds"


End Sub

What I would like to do is reduce this. I would like to initially build an array of unique components/configurations, then using that array iterate through it using the base array to do the count. this would benefit me at least 2 fold, 1) MUCH more efficient not duplicating counts and 2) it would allow me to add print and dxf commands in (print to .PDF drawings of all parts, and export .DXF drawings of parts that contain a custom property called "ItemCat" with the value of "Laser-Pur" and/or "Router-Pur"), and only have each unique part print out once rather that 24 times for a part that has 24 instances. Below is a sample code of what i think would work... i am just having issues connecting the two.

Sub Test()

Dim aReturn As Variant

Dim aArray As Variant

Dim swCmp As Variant

' build array


aArray = Array("red", "blue", "green", "blue", "blue", "green", "red", "red", "yellow", "red", "green", "blue")

aReturn = ArrayUnique(aArray)

    For i = 0 To UBound(aReturn)

        Debug.Print aReturn(i)

    Next i

End Sub


Function ArrayUnique(ByVal aArrayIn As Variant) As Variant


'remove duplicated values from a single dimension array

Dim aArrayOut() As Variant

Dim bFlag As Boolean

Dim vIn As Variant

Dim vOut As Variant

Dim i%, j%, k%


ReDim aArrayOut(LBound(aArrayIn) To UBound(aArrayIn))

i = LBound(aArrayIn)

j = i


For Each vIn In aArrayIn

    For k = j To i - 1

        If vIn = aArrayOut(k) Then bFlag = True: Exit For


    If Not bFlag Then aArrayOut(i) = vIn: i = i + 1

    bFlag = False



If i <> UBound(aArrayIn) Then ReDim Preserve aArrayOut(LBound(aArrayIn) To i - 1)

ArrayUnique = aArrayOut

End Function

the first code has fairly well broken out steps, and works as is to add a custom property called "MfgQty" to each file with the assembly count of said part. Works with multiple configurations of the same part and will add the property to each configuration correctly.


Any help on generating this Array so i can progress this code further would be helpful. as you can see the " 'remove duplicates from array" section is empty