Terry Raymond

Populate drawing title block with weldment cut list member properties

Discussion created by Terry Raymond on Nov 22, 2014
Latest reply on Sep 23, 2020 by Anup Harak

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


                sViewName = swView.Name

                Exit Do

            End If



        sViewName = swSheet.CustomPropertyView

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

            Set swView = swView.GetNextView


    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


        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)






End Sub