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
SolidworksApi macros