Follow along with the video below to see how to install our site as a web app on your home screen.
Note: This feature may not be available in some browsers.
Dim swApp As SldWorks.SldWorks
Dim swDoc As SldWorks.ModelDoc2
Dim swNote As SldWorks.Note
Dim swBstack As SldWorks.BalloonStack
Dim swSelMgr As SldWorks.SelectionMgr
Dim bStackDir As Long
Dim bStackFit As Long
Dim StackMembers As Variant
Dim bLength As Long
Dim aStackText() As String
Dim AttachedEnts As Variant
Dim aStackEnts() As SldWorks.Entity
Dim CurTextPoint As Variant
Dim LowStackNum As Long
Dim i As Long
Sub main()
Set swApp = Application.SldWorks
Set swDoc = swApp.ActiveDoc
Set swSelMgr = swDoc.SelectionManager
If swSelMgr.GetSelectedObjectCount <> 1 Then
MsgBox "Please select one stacked balloon and try again."
Exit Sub
End If
If swSelMgr.GetSelectedObjectType3(1, -1) <> swSelNOTES Then
MsgBox "Please select one stacked balloon and try again."
Exit Sub
End If
Set swNote = swSelMgr.GetSelectedObject6(1, -1)
swDoc.ClearSelection2 True
If swNote.IsStackedBalloon = False Then
MsgBox "Please select one stacked balloon and try again."
Exit Sub
End If
Set swBstack = swNote.GetBalloonStack
StackMembers = swBstack.Stack
bStackDir = swBstack.Direction
bLength = swBstack.Length
bStackFit = swBstack.Master.GetBalloonSize
CurTextPoint = swBstack.Master.GetTextPoint2
ReDim aStackText(1, 0)
aStackText(0, 0) = swBstack.Master.GetText
aStackText(1, 0) = "0"
ReDim aStackEnts(0)
AttachedEnts = swBstack.Master.GetAnnotation.GetAttachedEntities
Set aStackEnts(0) = AttachedEnts(0)
For i = 1 To (UBound(StackMembers) + 1)
ReDim Preserve aStackText(1, i)
Set swNote = StackMembers(i - 1)
aStackText(0, i) = swNote.GetText
aStackText(1, i) = i
ReDim Preserve aStackEnts(i)
AttachedEnts = StackMembers(i - 1).GetAnnotation.GetAttachedEntities
Set aStackEnts(i) = AttachedEnts(0)
Next i
'Debug.Print "Pre-sort"
'For i = 0 To UBound(aStackText, 2)
' Debug.Print aStackText(0, i), aStackText(1, i)
'Next i
aSort aStackText
LowStackNum = aStackText(1, 0)
If LowStackNum <> 0 Then
swBstack.Master.GetAnnotation.Select False
End If
For i = 0 To UBound(StackMembers)
If i + 1 <> LowStackNum Then
StackMembers(i).GetAnnotation.Select True
End If
Next i
swDoc.DeleteSelection False
'Debug.Print "Post-sort"
'For i = 0 To UBound(aStackText, 2)
' Debug.Print aStackText(0, i), aStackText(1, i)
'Next i
For i = 1 To UBound(aStackText, 2)
aStackEnts(CLng(aStackText(1, i))).Select False
swBstack.AddTo swBalloonTextItemNumber, "", swBalloonTextItemNumber, ""
Next i
swDoc.EditRebuild3
End Sub
Private Sub aSort(ByRef myArray As Variant)
Dim tmpVal1 As String
Dim tmpVal2 As String
Dim bMoved As Boolean
Dim i As Long
bMoved = True
While bMoved
bMoved = False
For i = 1 To UBound(myArray, 2)
If myArray(0, i) < myArray(0, i - 1) Then
bMoved = True
tmpVal1 = myArray(0, i - 1)
tmpVal2 = myArray(1, i - 1)
myArray(0, i - 1) = myArray(0, i)
myArray(1, i - 1) = myArray(1, i)
myArray(0, i) = tmpVal1
myArray(1, i) = tmpVal2
Exit For
End If
Next i
Wend
End Sub
Dim swApp As SldWorks.SldWorks
Dim swDoc As SldWorks.ModelDoc2
Dim swNote As SldWorks.Note
Dim swBstack As SldWorks.BalloonStack
Dim swSelMgr As SldWorks.SelectionMgr
Dim bStackDir As Long
Dim bStackFit As Long
Dim StackMembers As Variant
Dim bLength As Long
Dim aStackText() As String
Dim AttachedEnts As Variant
Dim aStackEnts() As SldWorks.Entity
Dim CurTextPoint As Variant
Dim LowStackNum As Long
Dim i As Long
Sub main()
Set swApp = Application.SldWorks
Set swDoc = swApp.ActiveDoc
Set swSelMgr = swDoc.SelectionManager
If swSelMgr.GetSelectedObjectCount <> 1 Then
MsgBox "Please select one stacked balloon and try again."
Exit Sub
End If
If swSelMgr.GetSelectedObjectType3(1, -1) <> swSelNOTES Then
MsgBox "Please select one stacked balloon and try again."
Exit Sub
End If
Set swNote = swSelMgr.GetSelectedObject6(1, -1)
swDoc.ClearSelection2 True
If swNote.IsStackedBalloon = False Then
MsgBox "Please select one stacked balloon and try again."
Exit Sub
End If
Set swBstack = swNote.GetBalloonStack
StackMembers = swBstack.Stack
bStackDir = swBstack.Direction
bLength = swBstack.Length
bStackFit = swBstack.Master.GetBalloonSize
CurTextPoint = swBstack.Master.GetTextPoint2
ReDim aStackText(1, 0)
aStackText(0, 0) = swBstack.Master.GetText
aStackText(1, 0) = "0"
ReDim aStackEnts(0)
AttachedEnts = swBstack.Master.GetAnnotation.GetAttachedEntities
Set aStackEnts(0) = AttachedEnts(0)
For i = 1 To (UBound(StackMembers) + 1)
ReDim Preserve aStackText(1, i)
Set swNote = StackMembers(i - 1)
aStackText(0, i) = swNote.GetText
aStackText(1, i) = i
ReDim Preserve aStackEnts(i)
AttachedEnts = StackMembers(i - 1).GetAnnotation.GetAttachedEntities
Set aStackEnts(i) = AttachedEnts(0)
Next i
'Debug.Print "Pre-sort"
'For i = 0 To UBound(aStackText, 2)
' Debug.Print aStackText(0, i), aStackText(1, i)
'Next i
aSort aStackText
LowStackNum = aStackText(1, 0)
If LowStackNum <> 0 Then
swBstack.Master.GetAnnotation.Select False
End If
For i = 0 To UBound(StackMembers)
If i + 1 <> LowStackNum Then
StackMembers(i).GetAnnotation.Select True
End If
Next i
swDoc.DeleteSelection False
'Debug.Print "Post-sort"
'For i = 0 To UBound(aStackText, 2)
' Debug.Print aStackText(0, i), aStackText(1, i)
'Next i
For i = 1 To UBound(aStackText, 2)
aStackEnts(CLng(aStackText(1, i))).Select False
swBstack.AddTo swBalloonTextItemNumber, "", swBalloonTextItemNumber, ""
Next i
swDoc.EditRebuild3
End Sub
Private Sub aSort(ByRef myArray As Variant)
Dim tmpVal1 As String
Dim tmpVal2 As String
Dim bMoved As Boolean
Dim i As Long
bMoved = True
While bMoved
bMoved = False
For i = 1 To UBound(myArray, 2)
If CLng(myArray(0, i)) < CLng(myArray(0, i - 1)) Then
bMoved = True
tmpVal1 = myArray(0, i - 1)
tmpVal2 = myArray(1, i - 1)
myArray(0, i - 1) = myArray(0, i)
myArray(1, i - 1) = myArray(1, i)
myArray(0, i) = tmpVal1
myArray(1, i) = tmpVal2
Exit For
End If
Next i
Wend
End Sub