Populate drawing title block with weldment cut list member properties

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!

<p>Sub main()</p><p>    Dim swApp As SldWorks.SldWorks</p><p>    Dim swDraw As SldWorks.DrawingDoc</p><p>    Dim swSheet As SldWorks.Sheet</p><p>    Dim swView As SldWorks.View</p><p>           </p><p>    Dim swModel As SldWorks.ModelDoc2</p><p>    Dim swFeature As SldWorks.Feature</p><p>    Dim swBodyFolder As SldWorks.BodyFolder</p><p>    Dim swCustPropMgr As SldWorks.CustomPropertyManager</p><p>                </p><p>    Dim bool As Boolean</p><p>    Dim sViewName, sViewBodyName, sBodyName, sPropVal As String</p><p>                </p><p>    Set swApp = Application.SldWorks</p><p>    Set swDraw = swApp.ActiveDoc</p><p>    bool = swDraw.ActivateSheet(swDraw.GetSheetNames(0))</p><p>    Set swSheet = swDraw.GetCurrentSheet</p><p>    Set swView = swDraw.GetFirstView</p><p>    </p><p>    'Find the main referenced view of the document on sheet1.  If default, find the first view.</p><p>    If swSheet.CustomPropertyView = "Default" Then</p><p>        Do While Not swView Is Nothing</p><p>            If (swView.ReferencedDocument Is Nothing) Then</p><p>                Set swView = swView.GetNextView 'skip empty sheet "views" etc</p><p>            Else</p><p>                sViewName = swView.Name</p><p>                Exit Do</p><p>            End If</p><p>        Loop</p><p>    Else</p><p>        sViewName = swSheet.CustomPropertyView</p><p>        Do While swView.Name <> sViewName And Not swView Is Nothing</p><p>            Set swView = swView.GetNextView</p><p>        Loop</p><p>    End If</p><p>    </p><p>    'If no referenced document was found, swView will be empty.  So no use trying to copy variables from a part.</p><p>    If swView Is Nothing Then Exit Sub</p><p>    </p><p>    Set swModel = swView.ReferencedDocument</p><p>           </p><p>    'If it is a view of a single body Weldment Member, get cutlist properties & populate title block</p><p>    If swModel.GetType = swDocPART Then</p><p>        If swModel.IsWeldment And swView.GetBodiesCount = 1 Then</p><p>        sViewBodyName = swView.Bodies(0).GetSelectionId</p><p>        sBodyName = Left(sViewBodyName, InStr(sViewBodyName, "@") - 1)</p><p>        </p><p>        'Loop thru all features looking for cutlist items</p><p>        Set swFeature = swModel.FirstFeature</p><p>        Do While Not swFeature Is Nothing</p><p>            If swFeature.GetTypeName = "CutListFolder" Then</p><p>                Set swBodyFolder = swFeature.GetSpecificFeature2</p><p>                </p><p>                'Loop through cutlist looking for body.  Should only be one body, but loop just to be sure.</p><p>                For i = 0 To UBound(swBodyFolder.GetBodies)</p><p>                    If swBodyFolder.GetBodies(i).Name = sBodyName Then</p><p>                    </p><p>                        'Body found! This is where the properties are</p><p>                        Set swCustPropMgr = swFeature.CustomPropertyManager</p><p>                        Exit Do</p><p>                    End If</p><p>                Next i</p><p>                </p><p>            End If</p><p>            Set swFeature = swFeature.GetNextFeature</p><p>        Loop</p><p>        End If</p><p>    End If</p><p>    </p><p>    'get custom properties from normal model if weldment info not found</p><p>    If swCustPropMgr Is Nothing Then</p><p>        Set swCustPropMgr = swModel.Extension.CustomPropertyManager(swView.ReferencedConfiguration)</p><p>    End If</p><p>    </p><p>    sPropVal = swCustPropMgr.Get("PartNumber")</p><p>    bool = swDraw.Extension.CustomPropertyManager("").Add2("PartNumber", swCustomInfoText, sPropVal)</p><p>    bool = swDraw.Extension.CustomPropertyManager("").Set("PartNumber", sPropVal)</p><p>    </p><p>    sPropVal = swCustPropMgr.Get("Description")</p><p>    bool = swDraw.Extension.CustomPropertyManager("").Add2("Description", swCustomInfoText, sPropVal)</p><p>    bool = swDraw.Extension.CustomPropertyManager("").Set("Description", sPropVal)</p><p></p><p></p><p>    swDraw.EditRebuild3</p><p></p><p></p><p>End Sub</p>
SolidworksApi macros