1 Reply Latest reply on Aug 25, 2017 7:36 AM by Cad Admin

    VBA - Limit Number of Stacked Balloons

    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

       

              Wend

                  

          Set swView = swView.GetNextView

       

          Wend

          

      End Sub