AnsweredAssumed Answered

VBA - Stacked Balloons for Toolbox Items

Question asked by Cad Admin on Jun 6, 2017
Latest reply on Jul 26, 2017 by Cad Admin

VBA Macro

 

Currently my company uses a stacked balloon for toolbox items.  I'm trying to create a macro that selects all balloons on a sheet then checks to see if they are a toolbox item. & if so adds a stacked balloon to the original balloons, in a specific format.

 

What i have so far...

  • i can select a balloon,
  • I can determine if the attached item is a toolbox item.
  • I can add a balloon in the per-determined format.

 

Issues..

  • I can't seem to change the value of the stacked balloon to read the "description" custom property of the detail it is ballooning.
  • selection is based off a "recorded macro"... the add-too isn't following the "user selection" it using the "recorded selection"

 

Future

  • I would like run this on all balloons on all sheets..without user selection of the balloons...more automatic.

 

Warning(LOL): Code below is a Hodge-Podge of snippets i either have found or currently use...

 

Option Explicit

 

Sub main()

 

    Dim swApp                            As SldWorks.SldWorks

    Dim swModel                         As SldWorks.ModelDoc

    Dim swSelMgr                       As SldWorks.SelectionMgr

    Dim swNote                      As SldWorks.Note

    Dim swAnn                       As SldWorks.Annotation

    Dim modelDocExt                 As SldWorks.ModelDocExtension

    Dim vAttEntArr                  As Variant

    Dim vAttEntTypeArr              As Variant

    Dim swEnt                       As SldWorks.Entity

    Dim swComp                      As SldWorks.Component

    Dim swCompModel                 As SldWorks.ModelDoc

    Dim i                           As Long

    Dim bRet                        As Boolean

    Dim ret                         As Long

    Dim boolstatus                  As Boolean

  

    Set swApp = Application.SldWorks

    Set swModel = swApp.ActiveDoc

    Set swSelMgr = swModel.SelectionManager

    Set swNote = swSelMgr.GetSelectedObject5(1)

    Set swAnn = swNote.GetAnnotation

  

    Debug.Assert swNote.IsBomBalloon

 

    vAttEntArr = swAnn.GetAttachedEntities2: If IsEmpty(vAttEntArr) Then Exit Sub

    vAttEntTypeArr = swAnn.GetAttachedEntityTypes

 

    Debug.Assert UBound(vAttEntArr) = UBound(vAttEntTypeArr)

 

    Debug.Print "File = " & swModel.GetPathName

    Debug.Print "  Name                 = " & swAnn.GetName

    Debug.Print "    Is stacked         = " & swNote.IsStackedBalloon

    Debug.Print "    Is stacked master  = " & swNote.IsStackedBalloonMaster

 

    For i = 0 To UBound(vAttEntArr)

        Debug.Print "    AttEntType         = " & vAttEntTypeArr(i)

 

        If swSelNOTHING <> vAttEntTypeArr(i) Then

            Set swEnt = vAttEntArr(i)

            Set swComp = swEnt.GetComponent

            Set swCompModel = swComp.GetModelDoc

            Set modelDocExt = swCompModel.Extension

            ret = modelDocExt.ToolboxPartType

 

            Debug.Print "    AttEnt             = " & swComp.GetPathName & " <" & swComp.ReferencedConfiguration & ">"

            Debug.Print "    Toolbox part type  = " & ret

'----------------------------------------Add Balloon Code Here--------------------------------------------------

            If ret <> 0 Then

            Dim Part As Object

            Dim longstatus As Long, longwarnings As Long

              

                Set Part = swApp.ActiveDoc

                boolstatus = Part.Extension.SelectByID2("DetailItem561@Drawing View4", "NOTE", 0.330553225698155, 0.435615531289275, 0, False, 0, Nothing, 0)

                Set swNote = Part.SelectionManager.GetSelectedObject3(1)

                boolstatus = Part.Extension.SelectByRay(0.271848815289342, 0.448482251378878, 3.97671893132383E-02, 0, 0, -1, 5.46835603808116E-04, 2, False, 0, 0)

                Dim myBalloonStack      As Object

                Dim swNote2             As Object

              

                If Not swNote Is Nothing Then

                   Set myBalloonStack = swNote.GetBalloonStack()

                   Set swNote2 = myBalloonStack.AddTo(swBalloonTextContent_e.swBalloonTextCustom, "Description", 1, "")

                        Dim doubleQuote As String

                        doubleQuote = Chr(34)

                        swNote2.PropertyLinkedText = "$PRPMODEL:" & doubleQuote & "Description" & doubleQuote

                        boolstatus = swNote2.SetBalloon(swBalloonStyle_e.swBS_Underline, swBalloonFit_e.swBF_Tightest)

                End If

            End If

'-------------------------------------------------------------------------------------------------------------

       

        End If

 

    Next i

 

End Sub

 

As always all help is appreciated...Thanks in advance

Outcomes