9 Replies Latest reply on Mar 18, 2016 5:36 PM by Kyle Lami

    Macro which suppresses all folders of the same name in an assembly

    Kyle Schutte

      Hello,

       

      I am trying to create a macro which will suppress all folders of the same name in an assembly. In my case, I have added all the fasteners in each sub-assembly to a folder appropriately named "Fasteners", so that I can easily suppress all fasteners in an assembly by simply toggling the folder. This helps our sluggish computers handle the model better as there are many, many fasteners within the master assembly.

       

      So - my overall goal is to be able to run a macro while in the master assembly which will suppress all fasteners. The macro below is my best attempt and falls short as it only suppresses the "Fasteners" folder in the top-level of the assembly.

       

      Any help is greatly appreciated.

       

       

      *************************************************

      Dim swApp As Object

       

       

      Dim Part As Object

      Dim boolstatus As Boolean

      Dim longstatus As Long, longwarnings As Long

       

       

      Sub main()

       

       

      Set swApp = _

      Application.SldWorks

       

       

      Set Part = swApp.ActiveDoc

      boolstatus = Part.Extension.SelectByID2("Fasteners", "FTRFOLDER", 0, 0, 0, False, 0, Nothing, 0)

      Part.EditSuppress2

      Part.ClearSelection2 True

      End Sub

      *************************************************

        • Re: Macro which suppresses all folders of the same name in an assembly
          Deepak Gupta

          If you're to suppress the fasteners in the assembly, then go to Tools > Component Selection > Select Toolbox. This would select all toolbox files in the top level assembly including sub-assembly. Then right click and select suppress/unsuppress.

           

          This would be faster than macro and would be easy to use.

          • Re: Macro which suppresses all folders of the same name in an assembly
            Yuvaraj Sakthivel

            Dear Sir,

             

            Try the below macro, Kindly check and let me know

             

            Option Explicit

            Dim swApp As SldWorks.SldWorks

            Dim swModel As SldWorks.ModelDoc2

            Dim swAsm As SldWorks.AssemblyDoc

            Dim swcomp As SldWorks.Component2

            Dim swModelComp As SldWorks.ModelDoc2

             

            Sub main()

            Set swApp = Application.SldWorks

            Set swModel = swApp.ActiveDoc

            Set swAsm = swModel

            Dim vComp As Variant

            Dim i As Integer

            vComp = swAsm.GetComponents(True)

            For i = 0 To UBound(vComp)

            Set swcomp = vComp(i)

            If Not swcomp Is Nothing Then

            Dim s As Integer

            s = swcomp.GetSuppression

            If Not s = 0 Then

            Dim strComp As String

            strComp = swcomp.Name2

            Set swModelComp = swcomp.GetModelDoc2

            Dim t As Integer

            t = swModelComp.GetType

            If t = 1 Then

            Dim ret As Long

            ret = swModelComp.Extension.ToolboxPartType

            If ret = 1 Then

            swcomp.Select4 True, Nothing, False

            End If

            End If

            End If

            End If

            Next i

            swModel.EditSuppress2

            swModel.ClearSelection2 True

            swModel.ForceRebuild3 True

            End Sub

             

            Regards,

            Yuvaraj S

              • Re: Macro which suppresses all folders of the same name in an assembly
                Kyle Schutte

                Yuvaraj,

                 

                Thank you for the response.

                I ran the macro and I get the following error:

                 

                 

                From the following code:

                 

                t = swModelComp.GetType

                 

                My macro skills are not the best so I'm not entirely sure why I am getting this error, as the variable 't' is set in the prior line as an integer.

                Any insight is appreciated.

                  • Re: Macro which suppresses all folders of the same name in an assembly
                    Yuvaraj Sakthivel

                    If  swModelComp is nothing , this error may come. Add if condition above that line.

                     

                    Check with the below macro.

                     

                    Option Explicit

                     

                     

                    Dim swApp As SldWorks.SldWorks

                    Dim swModel As SldWorks.ModelDoc2

                    Dim swAsm As SldWorks.AssemblyDoc

                    Dim swcomp As SldWorks.Component2

                    Dim swModelComp As SldWorks.ModelDoc2

                    Dim swPart As SldWorks.PartDoc

                     

                    Sub main()

                    Set swApp = Application.SldWorks

                    Set swModel = swApp.ActiveDoc

                    Set swAsm = swModel

                    Dim vComp As Variant

                    Dim i As Integer

                    vComp = swAsm.GetComponents(True)

                    For i = 0 To UBound(vComp)

                    Set swcomp = vComp(i)

                    If Not swcomp Is Nothing Then

                    Dim s As Integer

                    s = swcomp.GetSuppression

                    If Not s = 0 Then

                    Dim strComp As String

                    strComp = swcomp.Name2

                    Set swModelComp = swcomp.GetModelDoc2

                    If Not swModelComp Is Nothing Then

                    Dim t As Integer

                    t = swModelComp.GetType

                    If t = 1 Then

                    Dim ret As Long

                    ret = swModelComp.Extension.ToolboxPartType

                    If ret = 1 Then

                    swcomp.Select4 True, Nothing, False

                    End If

                    End If

                    End If

                    End If

                    End If

                    Next i

                    swModel.EditSuppress2

                    swModel.ClearSelection2 True

                    swModel.ForceRebuild3 True

                    End Sub

                • Re: Macro which suppresses all folders of the same name in an assembly
                  Keith Rice

                  IAssemblyDoc::GetComponents won't work because it returns components, and a folder is not a component. Rather, it is necessary to find the folder as an IFeature object and suppress it.

                   

                  Option Compare Text
                  
                  Const FOLDER_NAME As String = "Fasteners"
                  
                  Sub main()
                      Dim swApp As SldWorks.SldWorks
                      Dim swModel As SldWorks.ModelDoc2
                      
                      Set swApp = Application.SldWorks
                      Set swModel = swApp.ActiveDoc
                      
                      TraverseModel swModel, swModel, 1
                  End Sub
                  
                  Private Sub TraverseModel(swModel As SldWorks.ModelDoc2, model As Object, nLevel As Integer)
                      Dim swFeat As SldWorks.Feature
                      Dim swComp As SldWorks.Component2
                      
                      Set swFeat = model.FirstFeature
                      
                      Do While Not swFeat Is Nothing
                          If swFeat.Name = FOLDER_NAME And _
                              swFeat.GetTypeName = "FtrFolder" Then
                              
                              swFeat.Select2 False, Empty
                              swModel.EditSuppress2
                              
                          End If
                          
                          If swFeat.GetTypeName = "Reference" Then
                              Set swComp = swFeat.GetSpecificFeature2
                              TraverseModel swModel, swComp, nLevel + 1
                          End If
                          
                          Set swFeat = swFeat.GetNextFeature
                      Loop
                  End Sub
                  

                   

                  Keith

                  SolidWorks API Training