0 Replies Latest reply on May 7, 2015 10:40 AM by Barry Setzer

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

    Barry Setzer

      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