AnsweredAssumed Answered

Macro problem....Deleting all supressed components and all configurations from assembly

Question asked by Barry Setzer on May 7, 2015

So with some help from a few of you here, I have a macro that deletes all suppressed components and configurations from my assembly. I need the macro to also dive into each component of the assembly and delete the unused configurations here also. I am trying to use the Publis Sub "AllComponents" to do this, but I can't get it to work......can anyone help me out here? This is all in the same module........



Option Explicit
Dim swApp As SldWorks.SldWorks
Public iCountDelete As Integer
Public sNameDelete As String


Sub main()

    Dim swApp                 As SldWorks.SldWorks
    Dim swModel               As SldWorks.ModelDoc2
    Dim swAssy                As SldWorks.AssemblyDoc
    Dim swConf                As SldWorks.Configuration
    Dim swRootComp            As SldWorks.Component2
    Set swApp = CreateObject("SldWorks.Application")
    Set swModel = swApp.ActiveDoc
    Set swConf = swModel.GetActiveConfiguration
    Set swRootComp = swConf.GetRootComponent

    TraverseComponent swRootComp, swModel, 0
MsgBox ("Barry Has Cleaned Your File. You're Welcome!")
End Sub


Sub TraverseComponent(swComp As SldWorks.Component2, RootModel As SldWorks.ModelDoc2, ByVal iLev As Integer)

    Dim vChildComp            As Variant
    Dim swChildComp           As SldWorks.Component2
    Dim swCompConfig          As SldWorks.Configuration
    Dim i                     As Long
    Dim iRueck                As Double
    Dim oModel, oModComp      As ModelDoc2
    Dim iSel                  As Object
    Dim b                     As Boolean
    Dim o                     As Object
    Dim iLevel                As Integer
    iLevel = iLev + 1   ' This variable is meant to show the sub-level the macro currently works in
    Debug.Print iLevel & "|" & swComp.Name

    vChildComp = swComp.GetChildren
    For i = 0 To UBound(vChildComp)
        Set swChildComp = vChildComp(i)
        If swChildComp.IsSuppressed Then   ' Identified a suppressed part - Aim is to kill this one, no matter if it is assembly or part
            Debug.Print "Suppr.: " & swChildComp.Name
            swComp.Select4 False, Nothing, False
            b = swChildComp.Select4(False, iSel, False)
            b = RootModel.Extension.DeleteSelection2(1)
            iCountDelete = iCountDelete + 1
            RootModel.ClearSelection2 (True)

            If b = False Then i = swChildComp.SetSuppression2(0)
         End If

        TraverseComponent swChildComp, RootModel, iLevel
    Next i

Call AllComponents

End Sub

Public Sub AllComponents()

Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swAssy As SldWorks.AssemblyDoc
Dim swComp As SldWorks.Component2
Dim swCompModel As SldWorks.ModelDoc2
Dim i As Integer
Dim vComps As Variant
    Set swApp = Application.SldWorks
    Set swModel = swApp.ActiveDoc
    Set swAssy = swModel
    vComps = swAssy.GetComponents(True)
    If IsEmpty(vComps) Then Exit Sub
    For i = 0 To UBound(vComps)
        Set swComp = vComps(i)
        Set swCompModel = swComp.GetModelDoc2
         Call Delcon
    Next i

End Sub


Public Sub Delcon()
Dim swApp          As SldWorks.SldWorks
Dim swModel        As SldWorks.ModelDoc2
Dim swConFig       As SldWorks.Configuration
Dim sConFigName    As String
Dim vConFigNames   As Variant
Dim j              As Integer
Dim bRet           As Boolean

Set swApp = _
If swApp.GetDocumentCount() = 0 Then Exit Sub
Set swModel = swApp.ActiveDoc
If swModel.GetType() = swDocumentTypes_e.swDocDRAWING Then Exit Sub
If swModel.GetConfigurationCount() = 1 Then Exit Sub
Set swConFig = swModel.GetActiveConfiguration
vConFigNames = swModel.GetConfigurationNames
For j = 0 To UBound(vConFigNames)
    sConFigName = vConFigNames(j)
    If Not sConFigName = swConFig.Name Then
    bRet = swModel.DeleteConfiguration2(sConFigName)
    End If
Next j
swModel.ForceRebuild3 (False)
End Sub