Casey Balderson

API: Hyperlink BOM Balloons in Drawing to Sub-Components Drawings (VBA)

Discussion created by Casey Balderson on May 16, 2019

I made this macro which will hyperlink the BOM balloon to the file with the same name as shown in it's corresponding Part Number field in the BOM, assuming the drawing exists in the same directory of the Part being linked.

FYI, Hyperlinks remain active in PDF's, so a PDF reader will try to open the SolidWorks links in the native SolidWorks application, so a modification may be necessary to link PDFs to PDFs.


' Preconditions:
' 1. Add "Microsoft Scripting Runtime" to References for "file exist"
' Postconditions:
' 1. Links all balloons to drawing with the same name & location as the item in BOM

Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
If Not swModel.GetType = swDocDRAWING Then
        MsgBox "Must run macro in drawing only."
End If
Dim swDrawDoc As SldWorks.DrawingDoc
Dim swView As SldWorks.View
Dim swNote As SldWorks.Note
Dim sheetCount As Long
Dim viewCount As Long
Dim noteCount As Long
Dim swSelectionMgr As SldWorks.SelectionMgr
Dim swAnnotation As SldWorks.Annotation
Dim swBomTableAnnotation As SldWorks.BomTableAnnotation
Dim swBomBalloonParams As SldWorks.BalloonOptions
Dim i, j As Long
Dim swBalloon As SldWorks.BalloonOptions
Dim strLink() As String
Dim strFilePath As String
Dim strFileName As String
Dim strDocName As String
Dim NameSegs() As String
Dim strExtension As String

Sub main()
    strExtension = ".SLDDRW"
    Set swApp = Application.SldWorks
    Set swModel = swApp.ActiveDoc
    Set swDrawDoc = swModel
    strFilePath = Left(swModel.GetPathName, Len(swModel.GetPathName) - 21)
    strDocName = Mid(swModel.GetPathName, Len(strFilePath) + 1)
    Dim swFeat As SldWorks.Feature
    Dim swTableAnn As SldWorks.TableAnnotation
    Dim swBomFeat As SldWorks.BomFeature
    Set swFeat = swModel.FirstFeature
    Do While Not swFeat Is Nothing
        If swFeat.GetTypeName = "BomFeat" Then
            If Not swBomFeat Is Nothing Then
                MsgBox "More than one BOM has been detected." & vbCrLf & _
                       "Only the first BOM will be used for balloon hyperlink."
                Exit Do
            End If
            Set swBomFeat = swFeat.GetSpecificFeature2
            Dim vTableArr As Variant
            Dim vTable As Variant
            Dim vConfigArray As Variant
            Dim vConfig As Variant
            Dim ConfigName As String
            Dim swTable As SldWorks.TableAnnotation
            Set swFeat = swBomFeat.GetFeature
            vTableArr = swBomFeat.GetTableAnnotations
            For Each vTable In vTableArr
                Set swTable = vTable
                vConfigArray = swBomFeat.GetConfigurations(True, True)
                For Each vConfig In vConfigArray
                    ConfigName = vConfig
                    Set swTableAnn = swTable
                    Dim nNumRow As Long
                    Dim nNumColumn As Long
                    nNumRow = swTableAnn.RowCount
                    ReDim strLink(nNumRow) As String
                    Set swBOMTableAnn = swTableAnn
                    For j = 0 To nNumRow - 1
                        Dim vPtArr As Variant
                        Dim swComp As Object
                        Dim pt As Object
                        vPtArr = swBOMTableAnn.GetComponents2(j, ConfigName)
                        If (Not IsEmpty(vPtArr)) Then
                            For i = 0 To UBound(vPtArr)
                                Set pt = vPtArr(i)
                                Set swComp = pt
                                If Not swComp Is Nothing Then
                                    strLink(j) = (Left(swComp.GetPathName, Len(swComp.GetPathName) - 7) & strExtension)
                                    If Not UCase(Left(swComp.ReferencedConfiguration, 7)) = "DEFAULT" Then
                                        NameSegs = Split(strLink(j), "\")
                                        strLink(j) = Left(strLink(j), Len(strLink(j)) - Len(NameSegs(UBound(NameSegs)))) & swComp.ReferencedConfiguration & strExtension
                                    End If
                                    Debug.Print "  Could not get component" & j & "."
                                End If
                        End If
                    Next j
                Next vConfig
            Next vTable
        End If
        Set swFeat = swFeat.GetNextFeature
    If swBomFeat Is Nothing Then
            MsgBox "No BOM Found"
    End If
    'get balloons and add hyperlink based on findings above
    Dim viewCount As Long
    viewCount = swDrawDoc.GetViewCount
    Dim ss As Variant
    ss = swDrawDoc.GetViews
    For sheetCount = LBound(ss) To UBound(ss)
        Dim vv As Variant
        vv = ss(sheetCount)
        For viewCount = (LBound(vv) + 1) To UBound(vv)
            Dim vNotes As Variant
            noteCount = vv(viewCount).GetNoteCount
            If noteCount > 0 Then
                vNotes = vv(viewCount).GetNotes
                For i = 0 To noteCount - 1
                    Set swNote = vNotes(i)
                    If swNote.IsBomBalloon Then
                    Set swAnnotation = swNote.GetAnnotation
                    swAnnotation.Select3 False, Nothing
                    Dim intMethod As Integer
                    If swNote.GetBomBalloonTextStyle(True) = swDetailingNoteTextItemNumber Then
                        If fso.FileExists(strLink(swNote.GetBomBalloonText(True))) = True Then swNote.SetHyperlinkText (strLink(swNote.GetBomBalloonText(True)))
                    End If
                    swModel.ClearSelection2 True
                    End If
            End If
        Next viewCount
    Next sheetCount
End Sub

Hopefully others can use this to make drawing navigating more convenient. If you make variations to this code, please paste into the comments.