AnsweredAssumed Answered

VBA - Limit Number of Stacked Balloons

Question asked by Cad Admin on Jul 27, 2017
Latest reply on Aug 25, 2017 by Cad Admin

Side question from another post.  I have a macro that adds a stacked balloon to an existing balloon & formats it as you see below.  Is there a way to limit it to just the run on a single balloon and added description.  I don't want to be able to run it again and add to the stack again, and again, and again.


  • I need to limit the macro to only run on “single balloons. So basically checking the balloon stack count is < 1, anything 1 or higher it skips.  I tried swNote.GetBalloonStack.Count, with inconsistent results and object not defined error after a few successful checks



Option Explicit


Sub main()


    Dim swApp                       As SldWorks.SldWorks

    Dim swModel                     As ModelDoc2

    Dim swDraw                      As DrawingDoc

    Dim swView                      As View

    Dim swNote                      As Note

    Dim swAnn                       As Annotation

    Dim swSelMgr                    As SldWorks.SelectionMgr

    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 swDraw = swModel


    Set swView = swDraw.GetFirstView

    Set swView = swView.GetNextView


    While Not swView Is Nothing

        Debug.Print "-------------------"

        Debug.Print swView.Name


        Set swNote = swView.GetFirstNote

        While Not swNote Is Nothing

        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)


            For i = 0 To UBound(vAttEntArr)


                If swSelNOTHING <> vAttEntTypeArr(i) Then

                    Set swEnt = vAttEntArr(i)

                    Set swComp = swEnt.GetComponent

                    Set swCompModel = swComp.GetModelDoc

                    Set modelDocExt = swCompModel.Extension

                    ret = modelDocExt.ToolboxPartType


                    If ret <> 0 And swNote.GetBalloonStyle <> 10 Then


                        Debug.Print "File = " & swModel.GetPathName

                        Debug.Print "  Name                 = " & swAnn.GetName

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

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

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

                        Debug.Print "    Balloon style      = " & swNote.GetBalloonStyle

                        Debug.Print "    Toolbox Part       = " & ret



                        Dim myBalloonStack      As Object

                        Dim swNote2             As Object


                        If Not swNote Is Nothing Then

                                Dim AttachPosition As Variant

                                Dim StackCount As Long

                                Dim StackArray As Variant


                                AttachPosition = swNote.GetAttachPos 'Get the attachment point of the current note

                                swAnn.Select3 True, Nothing 'Select the current note


                                swApp.RunCommand swCommands_Resume_Stacking_Balloons, "" 'RMB -> Add to Stack

                                If vAttEntTypeArr(i) = swSelFACES Then    'Determine if the note is attached to a face or to an edge

                                    swModel.Extension.SelectByID2 "", "FACE", AttachPosition(0), AttachPosition(1), AttachPosition(2), False, 0, Nothing, Empty

                                ElseIf vAttEntTypeArr(i) = swSelEDGES Then

                                    swModel.Extension.SelectByID2 "", "EDGE", AttachPosition(0), AttachPosition(1), AttachPosition(2), False, 0, Nothing, Empty

                                End If

                                swApp.RunCommand swCommands_PmOK, "" 'Click okay in the Propertymanager


                                Set myBalloonStack = swNote.GetBalloonStack 'Get the balloonstack, to change the note that has just been added

                                If Not myBalloonStack Is Nothing Then

                                    StackCount = myBalloonStack.Count

                                    StackArray = myBalloonStack.Stack

                                    Set swNote2 = StackArray(StackCount - 1)

                                    swNote2.SetBomBalloonText 1, "$PRPMODEL:""Description""", 1, ""

                                    swNote2.SetBalloon swBalloonStyle_e.swBS_Underline, swBalloonFit_e.swBF_Tightest

                                End If

                        End If

                    End If

                End If

            Next i


        Set swNote = swNote.GetNext




    Set swView = swView.GetNextView




End Sub