Gemfury

bee / draftsight deb

Repository URL to install this package:
Details
draftsight / opt / dassault-systemes / DraftSight / APISDK / Create_Tracker_Example_VBA.htm
<html>

<head>
<title>Create Tracker Example (VBA)</title>
<meta http-equiv="Content-Language" content="en-us">
<meta http-equiv="Content-Type" content="text/html; charset=windows-1252">
<link rel="stylesheet" type="text/css" href="ApiHelp.css">
<meta name=MS-HKWD content="VBA examples">
<meta name=MS-HKWD content="VBA examples,trackers">
<meta name=MS-HKWD content="VBA examples,temporary entities">


</head>


<body>
<h1>Create Tracker Example (VBA)</h1>

<p>This example shows how to create a tracker and add a temporary entity to the 
tracker.</p>
<pre>'--------------------------------------------------------------
' Preconditions:
' 1. Create a VBA macro in a software product in which VBA is
'    embedded.
' 2. Copy and paste this example into the Visual Basic IDE.
'    a. In Modules, copy and paste the <a href="#Module">Main module</a>.
'    b. Insert a class called Class1, and paste the <a href="#Class1">Class1 module</a>.
' 3. Add a reference to the DraftSight type library,
'    <i>install_dir</i>\<b>bin\dsAutomation.dll</b>.
' 4. Start DraftSight and open a document.
' 5. Run the macro.
'
' Postconditions:
' 1. Creates a temporary Circle for the tracker.
' 2. Creates a tracker and adds the temporary Circle to the
'    the tracker.
' 3. Examine the pointer in the drawing to verify.
' 4. Prompts you to click in the drawing to insert a Circle.
' 5. Inserts a Circle in the drawing at the point where you clicked.
'----------------------------------------------------------------</pre>
<pre><a name="Module"></a><b>'Main module</b>
Option Explicit</pre>
<pre>Public dsTrackerEvent As Class1</pre>
<pre>Public dsApp As DraftSight.Application
Public dsTempCircle As DraftSight.Circle</pre>
<pre>Sub main()        </pre>
<pre>        Dim dsModel As DraftSight.Model
        Dim dsSketchMgr As DraftSight.SketchManager</pre>
<pre>        'Connect to DraftSight application
        Set dsApp = GetObject(, &quot;DraftSight.Application&quot;)        </pre>
<pre>        'Abort any command currently running in DraftSight
        'to avoid nested commands
        dsApp.AbortRunningCommand</pre>
<pre>        If dsApp Is Nothing Then
            Return
        End If</pre>
<pre>        'Get active document
        Dim dsDoc As DraftSight.Document
        Set dsDoc = dsApp.<b>GetActiveDocument</b>()
        If dsDoc Is Nothing Then
            MsgBox (&quot;There are no open documents in DraftSight.&quot;)
            Return
        End If
        
</pre>
<pre>        'Get Sketch Manager
        Set dsModel = dsDoc.<b>GetModel</b>()
        Set dsSketchMgr = dsModel.<b>GetSketchManager</b>()</pre>
<pre>        'Create temporary Circle
        dsApp.<b>TemporaryEntityMode</b> = True
        Set dsTempCircle = dsSketchMgr.<b>InsertCircle</b>(0, 0, 0, 10)
        dsApp.<b>TemporaryEntityMode</b> = False</pre>
<pre>        'Create tracker and add temporary Circle
        Dim dsTracker As DraftSight.Tracker
        Set dsTracker = dsApp.<b>CreateTracker</b>()
        dsTracker.<b>AddTemporaryEntity</b> dsTempCircle
        </pre>
<pre>        'Set up event
        Set dsTrackerEvent = New Class1
        Set dsTrackerEvent.myTracker = dsTracker</pre>
<pre>        'Prompt for point where to insert Circle
        'Before prompt, add tracker to command message
        Dim dsCmdMsg As CommandMessage
        Set dsCmdMsg = dsApp.<b>GetCommandMessage</b>()
        dsCmdMsg.<b>AddTracker</b> dsTracker</pre>
<pre>        Dim x As Double
        x = 0#
        Dim y As Double
        y = 0#
        Dim z As Double
        z = 0#</pre>
<pre>        Dim res As Boolean
        res = dsCmdMsg.<b>PromptForPoint</b>(&quot;Click to insert Circle&quot;, x, y, z)</pre>
<pre>        If res = True Then
            'Set the center of the Circle where user clicked
            dsTempCircle.<b>SetCenter</b> x, y, z
            'Add temporary Circle to drawing
            dsSketchMgr.<b>AddTemporaryEntity</b> dsTempCircle
        End If</pre>
<pre>        'Remove tracker from command message if no longer needed
        dsCmdMsg.<b>RemoveTracker</b> dsTracker
</pre>
<pre>    End Sub</pre>
<pre><b><a name="Class1"></a>'Class1</b> <b>module</b>
</pre>
<pre>Option Explicit    </pre>
<pre>Public WithEvents myTracker As DraftSight.Tracker    </pre>
<pre>Public Sub myTracker_<b>UpdateNotify</b>(ByVal CursorPosition As DraftSight.MathPoint)                    </pre>
<pre>        If CursorPosition Is Nothing Then
            Return
        End If</pre>
<pre>        Dim x As Double
        x = 0#
        Dim y As Double
        y = 0#
        Dim z As Double
        z = 0#
        CursorPosition.<b>GetPosition</b> x, y, z</pre>
<pre>        dsTempCircle.<b>SetCenter</b> x, y, z</pre>
<pre>End Sub</pre>

</body>

</html>
bee / draftsight deb

Products

About

Resources

Contact Gemfury
