12 Replies Latest reply on Dec 1, 2018 3:08 AM by Marco Cicolini

    Isolate components with the same appearence

    Marco Cicolini

      Hello.

      We just bought a company which was working with solidworks, I have a huge database to work on and syncronize with ours.

      My problem is the following, I need to select and isolate all the components in an assembly with the same appearence.

      I now I could create a property with the appearence name in order to filter the assembly, but I have thousands of components, is there any possibility to create a macro that does this job? Or any other way to filter and isolate them in the assembly?

      Thanks in advance

        • Re: Isolate components with the same appearence
          Marco Cicolini

          I found this great macro, but it doesn't work in an assembly. Does anyone know if is possible to modify it to make it work in an assembly?

          I'm struggling to make it work, but i'm not really good with VBA coding...

          Macro - Select surfaces by a colour

            • Re: Isolate components with the same appearence
              Fifi Riri

              This will create a new display state with all parts that have the "SOLIDWORKS Materials|Plain Carbon Steel|9" appearance

               

              Option Explicit

              Dim status As Boolean

              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.GetRootComponent3(True)

                  swModel.ClearSelection2 True

                  TraverseComponent swRootComp

                  status = swModel.Isolate

                  status = swModel.SaveIsolate("Test_Display_State")

              End Sub

              Sub TraverseComponent(swComp As SldWorks.Component2)

                  Dim vChilds As Variant

                  Dim vChild As Variant

                  Dim swChildComp As SldWorks.Component2

                  Dim swPart As SldWorks.PartDoc

                  Dim swSelData As SldWorks.SelectData

                  vChilds = swComp.GetChildren

                  For Each vChild In vChilds

                      Set swChildComp = vChild

                      Set swPart = swChildComp.GetModelDoc2

                      Debug.Print "Appearance of " & swChildComp.Name2 & " : " & swPart.MaterialIdName

                      If swPart.MaterialIdName = "SOLIDWORKS Materials|Plain Carbon Steel|9" Then

                          Set swSelData = swPart.SelectionManager.CreateSelectData

                          status = swChildComp.Select4(True, swSelData, False)

                      End If

                      TraverseComponent swChildComp

                  Next

              End Sub

                • Re: Isolate components with the same appearence
                  Marco Cicolini

                  Sorry, I tried it (I replaced SOLIDWORKS Materials|Plain Carbon Steel|9 with one of the appearence I find in my assembly) but I get this error message back: Run time error '13"

                  If I run the debug it highlight this string: Set swPart = swChildComp.GetModelDoc2

                    • Re: Isolate components with the same appearence
                      Fifi Riri

                      My bad. Try this:

                       

                      Option Explicit

                      Dim status As Boolean

                      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.GetRootComponent3(True)

                          swModel.ClearSelection2 True

                          TraverseComponent swRootComp

                          status = swModel.Isolate

                          status = swModel.SaveIsolate("Test_Display_State")

                      End Sub

                      Sub TraverseComponent(swComp As SldWorks.Component2)

                          Dim vChilds As Variant

                          Dim vChild As Variant

                          Dim swChildComp As SldWorks.Component2

                          Dim swModel As SldWorks.ModelDoc2

                          Dim swSelData As SldWorks.SelectData

                          vChilds = swComp.GetChildren

                          For Each vChild In vChilds

                              Set swChildComp = vChild

                              Set swModel = swChildComp.GetModelDoc2

                              If swModel.GetType = swDocumentTypes_e.swDocPART Then

                                  Debug.Print "Appearance of " & swChildComp.Name2 & " : " & swModel.MaterialIdName

                                  If swModel.MaterialIdName = "SOLIDWORKS Materials|Plain Carbon Steel|9" Then

                                      Set swSelData = swModel.SelectionManager.CreateSelectData

                                      status = swChildComp.Select4(True, swSelData, False)

                                  End If

                              Else

                                  TraverseComponent swChildComp

                              End If

                          Next

                      End Sub

                        • Re: Isolate components with the same appearence
                          Marco Cicolini

                          First thing, many many thaks for your help!

                          I get no error back now, but in the new display state I see all the components and not only ones with the appearence I chose.

                          I replaced "SOLIDWORKS Materials|Plain Carbon Steel|9"  with one of my appearence, for example: ral_1023_traffic yellow (which is the name of one of my apearences), is that right? Or do I have to change something else?

                          Thanks again!

                            • Re: Isolate components with the same appearence
                              Fifi Riri

                              in the immediate window of the vba editor, you will see a listing of each part material appearance name.

                              the macro will differentiate based on this list.

                              if you want the color, you might try with appearance filename instead of MaterialIdName

                                          Dim varAppearances As Variant

                                          varAppearances = swModel.Extension.GetRenderMaterials2(swDisplayStateOpts_e.swThisDisplayState, Nothing)

                                          Debug.Print "Appearance's filename: " & varAppearances(0).FileName

                                • Re: Isolate components with the same appearence
                                  Marco Cicolini

                                  Ok, thanks!

                                  So I modified the macro as following. But when I try to run tha macro I get the runtime error 91: Object variable or With block variable not set. What did I fail?

                                  Sorry my VBA level is quite low, and unfortunately our IT man doesn't really know Solidworks

                                   

                                  Option Explicit

                                  Dim status As Boolean

                                  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.GetRootComponent3(True)

                                  swModel.ClearSelection2 True

                                  TraverseComponent swRootComp

                                  status = swModel.Isolate

                                  status = swModel.SaveIsolate("Test_Display_State")

                                  End Sub

                                   

                                  Sub TraverseComponent(swComp As SldWorks.Component2)

                                  Dim vChilds As Variant

                                  Dim vChild As Variant

                                  Dim swChildComp As SldWorks.Component2

                                  Dim swModel As SldWorks.ModelDoc2

                                  Dim swPart As SldWorks.PartDoc

                                  Dim swSelData As SldWorks.SelectData

                                  Dim varAppearances As Variant

                                  varAppearances = swModel.Extension.GetRenderMaterials2(swDisplayStateOpts_e.swThisDisplayState, Nothing)

                                  vChilds = swComp.GetChildren

                                  For Each vChild In vChilds

                                  Set swChildComp = vChild

                                  Set swModel = swChildComp.GetModelDoc2

                                  If swModel.GetType = swDocumentTypes_e.swDocPART Then

                                  Set swPart = swModel

                                  Debug.Print "Appearance's filename: " & varAppearances(0).FileName

                                  If swPart.Appearence = "colore_koyo" Then

                                  Set swSelData = swPart.SelectionManager.CreateSelectData

                                  status = swChildComp.Select4(True, swSelData, False)

                                  End If

                                  End If

                                  TraverseComponent swChildComp

                                  Next

                                  End Sub

                                    • Re: Isolate components with the same appearence
                                      Fifi Riri

                                      Try this

                                       

                                      Option Explicit

                                      Dim status As Boolean

                                      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.GetRootComponent3(True)

                                          swModel.ClearSelection2 True

                                          TraverseComponent swRootComp

                                          status = swModel.Isolate

                                          status = swModel.SaveIsolate("Test_Display_State")

                                      End Sub

                                      Sub TraverseComponent(swComp As SldWorks.Component2)

                                          Dim vChilds As Variant

                                          Dim vChild As Variant

                                          Dim swChildComp As SldWorks.Component2

                                          Dim swModel As SldWorks.ModelDoc2

                                          Dim swSelData As SldWorks.SelectData

                                          Dim swAppearance As SldWorks.RenderMaterial

                                          Dim varAppearances As Variant

                                          vChilds = swComp.GetChildren

                                          For Each vChild In vChilds

                                              Set swChildComp = vChild

                                              Set swModel = swChildComp.GetModelDoc2

                                              If swModel.GetType = swDocumentTypes_e.swDocPART Then

                                                  varAppearances = swModel.Extension.GetRenderMaterials2(swDisplayStateOpts_e.swThisDisplayState, Nothing)

                                                  Set swAppearance = varAppearances(0)

                                                  Debug.Print "Appearance's filename: " & swAppearance.FileName

                                                  Debug.Print "Appearance's primary color: " & swAppearance.PrimaryColor

                                       

                                                  If swAppearance.FileName = "C:\Program Files\SOLIDWORKS Corp\SOLIDWORKS (2)\data\graphics\materials\metal\steel\cast stainless steel.p2m" Then

                                       

                                      ' Or:      If swAppearance.PrimaryColor = "12370374" Then

                                       

                                                      Set swSelData = swModel.SelectionManager.CreateSelectData

                                                      status = swChildComp.Select4(True, swSelData, False)

                                                  End If

                                              Else

                                                  TraverseComponent swChildComp

                                              End If

                                          Next

                                      End Sub

                                        • Re: Isolate components with the same appearence
                                          Marco Cicolini

                                          It works!!!   Many many many thanks!!!!

                                           

                                          Oh wait, it worked only with the first assembly, then I tried it in a second one and it didn't. So I tried it back on first and it's not working... I'm going crazy

                                          Runtime error 13: type mismatch.

                                          Running the debug it highlits the bold line:

                                                      varAppearances = swModel.Extension.GetRenderMaterials2(swDisplayStateOpts_e.swThisDisplayState, Nothing)

                                                      Set swAppearance = varAppearances(0)

                                                      Debug.Print "Appearance's filename: " & swAppearance.FileName

                                           

                                          Do you have any ideas? It worked once on this assembly.

                                          I'm trying different aeparences to see the result and try different ways

                                            • Re: Isolate components with the same appearence
                                              Fifi Riri

                                              it s possible that some part has no appearance

                                              add an IF statement

                                               

                                                          If swModel.Extension.GetRenderMaterialsCount2(swDisplayStateOpts_e.swThisDisplayState, Nothing) > 0 Then

                                                            Set swAppearance = varAppearances(0)

                                                            Debug.Print "Appearance's filename: " & swAppearance.FileName

                                                            If swAppearance.FileName = "C:\Program Files\SOLIDWORKS Corp\SOLIDWORKS (2)\data\graphics\materials\metal\steel\cast stainless steel.p2m" Then

                                                              Set swSelData = swModel.SelectionManager.CreateSelectData

                                                              status = swChildComp.Select4(True, swSelData, False)

                                                            End If

                                                          End If

                            • Re: Isolate components with the same appearence
                              Marco Cicolini

                              This is the final solution.

                               

                               

                               

                              Option Explicit

                              Dim status As Boolean

                              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.GetRootComponent3(True)

                                  swModel.ClearSelection2 True

                                  TraverseComponent swRootComp

                                  status = swModel.Isolate

                                  status = swModel.SaveIsolate("Test_Display_State")

                              End Sub

                              Sub TraverseComponent(swComp As SldWorks.Component2)

                                  Dim vChilds As Variant

                                  Dim vChild As Variant

                                  Dim swChildComp As SldWorks.Component2

                                  Dim swModel As SldWorks.ModelDoc2

                                  Dim swSelData As SldWorks.SelectData

                                  Dim swAppearance As SldWorks.RenderMaterial

                                  Dim varAppearances As Variant

                                  vChilds = swComp.GetChildren

                                  For Each vChild In vChilds

                                      Set swChildComp = vChild

                                      Set swModel = swChildComp.GetModelDoc2

                                      If swModel.GetType = swDocumentTypes_e.swDocPART Then   

                                      If swModel.Extension.GetRenderMaterialsCount2(swDisplayStateOpts_e.swThisDisplayState, Nothing) > 0 Then

                                          varAppearances = swModel.Extension.GetRenderMaterials2(swDisplayStateOpts_e.swThisDisplayState, Nothing)

                                          Set swAppearance = varAppearances(0)

                                          Debug.Print "Appearance's filename: " & swAppearance.FileName

                                          Debug.Print "Appearance's primary color: " & swAppearance.PrimaryColor

                                           If swAppearance.FileName = "h:\marco\varie\solidworks\mc_my_materials\colori ral\ral_7016_antracite.p2m" Then

                              ' Or:      If swAppearance.PrimaryColor = "4341304" Then

                                               Set swSelData = swModel.SelectionManager.CreateSelectData

                                              status = swChildComp.Select4(True, swSelData, False)

                                          End If

                                      End If

                                      Else

                                          TraverseComponent swChildComp

                                      End If

                                  Next

                              End Sub