4 Replies Latest reply on Jul 12, 2016 3:13 PM by Christopher Washington

    Populate drawing title block with weldment cut list member properties

    Terry Raymond

      I figured this out with much help from yall's posts on this forum.  Sharing macro as thanks!  There have been a few posts in the past that didn't arrive at a solution; will point them here.

      Let me know if you see a way to improve!

       

      Sub main()

          Dim swApp As SldWorks.SldWorks

          Dim swDraw As SldWorks.DrawingDoc

          Dim swSheet As SldWorks.Sheet

          Dim swView As SldWorks.View

                

          Dim swModel As SldWorks.ModelDoc2

          Dim swFeature As SldWorks.Feature

          Dim swBodyFolder As SldWorks.BodyFolder

          Dim swCustPropMgr As SldWorks.CustomPropertyManager

                     

          Dim bool As Boolean

          Dim sViewName, sViewBodyName, sBodyName, sPropVal As String

                     

          Set swApp = Application.SldWorks

          Set swDraw = swApp.ActiveDoc

          bool = swDraw.ActivateSheet(swDraw.GetSheetNames(0))

          Set swSheet = swDraw.GetCurrentSheet

          Set swView = swDraw.GetFirstView

         

          'Find the main referenced view of the document on sheet1.  If default, find the first view.

          If swSheet.CustomPropertyView = "Default" Then

              Do While Not swView Is Nothing

                  If (swView.ReferencedDocument Is Nothing) Then

                      Set swView = swView.GetNextView 'skip empty sheet "views" etc

                  Else

                      sViewName = swView.Name

                      Exit Do

                  End If

              Loop

          Else

              sViewName = swSheet.CustomPropertyView

              Do While swView.Name <> sViewName And Not swView Is Nothing

                  Set swView = swView.GetNextView

              Loop

          End If

         

          'If no referenced document was found, swView will be empty.  So no use trying to copy variables from a part.

          If swView Is Nothing Then Exit Sub

         

          Set swModel = swView.ReferencedDocument

                

          'If it is a view of a single body Weldment Member, get cutlist properties & populate title block

          If swModel.GetType = swDocPART Then

              If swModel.IsWeldment And swView.GetBodiesCount = 1 Then

              sViewBodyName = swView.Bodies(0).GetSelectionId

              sBodyName = Left(sViewBodyName, InStr(sViewBodyName, "@") - 1)

             

              'Loop thru all features looking for cutlist items

              Set swFeature = swModel.FirstFeature

              Do While Not swFeature Is Nothing

                  If swFeature.GetTypeName = "CutListFolder" Then

                      Set swBodyFolder = swFeature.GetSpecificFeature2

                     

                      'Loop through cutlist looking for body.  Should only be one body, but loop just to be sure.

                      For i = 0 To UBound(swBodyFolder.GetBodies)

                          If swBodyFolder.GetBodies(i).Name = sBodyName Then

                         

                              'Body found! This is where the properties are

                              Set swCustPropMgr = swFeature.CustomPropertyManager

                              Exit Do

                          End If

                      Next i

                     

                  End If

                  Set swFeature = swFeature.GetNextFeature

              Loop

              End If

          End If

         

          'get custom properties from normal model if weldment info not found

          If swCustPropMgr Is Nothing Then

              Set swCustPropMgr = swModel.Extension.CustomPropertyManager(swView.ReferencedConfiguration)

          End If

         

          sPropVal = swCustPropMgr.Get("PartNumber")

          bool = swDraw.Extension.CustomPropertyManager("").Add2("PartNumber", swCustomInfoText, sPropVal)

          bool = swDraw.Extension.CustomPropertyManager("").Set("PartNumber", sPropVal)

         

          sPropVal = swCustPropMgr.Get("Description")

          bool = swDraw.Extension.CustomPropertyManager("").Add2("Description", swCustomInfoText, sPropVal)

          bool = swDraw.Extension.CustomPropertyManager("").Set("Description", sPropVal)

       

       

          swDraw.EditRebuild3

       

       

      End Sub

        • Re: Populate drawing title block with weldment cut list member properties
          Christopher Washington

          Not a programmer or anything. Just did "create macro" and made sure I pasted the body between the header and footer of the macro. I'm in the drawing with "selected body" and when I run it I get "Run-time error '13': Type mismatch"

           

          When I debug, it takes me to the following, with the second line being what's highlighted.

           

          'Loop through cutlist looking for body. Should only be one body, but loop just to be sure.

              For i = 0 To UBound (swBodyFolder.GetBodies)

            • Re: Populate drawing title block with weldment cut list member properties
              Terry Raymond

              Post your whole macro and I'm sure I or someone else can help.

              • Re: Populate drawing title block with weldment cut list member properties
                Simon Turner

                Either swBodyFolder has not been set correctly, or swBodyFolder.GetBodies is returning 0 bodies.

                You should check for that before trying to loop through the bodies. Something like this:

                Dim myBodies as Variant

                myBodies = swBodyFolder.GetBodies

                If IsEmpty(myBodies) = False Then

                     ...the loop

                End If

                 

                And make sure that you do have a CutlistFolder feature in the feature tree (add a weldment feature if not).

                  • Re: Populate drawing title block with weldment cut list member properties
                    Christopher Washington

                    Dim swApp As Object

                    Sub main()

                        Dim swApp As SldWorks.SldWorks

                        Dim swDraw As SldWorks.DrawingDoc

                        Dim swSheet As SldWorks.Sheet

                        Dim swView As SldWorks.View

                             

                        Dim swModel As SldWorks.ModelDoc2

                        Dim swFeature As SldWorks.Feature

                        Dim swBodyFolder As SldWorks.BodyFolder

                        Dim swCustPropMgr As SldWorks.CustomPropertyManager

                                  

                        Dim bool As Boolean

                        Dim sViewName, sViewBodyName, sBodyName, sPropVal As String

                                  

                        Set swApp = Application.SldWorks

                        Set swDraw = swApp.ActiveDoc

                        bool = swDraw.ActivateSheet(swDraw.GetSheetNames(0))

                        Set swSheet = swDraw.GetCurrentSheet

                        Set swView = swDraw.GetFirstView

                      

                        'Find the main referenced view of the document on sheet1.  If default, find the first view.

                        If swSheet.CustomPropertyView = "Default" Then

                            Do While Not swView Is Nothing

                                If (swView.ReferencedDocument Is Nothing) Then

                                    Set swView = swView.GetNextView 'skip empty sheet "views" etc

                                Else

                                    sViewName = swView.Name

                                    Exit Do

                                End If

                            Loop

                        Else

                            sViewName = swSheet.CustomPropertyView

                            Do While swView.Name <> sViewName And Not swView Is Nothing

                                Set swView = swView.GetNextView

                            Loop

                        End If

                      

                        'If no referenced document was found, swView will be empty.  So no use trying to copy variables from a part.

                        If swView Is Nothing Then Exit Sub

                      

                        Set swModel = swView.ReferencedDocument

                             

                        'If it is a view of a single body Weldment Member, get cutlist properties & populate title block

                        If swModel.GetType = swDocPART Then

                            If swModel.IsWeldment And swView.GetBodiesCount = 1 Then

                            sViewBodyName = swView.Bodies(0).GetSelectionId

                            sBodyName = Left(sViewBodyName, InStr(sViewBodyName, "@") - 1)

                          

                            'Loop thru all features looking for cutlist items

                            Set swFeature = swModel.FirstFeature

                            Do While Not swFeature Is Nothing

                                If swFeature.GetTypeName = "CutListFolder" Then

                                    Set swBodyFolder = swFeature.GetSpecificFeature2

                                  

                                    'Loop through cutlist looking for body.  Should only be one body, but loop just to be sure.

                                    For i = 0 To UBound(swBodyFolder.GetBodies)

                                        If swBodyFolder.GetBodies(i).Name = sBodyName Then

                                      

                                            'Body found! This is where the properties are

                                            Set swCustPropMgr = swFeature.CustomPropertyManager

                                            Exit Do

                                        End If

                                    Next i

                                  

                                End If

                                Set swFeature = swFeature.GetNextFeature

                            Loop

                            End If

                        End If

                      

                        'get custom properties from normal model if weldment info not found

                        If swCustPropMgr Is Nothing Then

                            Set swCustPropMgr = swModel.Extension.CustomPropertyManager(swView.ReferencedConfiguration)

                        End If

                      

                        sPropVal = swCustPropMgr.Get("PartNumber")

                        bool = swDraw.Extension.CustomPropertyManager("").Add2("PartNumber", swCustomInfoText, sPropVal)

                        bool = swDraw.Extension.CustomPropertyManager("").Set("PartNumber", sPropVal)

                      

                        sPropVal = swCustPropMgr.Get("Description")

                        bool = swDraw.Extension.CustomPropertyManager("").Add2("Description", swCustomInfoText, sPropVal)

                        bool = swDraw.Extension.CustomPropertyManager("").Set("Description", sPropVal)

                     

                     

                        swDraw.EditRebuild3

                     

                     

                    Set swApp = Application.SldWorks

                    End Sub

                    Like I said, I just pasted what was provided where I thought it was supposed to go. So it should look like the one that was provided before so far as I know. I'm just figuring it was a different version back then and who knows what has changed insofar as this stuff goes.

                     

                    There's definitely a weldment cutlist with several bodies that have a unique description, part number, and drawing number but it's under:

                    Description

                    DRAWN BY

                    DateCompleted

                    PartNo

                    DRAWING NO

                     

                    I'm under the impression that I could do a "select bodies" and it'll pull the cutlist properties of the selected body and subsequently populate the title block with the relevant information. Thanks in advance!