11 Replies Latest reply on Dec 21, 2016 5:30 AM by K. V.

    macro gets stuck, can't find out on which part

    K. V.

      I can't figure out why this macro is stuck, anyone that can help me? It is for Deleting suppressed parts/assembly's

       

      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
         
      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
                  RootModel.EditAssembly
                  b = swChildComp.Select4(False, iSel, False)
                  b = RootModel.Extension.DeleteSelection2(1)
                  iCountDelete = iCountDelete + 1
                  RootModel.ClearSelection2 (True)
                  RootModel.EditAssembly

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

              TraverseComponent swChildComp, RootModel, iLevel
          Next i

       

       

      Set swApp = Application.SldWorks
      End Sub

        • Re: macro gets stuck, can't find out on which part
          Christian Chu

          I run your macro and  it runs ok - not sure what you mean "gets stuck"

          I created a new assembly and inserted 2 parts. Suppressed one of them and run the macro - The suppressed part is deleted from the assembly

          Can you post a screen shot if there is any?

          • Re: macro gets stuck, can't find out on which part
            Ivana Kolin
            Option Explicit
            Sub main()
                Dim swApp                                    As SldWorks.SldWorks
                Dim swModel                                  As SldWorks.ModelDoc2
                Dim swConf                                    As SldWorks.Configuration
                Dim swRootComp                                As SldWorks.Component2
            
            
            
            
                Set swApp = Application.SldWorks
                Set swModel = swApp.ActiveDoc
                Set swConf = swModel.GetActiveConfiguration
                Set swRootComp = swConf.GetRootComponent
                TraverseComponent swRootComp, swModel, 0
            
            
            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 i                                        As Long
                Dim iSel                                      As Object
                Dim b                                        As Boolean
                Dim iLevel                                    As Integer
                Dim iCountDelete                              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 = UBound(vChildComp) To 0 Step -1
                    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
                        RootModel.EditAssembly
                        b = swChildComp.Select4(False, iSel, False)
                        b = RootModel.Extension.DeleteSelection2(1)
                        iCountDelete = iCountDelete + 1
                        RootModel.ClearSelection2 (True)
                        RootModel.EditAssembly
                        If b = False Then i = swChildComp.SetSuppression2(0)
                    Else
                        TraverseComponent swChildComp, RootModel, iLevel
                    End If
                   
                Next i
            
            
            
            
            End Sub
            
            
            
              • Re: macro gets stuck, can't find out on which part
                Chris Champions

                Ivana,

                Like Christian, I run the macro without a problem.

                So you just added the debug.print to list the componnts to be delelted?

                Chris

                • Re: macro gets stuck, can't find out on which part
                  K. V.

                  For some weird reason it still gives me an error, even with your updates macro. Seems to get stuck on the same string (For i = Ubound (vChildComp)....)

                    • Re: macro gets stuck, can't find out on which part
                      Ivana Kolin

                      try add this code after this line: vChildComp = swComp.GetChildren

                       

                      if isempty(vChildComp ) then 
                      msgbox "No children found"
                      exit sub
                      end if
                      

                       

                        • Re: macro gets stuck, can't find out on which part
                          K. V.

                          well, it worked, but for some weird reason if i do both of the corrections, i get in a loop hahahah.
                          "No children found" popped up and it started to loop around

                            • Re: macro gets stuck, can't find out on which part
                              Ivana Kolin
                              Option Explicit
                              Sub main()
                                  Dim swApp                                     As SldWorks.SldWorks
                                  Dim swModel                                   As SldWorks.ModelDoc2
                                  Dim swConf                                    As SldWorks.Configuration
                                  Dim swRootComp                                As SldWorks.Component2
                              
                              
                                  Set swApp = Application.SldWorks
                                  Set swModel = swApp.ActiveDoc
                                  Set swConf = swModel.GetActiveConfiguration
                                  Set swRootComp = swConf.GetRootComponent
                                  TraverseComponent swRootComp, swModel, 0
                              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 i                                         As Long
                                  Dim iSel                                      As Object
                                  Dim b                                         As Boolean
                                  Dim iCountDelete                              As Integer
                                  On Error GoTo TraverseComponent_Error
                                  iLev = iLev + 1  ' This variable is meant to show the sub-level the macro currently works in
                              Debug.Print iLev & "|" & swComp.Name
                                  vChildComp = swComp.GetChildren
                                  If IsEmpty(vChildComp) Then Exit Sub
                                  If UBound(vChildComp) < -0 Then Exit Sub
                                  swComp.Select4 False, Nothing, False
                                  RootModel.EditAssembly
                                  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
                                          b = swChildComp.Select4(False, iSel, False)
                                          b = RootModel.Extension.DeleteSelection2(swDelete_Children)
                                          iCountDelete = iCountDelete + 1
                                          If b = False Then
                                              swChildComp.SetSuppression2 (swComponentSuppressed)
                                          End If
                                      End If
                                  Next i
                                  RootModel.ClearSelection2 (True)
                                  RootModel.EditAssembly
                                  vChildComp = swComp.GetChildren
                                  If IsEmpty(vChildComp) Then Exit Sub
                                  If UBound(vChildComp) < -0 Then Exit Sub
                                  For i = 0 To UBound(vChildComp)
                                      Set swChildComp = vChildComp(i)
                                      TraverseComponent swChildComp, RootModel, iLev
                                  Next i
                              TraverseComponent_Exit:
                                  On Error Resume Next
                                  Exit Sub
                              TraverseComponent_Error:
                                  GoTo TraverseComponent_Exit
                              End Sub
                              
                              
                              
                              
                              
                              
                              
                              
                              
                              
                              
                              
                              
                              
                              
                              
                              
                              
                              
                              
                      • Re: macro gets stuck, can't find out on which part
                        Ivana Kolin

                        this line is also wrong:

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

                         

                        it has to be:

                        dim iRet as integer
                        If b = False Then iRet  = swChildComp.SetSuppression2(0)