Create Multi-row Callouts Example (VBA)
This example shows how to create a multi-row callout.
Modules
'-------------------------------------------
'
' Preconditions:
' 1)
Part or assembly is open.
'
' 2)
If an assembly is open, then it must be fully resolved.
'
' 3)
At least one or more geometric entities are
' selected
in the graphics area.
'
' Postconditions: Entities are preselected. Each entity
has a callout
' attached
to the selection point.
'
' Notes: Selecting features in FeatureManager design tree
is not currently supported.
'
'--------------------------------------------
Option Explicit
Sub main()
Dim
swApp As
SldWorks.SldWorks
Dim
swModel As
SldWorks.ModelDoc2
Dim
swModelExt As
SldWorks.ModelDocExtension
Dim
swSelMgr As
SldWorks.SelectionMgr
Dim
vSelPos() As
Variant
Dim
swCallout() As
SldWorks.Callout
Dim
nSelCount As
Long
Dim
i As
Long
Dim
bRet As
Boolean
Dim
callH As
New CalloutHandler
Dim
boolstatus As
Boolean
Set
swApp = CreateObject("SldWorks.Application")
Set
swModel = swApp.ActiveDoc
Set
swModelExt = swModel.Extension
Set
swSelMgr = swModel.SelectionManager
nSelCount
= swSelMgr.GetSelectedObjectCount2(-1)
ReDim
vSelPos(nSelCount)
ReDim
swCallout(nSelCount)
For
i = 0 To nSelCount - 1
vSelPos(i)
= swSelMgr.GetSelectionPoint2((i
+ 1), -1)
Next
i
swModel.ClearSelection2 True
For
i = 0 To nSelCount - 1
callH.Init
Nothing
Set
swCallout(i) = swSelMgr.CreateCallout2(4,
callH)
swCallout(i).Label2(0) = "Project"
swCallout(i).Label2(1) = "Product"
swCallout(i).Label2(2) = "Radius"
swCallout(i).Label2(3) = "Number"
swCallout(i).Value(0) = "10685"
swCallout(i).Value(1) = "Washer"
swCallout(i).Value(2) = "30"
swCallout(i).Value(3) = "1"
swCallout(i).SetTargetPoint 0, vSelPos(i)(0), vSelPos(i)(1),
vSelPos(i)(2)
swCallout(i).SetTargetPoint 1, vSelPos(i)(0), vSelPos(i)(1),
vSelPos(i)(2)
swCallout(i).SetTargetPoint 2, vSelPos(i)(0), vSelPos(i)(1),
vSelPos(i)(2)
swCallout(i).SetTargetPoint 3, vSelPos(i)(0), vSelPos(i)(1),
vSelPos(i)(2)
swCallout(i).TextColor(0) = swSystemColorsRefTriadX
swCallout(i).TextColor(1) = swSystemColorsRefTriadY
swCallout(i).TextColor(2) = swSystemColorsRefTriadZ
swCallout(i).TextColor(3) = swSystemColorsRefTriadX
swCallout(i).OpaqueColor = swSystemColorsSelectedItem4
swCallout(i).MultipleLeaders = False
bRet
= swModelExt.SelectByID2("",
"", _
vSelPos(i)(0),
vSelPos(i)(1), vSelPos(i)(2), _
True,
0, swCallout(i), 0)
swCallout(i).ValueInactive(3) = True
Next
i
End Sub
Back to top
Class Modules
______________________________________________________________________________
Option Explicit
Implements SwCalloutHandler
Dim m_pCallout As SldWorks.Callout
______________________________________________________________________________
Public Sub Init(clout As SldWorks.Callout)
Set
m_pCallout = clout
End Sub
______________________________________________________________________________
Private Sub Class_Initialize()
Debug.Print
"Class_Initialize"
End Sub
______________________________________________________________________________
Private Sub Class_Terminate()
Debug.Print
"Class_Terminate"
End Sub
'******************************************************************************'
'These methods are the implementations of the SolidWorks
notifications
Public Function SwCalloutHandler_OnStringValueChanged(ByVal
pManipulator As Object, ByVal Index As Long, ByVal Text As String) As
Boolean
Debug.Print
Index
Debug.Print
Text
Dim
retval As Boolean
retval
= True
If
Text = "XXXXXX" Then
retval
= False
pManipulator.ValueInactive(Index) = True
pManipulator.Label2(Index) = "Wrong!"
End
If
SwCalloutHandler_OnStringValueChanged
= retval
End Function
Back to top