id clear

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 clrNo 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)

    clrNo = 0
    Dim i As Integer
    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
                    Dim j As Integer
                    For j = 0 To vProperties - 1
                        If vPropnames(j) = "id" And vPropvalues(j) <> "" Then
                            swFeat.CustomPropertyManager.Set2 vPropnames(j), ""
                            clrNo = clrNo + 1
                        End If
                    Next j
                End If
            End If

            Set swFeat = swFeat.GetNextFeature
        Loop
    Next i
    MsgBox "Cleared " & clrNo & " values", vbOKOnly, "ID macro"
End Sub