id macro

Option Explicit

Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim featMgr As SldWorks.FeatureManager
Dim curMod As SldWorks.ModelDoc2 'currently traversed Model
Dim swBodyFolder As BodyFolder 'bodyfolder = top-level cut-list folder
Dim vComponents As Variant 'all components in the assy
Dim id As Integer
Dim swFeat As Feature

Sub main()
    Set swApp = Application.SldWorks
    Set swModel = swApp.ActiveDoc
    Set featMgr = swModel.FeatureManager

    If swModel.GetType <> swDocASSEMBLY Then
        MsgBox "Please open an assembly!", vbCritical, "Error"
        Exit Sub
    End If

    vComponents = swModel.GetComponents(False)

    Dim i As Integer

    id = CInt(InputBox("Start ID:", "ID Macro", "1"))
    'id = 1
    For i = 0 To UBound(vComponents)
        Set curMod = vComponents(i).GetModelDoc2()
        Set swFeat = curMod.FirstFeature

        Do While Not swFeat Is Nothing
            If swFeat.GetTypeName2 = "SolidBodyFolder" Then
                Set swBodyFolder = swFeat.GetSpecificFeature2
                swBodyFolder.UpdateCutList
            ElseIf swFeat.GetTypeName2 = "CutListFolder" Then
                Dim vProperties As Long
                Dim vPropnames As Variant
                Dim vProptypes As Variant
                Dim vPropvalues As Variant
                Dim vResolved As Variant

                vProperties = swFeat.CustomPropertyManager.GetAll2(vPropnames, vProptypes, vPropvalues, vResolved)
                If vProperties <> 0 Then
                    'Debug.Print "Number props: " & vProperties
                    Dim j As Integer
                    For j = 0 To vProperties - 1
                        'Debug.Print "Name: " & vPropnames(i)
                        'Debug.Print "Value: " & vPropvalues(i)

                        If vPropnames(j) = "id" Then
                            If vPropvalues(j) >= id Then
                                'Debug.Print "Found id, assigning " & id
                                swFeat.CustomPropertyManager.Set2 vPropnames(j), CStr(id)
                                id = id + 1
                            End If
                        End If
                    Next j
                End If
            End If

            Set swFeat = swFeat.GetNextFeature
        Loop
    Next i
    'Debug.Print "Last ID assigned: " & id - 1
    MsgBox "Last ID: " & id - 1, vbOKOnly, "ID macro"
End Sub