Gemfury

bee / draftsight deb

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

<head>
<title>Create and Attach HyperLink 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,HyperLinks">
<meta name=MS-HKWD content="VBA examples,Circles">
</head>


<body>
<h1>Create and Attach HyperLink Example (VBA)</h1>

<p>This example shows how to create and attach a HyperLink to a Circle.</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.
' 3. Add a reference to the DraftSight type library,
'    <i>install_dir</i>\<b>bin\dsAutomation.dll</b>.
' 4. Start DraftSight and open a drawing document.
' 5. Run the macro.
'
' Postconditions:
' 1. A Circle is constructed in the drawing document.
' 2. A HyperLink is created and attached to the Circle.
' 3. In DraftSight, put the cursor on the Circle to see the
'    the hyperlink and Ctrl+click to open DraftSight's website.
'----------------------------------------------------------------
Option Explicit</pre>
<pre>Sub main()</pre>
<pre>    Dim dsApp As DraftSight.Application
    Dim dsDoc As DraftSight.Document
    Dim dsModel As DraftSight.Model
    Dim dsSketchManager As DraftSight.SketchManager
    Dim dsCircle As DraftSight.Circle
    Dim centerX, centerY, centerZ, radius As Double
    </pre>
<pre>    'Connect to DraftSight
    Set dsApp = GetObject(, &quot;DraftSight.Application&quot;)
    'Abort any command currently running in DraftSight 
    'to avoid nested commands
    dsApp.<b>AbortRunningCommand</b></pre>
<pre>    'Get active document
    Set dsDoc = dsApp.<b>GetActiveDocument</b>()
    If Not dsDoc Is Nothing Then
        </pre>
<pre>        'Get model space
        Set dsModel = dsDoc.<b>GetModel</b>()
        </pre>
<pre>        'Get Sketch Manager
        Set dsSketchManager = dsModel.<b>GetSketchManager</b>()
        </pre>
<pre>        'Circle parameters
        centerX = 1#
        centerY = 2#
        centerZ = 0#
        radius = 5#
        </pre>
<pre>        'Construct a Circle
        Set dsCircle = dsSketchManager.<b>InsertCircle</b>(centerX, centerY, centerZ, radius)
        </pre>
<pre>        'Create and attach HyperLink to Circle
        Dim startCornerX As Double
        startCornerX = 0#
        Dim startCornerY As Double
        startCornerY = 0#
        Dim startCornerZ As Double
        startCornerZ = 0#
        Dim oppositeCornerX As Double
        startCornerX = 0#
        Dim oppositeCornerY As Double
        startCornerY = 0#
        Dim oppositeCornerZ As Double
        startCornerZ = 0#
        Dim hyperLinkAddress As String
        hyperLinkAddress = &quot;http://www.3ds.com/products/draftsight/free-cad-software/&quot;
        Dim description As String
        description = &quot;DraftSight's website&quot;
        Dim ds3DPolyLine As DraftSight.PolyLine3D
        Dim dsHyperLink As DraftSight.HyperLink
        </pre>
<pre>        Set dsHyperLink = dsSketchManager.<b>AttachLinkToArea</b>(startCornerX, startCornerY, startCornerZ, oppositeCornerX, oppositeCornerY, oppositeCornerZ, hyperLinkAddress, description, ds3DPolyLine)
        dsCircle.<b>SetHyperLink</b> dsHyperLink
    </pre>
<pre>    Else
        </pre>
<pre>        MsgBox &quot;There are no open documents in DraftSight.&quot;
        </pre>
<pre>    End If
End Sub</pre>

</body>

</html>
bee / draftsight deb

Products

About

Resources

Contact Gemfury
