Hide Table of Contents

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



Provide feedback on this topic

SOLIDWORKS welcomes your feedback concerning the presentation, accuracy, and thoroughness of the documentation. Use the form below to send your comments and suggestions about this topic directly to our documentation team. The documentation team cannot answer technical support questions. Click here for information about technical support.

* Required

 
*Email:  
Subject:   Feedback on Help Topics
Page:   Create Multi-row Callouts Example (VBA)
*Comment:  
*   I acknowledge I have read and I hereby accept the privacy policy under which my Personal Data will be used by Dassault Systèmes

Print Topic

Select the scope of content to print:



x

We have detected you are using a browser version older than Internet Explorer 7. For optimized display, we suggest upgrading your browser to Internet Explorer 7 or newer.

 Never show this message again
x

Web Help Content Version: API Help (English only) 2012 SP05

To disable Web help from within SOLIDWORKS and use local help instead, click Help > Use SOLIDWORKS Web Help.

To report problems encountered with the Web help interface and search, contact your local support representative. To provide feedback on individual help topics, use the “Feedback on this topic” link on the individual topic page.