26 Replies Latest reply on Sep 7, 2018 8:51 AM by Cad Admin

    VBA -  Get names of Subassembly Components in a Drawing

    Cad Admin

      I'm starting a macro.  I need to get the names of ALL components in a view....including sub-assembly components many levels deep.

       

      I was looking at starting with the macro below, but it doesn't go deeper than 1 level..

      2018 SOLIDWORKS API Help - Get Components in Drawing View Example (VBA)

        • Re: VBA -  Get names of Subassembly Components in a Drawing
          Sergio Monti

          Hi Cad Admin , I don't know if you need it to be shown on a drawing. If not and you just need it as a list of data, you can use an indented BOM, export to excel, sort by name and eliminate duplicates.

          I know it's a workaround but it's easy.

          • Re: VBA -  Get names of Subassembly Components in a Drawing
            Cad Admin

            Sergio,

            Nope, what I'm doing is I'm scanning the drawing views and looking for specific parts with names, to change the layer on the drawings.  Ive got it to work, but only at the root assembly level...not in any sub-assemblies.

              • Re: VBA -  Get names of Subassembly Components in a Drawing
                Sergio Monti

                You can still use indented BOM. It will give all the parts and assemblies.

                • Re: VBA -  Get names of Subassembly Components in a Drawing
                  Alex Burnett

                  It would be possible if you use recursion to get many levels deep. The macro function outlined below iterates through all components on a print and moves them to another layer. I did not write this and I don't remember who did.

                   

                  Sub ProcessDrawingComponent _
                  ( _
                  swApp As SldWorks.SldWorks, _
                  swDraw As SldWorks.DrawingDoc, _
                  swDrawComp As SldWorks.DrawingComponent, _
                  sPadStr As String, _
                  sChildrenOnSeparateLayers As Boolean _
                  )
                  
                  
                      Dim vDrawCompChildArr As Variant
                      Dim vDrawCompChild As Variant
                      Dim swDrawCompChild As SldWorks.DrawingComponent
                      'Dim swChildComp As SldWorks.Component2
                      Debug.Print sPadStr & swDrawComp.Name
                      
                      ChangeComponentLayer swApp, swDraw, swDrawComp, swDrawComp.Name
                      
                      vDrawCompChildArr = swDrawComp.GetChildren
                      
                      If Not IsEmpty(vDrawCompChildArr) Then
                      
                          For Each vDrawCompChild In vDrawCompChildArr
                          Set swDrawCompChild = vDrawCompChild
                          'Set swChildComp = swDrawCompChild.Component
                          If sChildrenOnSeparateLayers = True Then
                              ProcessDrawingComponent swApp, swDraw, swDrawCompChild, sPadStr + " ", sChildrenOnSeparateLayers
                          End If
                          
                          Next
                      End If
                  
                  
                  End Sub
                  
                • Re: VBA -  Get names of Subassembly Components in a Drawing
                  Cad Admin

                  This is where i am at...like i said works well, just not with sub assemblies  Also its still a little dirty, need to clean it up

                   

                  Sub mainChange()

                   

                      Dim swApp                      As SldWorks.SldWorks

                      Dim swModel                    As SldWorks.ModelDoc2

                      Dim swDraw                     As SldWorks.DrawingDoc

                      Dim swSelMgr                   As SldWorks.SelectionMgr

                      Dim swSelData                  As SldWorks.SelectData

                      Dim swModelDocExt              As SldWorks.ModelDocExtension

                      Dim swView                     As SldWorks.View

                      Dim swRootDrawComp             As SldWorks.DrawingComponent

                      Dim vDrawChildCompArr          As Variant

                      Dim vDrawChildComp             As Variant

                      Dim swDrawComp                 As SldWorks.DrawingComponent

                      Dim swComp                     As SldWorks.Component2

                      Dim swCompModel                As SldWorks.ModelDoc2

                      Dim assemblyDrawing            As String

                      Dim status                     As Boolean

                      Dim errors                     As Long

                      Dim warnings                   As Long

                      Dim lineWeight                 As Long

                      Dim lineThickness              As Double

                      Dim FlagFound                  As Boolean

                      Dim PartNumber                 As String

                   

                      Set swApp = Application.SldWorks

                   

                      Set swModel = swApp.ActiveDoc

                    

                      Set swDraw = swModel

                      Set swModelDocExt = swModel.Extension

                      Set swSelMgr = swModel.SelectionManager

                      Set swSelData = swSelMgr.CreateSelectData

                    

                      Set swView = swDraw.GetFirstView

                      Set swView = swView.GetNextView

                   

                      While Not swView Is Nothing

                    

                      Set swRootDrawComp = swView.RootDrawingComponent

                    

                      Debug.Print "File = " & swModel.GetPathName

                      Debug.Print "  View = " & swView.Name

                    

                      vDrawChildCompArr = swRootDrawComp.GetChildren

                    

                      For Each vDrawChildComp In vDrawChildCompArr

                          Set swDrawComp = vDrawChildComp

                        

                          'Debug.Print " Drawing component selected = " & swDrawComp.Select(True, Nothing)

                   

                          Set swComp = swDrawComp.Component

                    

                          If Not Nothing Is swComp Then

                              Set swCompModel = swComp.GetModelDoc2

                              'Debug.Print "      Component                            = " & swComp.Name2

                              PartNumber = UCase(swComp.Name2)

                            

                              If InStr(1, PartNumber, "PUR", vbTextCompare) Then

                                  swDrawComp.UseDocumentDefaults = False

                                  swDrawComp.Layer = "PART"

                                  Debug.Print "      Component                            = " & swComp.Name2

                              End If

                                            

                          End If

                   

                      Next

                        

                      Set swView = swView.GetNextView

                    

                      Wend

                   

                  swModel.ClearSelection

                   

                  End Sub

                    • Re: VBA -  Get names of Subassembly Components in a Drawing
                      Alex Burnett

                      Here's what I'm talking about when I mention recursion. You write the loop once and it will go in level by level and operate the same function before moving back out to the previous level to continue. Here's the code that is working on my machine.

                       

                      I modified your code to pull the layer move function into its own subroutine. Now, for every view you will call the ProcessDrawingComponent function and it will start and look at each component in the sub-assembly for you. I hope this makes sense. I am not sure if the check for "PUR" in the PartNumber string works or not since I didn't have that implemented but so far this seems to work.

                       

                      Sub main()
                          Dim swApp                      As SldWorks.SldWorks
                          Dim swModel                    As SldWorks.ModelDoc2
                          Dim swDraw                     As SldWorks.DrawingDoc
                          Dim swSelMgr                   As SldWorks.SelectionMgr
                          Dim swSelData                  As SldWorks.SelectData
                          Dim swModelDocExt              As SldWorks.ModelDocExtension
                          Dim swView                     As SldWorks.View
                          Dim swRootDrawComp             As SldWorks.DrawingComponent
                          Dim assemblyDrawing            As String
                          Dim status                     As Boolean
                          Dim errors                     As Long
                          Dim warnings                   As Long
                          Dim lineWeight                 As Long
                          Dim lineThickness              As Double
                          Dim FlagFound                  As Boolean
                          Dim PartNumber                 As String
                      
                          Set swApp = Application.SldWorks
                      
                          Set swModel = swApp.ActiveDoc
                        
                          Set swDraw = swModel
                          Set swModelDocExt = swModel.Extension
                          Set swSelMgr = swModel.SelectionManager
                          Set swSelData = swSelMgr.CreateSelectData
                        
                          Set swView = swDraw.GetFirstView
                          Set swView = swView.GetNextView
                          
                          Debug.Print "File = " & swModel.GetPathName
                          While Not swView Is Nothing
                        
                             Set swRootDrawComp = swView.RootDrawingComponent
                           
                             Debug.Print "  View = " & swView.Name
                           
                           'DO IT
                             If Not swRootDrawComp Is Nothing Then
                                ProcessDrawingComponent swDraw, swRootDrawComp, 1
                             End If
                             
                             Set swView = swView.GetNextView
                           
                          Wend
                      
                          swModel.ClearSelection
                      End Sub
                      
                      
                      Sub ProcessDrawingComponent _
                      ( _
                      swDraw As SldWorks.DrawingDoc, _
                      swDrawComp As SldWorks.DrawingComponent, _
                      currentLevel As Integer _
                      )
                        
                          Dim vDrawCompChildArr As Variant
                          Dim vDrawCompChild As Variant
                          Dim swDrawCompChild As SldWorks.DrawingComponent
                            
                          Dim i As Integer
                          Dim indent As String
                          For i = 0 To currentLevel + 1
                               indent = indent & "   "
                          Next
                          
                          vDrawCompChildArr = swDrawComp.GetChildren
                            
                          If Not IsEmpty(vDrawCompChildArr) Then
                            For Each vDrawChildComp In vDrawCompChildArr
                                 Set swDrawComp = vDrawChildComp
                                 Set swComp = swDrawComp.Component
                           
                                 If Not Nothing Is swComp Then
                                     Set swCompModel = swComp.GetModelDoc2
                                     Debug.Print "Level: " & currentLevel & indent & "Component" & vbTab & vbTab & "= " & swComp.Name2
                                     PartNumber = UCase(swComp.Name2)
                                   
                                     If InStr(1, PartNumber, "PUR", vbTextCompare) Then
                                         swDrawComp.UseDocumentDefaults = False
                                         swDrawComp.Layer = "PART"
                                     '    Debug.Print "      Component                            = " & swComp.Name2
                                     End If
                                     ProcessDrawingComponent swDraw, swDrawComp, currentLevel + 1
                                 End If
                          
                             Next
                          End If
                          
                      End Sub
                      

                       

                      Here's a portion of my output to show it works:

                       

                      Level: 1         Component      = 67593-1

                      Level: 1         Component      = 67593-2

                      Level: 1         Component      = 77061-4

                      Level: 1         Component      = 72850-1

                      Level: 1         Component      = 72850-2

                      Level: 1         Component      = 74366-1

                      Level: 1         Component      = 74366-3

                      Level: 1         Component      = 74366-5

                      Level: 1         Component      = 74366-7

                      Level: 1         Component      = 74084-1

                      Level: 1         Component      = 74084-2

                      Level: 1         Component      = 72932-1

                      Level: 1         Component      = 74076-1

                      Level: 2            Component       = 74076-1/76494-1

                      Level: 3               Component        = 74076-1/76494-1/76501-1

                      Level: 3               Component        = 74076-1/76494-1/76498-1

                      Level: 3               Component        = 74076-1/76494-1/76498-2

                      Level: 3               Component        = 74076-1/76494-1/76500-1

                      Level: 3               Component        = 74076-1/76494-1/77246-1

                      Level: 3               Component        = 74076-1/76494-1/77246-2

                      Level: 3               Component        = 74076-1/76494-1/77265-1

                      Level: 2            Component       = 74076-1/4085-1

                      Level: 2            Component       = 74076-1/76317-1

                      Level: 2            Component       = 74076-1/78536-1

                      Level: 2            Component       = 74076-1/5465-1

                      Level: 2            Component       = 74076-1/76684-1

                      Level: 2            Component       = 74076-1/76632-1

                      Level: 2            Component       = 74076-1/9011-1

                      Level: 1         Component      = 74076-3

                       

                    • Re: VBA -  Get names of Subassembly Components in a Drawing
                      Josh Brady

                      There are lots of ways to get components.

                      If you're just looking for certain ones and you don't give two poops about the structure, get the view's referenced model and use GetComponents(False).  You'll get an array of all the components at all levels that's easy to cycle through.

                      • Re: VBA -  Get names of Subassembly Components in a Drawing
                        Keith Rice

                        Below is code that will get the components of a selected view and you can adapt it for an entire drawing if you wish. This code works with part views, empty views, and section views. If you know you won't encounter those kinds of views then you can use IView.ReferencedDocument like Josh Brady to shorten the code even more. Note that IAssemblyDoc.GetComponents() does not return components in order. If you want to do that then you will need to recursively traverse the feature tree like this example in my Macro Library. (Note: The macro I just linked to is NOT the same as this traversal macro in the SolidWorks API Help, which is less versatile and much longer.)

                         

                        Sub main()
                            Dim swApp As SldWorks.SldWorks
                            Dim swModel As ModelDoc2
                            Dim swSelMgr As SelectionMgr
                            Dim swView As View
                            Dim swDrwComp As DrawingComponent
                            Dim swComp As Component2
                            Dim swCompModel As ModelDoc2
                            Dim swAssy As AssemblyDoc
                            Dim vComps As Variant
                            Dim i As Integer
                            
                            Set swApp = Application.SldWorks
                            Set swModel = swApp.ActiveDoc
                            Set swSelMgr = swModel.SelectionManager
                            Set swView = swSelMgr.GetSelectedObject6(1, -1)
                            Set swDrwComp = swView.RootDrawingComponent
                            
                            If swDrwComp Is Nothing Then
                                Debug.Print "No components in view."
                                Exit Sub
                            End If
                            
                            Set swComp = swDrwComp.Component
                            
                            If swComp Is Nothing Then
                                Debug.Print "No components in view because view references a part."
                                Exit Sub
                            End If
                            
                            Set swCompModel = swComp.GetModelDoc2
                            
                            If swCompModel Is Nothing Then
                                Debug.Print "Could not access underlying model."
                                Exit Sub
                            End If
                            
                            Debug.Print "Components in view:"
                            
                            If swCompModel.GetType = swDocPART Then
                                Debug.Print vbTab & swComp.Name2
                            Else
                                
                                Set swAssy = swCompModel
                                vComps = swAssy.GetComponents(False)
                                
                                For i = 0 To UBound(vComps)
                                Set swComp = vComps(i)
                                    Debug.Print vbTab & swComp.Name2
                                Next i
                            End If
                        End Sub
                        

                        Keith

                        SolidWorks API Training and Services

                        • Re: VBA -  Get names of Subassembly Components in a Drawing
                          Cad Admin

                          Thanks all for the input. I will review, and update to my solution.

                          • Re: VBA -  Get names of Subassembly Components in a Drawing
                            Cad Admin

                            Alright, here is where it is at.  I can get the views, their configs, the code cycles and changes only certain parts. i have attached the debug.print output to show, the level 1 parts do not change. I even manually by clicking the part, then change the component line font, it just doesn't change.

                             

                            Code:

                             

                            Option Explicit

                             

                            Sub main()

                                Dim swApp                      As SldWorks.SldWorks

                                Dim swModel                    As SldWorks.ModelDoc2

                                Dim swAssy                     As AssemblyDoc

                                Dim swDraw                     As SldWorks.DrawingDoc

                                Dim swSelMgr                   As SldWorks.SelectionMgr

                                Dim swSelData                  As SldWorks.SelectData

                                Dim swModelDocExt              As SldWorks.ModelDocExtension

                                Dim swView                     As SldWorks.View

                                Dim swRootDrawComp             As SldWorks.DrawingComponent

                                Dim assemblyDrawing            As String

                                Dim status                     As Boolean

                                Dim errors                     As Long

                                Dim warnings                   As Long

                                Dim PartNumber                 As String

                                Dim bRet                       As Boolean

                                Dim sConfigName                As String

                             

                                Set swApp = Application.SldWorks

                                Set swModel = swApp.ActiveDoc

                               

                                Set swDraw = swModel

                                Set swModelDocExt = swModel.Extension

                                Set swSelMgr = swModel.SelectionManager

                                Set swSelData = swSelMgr.CreateSelectData

                               

                                Set swView = swDraw.GetFirstView

                                Set swView = swView.GetNextView

                                 

                                Debug.Print "File = " & swModel.GetPathName

                                While Not swView Is Nothing

                               

                                   Set swDrawModel = swView.ReferencedDocument

                                   Set swRootDrawComp = swView.RootDrawingComponent

                                  

                                   sConfigName = swView.ReferencedConfiguration

                                   bRet = swDrawModel.ShowConfiguration2(sConfigName)

                                   Set swAssy = swDrawModel

                                  

                                    Debug.Print "  View = " & swView.Name

                                    'Debug.Print "    Referenced model name = " & swView.GetReferencedModelName

                                    Debug.Print "    Referenced configuration name = " & swView.ReferencedConfiguration

                                    Debug.Print "    Referenced configuration persistent reference ID = " & swView.ReferencedConfigurationID

                                  

                                 'DO IT

                                   If Not swRootDrawComp Is Nothing Then

                                    swRootDrawComp.UseDocumentDefaults = False

                                      ProcessDrawingComponent swDraw, swRootDrawComp, 1

                                   End If

                                    

                                   Set swView = swView.GetNextView

                                  

                                Wend

                             

                                swModel.ClearSelection

                            End Sub

                             

                             

                            Sub ProcessDrawingComponent(swDraw As SldWorks.DrawingDoc, swDrawComp As SldWorks.DrawingComponent, currentLevel As Integer)

                             

                               

                                Dim vDrawCompChildArr As Variant

                                Dim vDrawCompChild As Variant

                                Dim swDrawCompChild As SldWorks.DrawingComponent

                                   

                                Dim i As Integer

                                Dim indent As String

                               

                               

                                For i = 0 To currentLevel + 1

                                     indent = indent & "   "

                                Next

                                 

                                vDrawCompChildArr = swDrawComp.GetChildren

                               

                                If Not IsEmpty(vDrawCompChildArr) Then

                                  For Each vDrawChildComp In vDrawCompChildArr

                                       Set swDrawComp = vDrawChildComp

                                       Set swComp = swDrawComp.Component

                                  

                                       If Not Nothing Is swComp Then

                                           Set swCompModel = swComp.GetModelDoc2

                                           PartNumber = UCase(swComp.Name2)

                                          

                                           If InStr(1, PartNumber, "PUR", vbTextCompare) Then

                            swDrawComp.UseDocumentDefaults = False

                                               swDrawComp.Layer = "PART"

                                               'swDrawComp.LayerOverride = 0

                                               Debug.Print "      Level: " & currentLevel & "  Component" & vbTab & "= " & swComp.Name2 & "      Layer: " & swDrawComp.Layer

                                           End If

                                          

                                           ProcessDrawingComponent swDraw, swDrawComp, currentLevel + 1

                                       End If

                                   Next

                                End If

                            End Sub

                             

                            Debug: (common denominator is the parts are all level 1 parts...)

                             

                            File = C:\Users\admin\Desktop\A6200.SLDDRW

                              View = Drawing View17

                                Referenced configuration name = 5TH STAGE

                                Referenced configuration persistent reference ID = 3

                                  Level: 1 Component   = 30G4755_C_PUR-1      Layer:

                                  Level: 1 Component   = 30G1907_C_PUR-1      Layer:

                                  Level: 1 Component   = 30G1862_A_PUR-1      Layer:

                              View = Drawing View18

                                Referenced configuration name = 7TH STAGE

                                Referenced configuration persistent reference ID = 4

                                  Level: 1 Component   = 30G1862_A_PUR-1      Layer:

                                  Level: 2 Component   = 30G1862_A_PUR-1/30G1863_A_PUR-1      Layer: PART

                                  Level: 2 Component   = 30G1862_A_PUR-1/30G1864_A_PUR-9      Layer: PART

                                  Level: 2 Component   = 30G1862_A_PUR-1/30G1864_A_PUR-6      Layer: PART

                                  Level: 2 Component   = 30G1862_A_PUR-1/30G1864_A_PUR-3      Layer: PART

                                  Level: 2 Component   = 30G1862_A_PUR-1/30G1864_A_PUR-5      Layer: PART

                            Level: 2  Component   = 30G1862_A_PUR-1/30G1864_A_PUR-4      Layer: PART

                                  Level: 2 Component   = 30G1862_A_PUR-1/30G1864_A_PUR-7      Layer: PART

                                  Level: 2 Component   = 30G1862_A_PUR-1/30G1864_A_PUR-8      Layer: PART

                                  Level: 2 Component   = 30G1862_A_PUR-1/30G1864_A_PUR-1      Layer: PART

                                  Level: 2 Component   = 30G1862_A_PUR-1/30G1865_001_PUR-1      Layer: PART

                                  Level: 1 Component   = 30G4755_C_PUR-1      Layer:

                                  Level: 1 Component   = 30G1907_C_PUR-1      Layer:

                              • Re: VBA -  Get names of Subassembly Components in a Drawing
                                Cad Admin

                                Think I figured it out…I can change layers fine…if the components of the view are the configuration used when creating the drawing view.  If I change the configuration of the view, it starts having issues, changing the parts. 

                                 

                                Which bring me back to the configuration changes being the issue.

                                 

                                All-in-all, the code does what i want, how i want, there are just certain conditions on some parts that prevent me from getting the results i want.

                              • Re: VBA -  Get names of Subassembly Components in a Drawing
                                Cad Admin

                                Just found this...looks like possibly my issue...damnit...lol!!!

                                SPR 771964