Terry Raymond

Populate drawing title block with weldment cut list member properties

Discussion created by Terry Raymond on Nov 22, 2014
Latest reply on Jul 12, 2016 by Christopher Washington

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

Outcomes