Gemfury

bee / draftsight deb

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

<head>
<title>Insert Hatch 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,Hatches">
<meta name=MS-HKWD content="VBA examples,Hatch boundary loops">
</head>


<body>
<h1>Insert Hatch Example (VBA)</h1>

<p>This example shows how to insert a Hatch in a drawing document.</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: A Hatch is inserted in the drawing document
' and zoomed to fit.</pre>
<pre>'----------------------------------------------------------------
Option Explicit</pre>
<pre>    Dim dsApp As DraftSight.Application
    Dim dsDoc As DraftSight.Document
    Dim dsModel As DraftSight.Model
    Dim dsSketchManager As DraftSight.SketchManager</pre>
<pre>    Sub main()
    '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 dsDoc Is Nothing Then
        MsgBox (&quot;There are no open documents in DraftSight.&quot;)
        End
    End If</pre>
<pre>    'Get model space
    Set dsModel = dsDoc.<b>GetModel</b>
    </pre>
<pre>    'Get Sketch Manager
    Set dsSketchManager = dsModel.<b>GetSketchManager</b>
    </pre>
<pre>    'Hatch parameters
    Dim boundaryPointCountArray(0) As Long
    boundaryPointCountArray(0) = 4
    </pre>
<pre>    Dim boundaryPoints(0 To 7) As Double
    boundaryPoints(0) = 0: boundaryPoints(1) = 0
    boundaryPoints(2) = 2: boundaryPoints(3) = 0
    boundaryPoints(4) = 2: boundaryPoints(5) = 2
    boundaryPoints(6) = 0: boundaryPoints(7) = 2
   </pre>
<pre>    Dim patternName As String
    patternName = &quot;ANSI31&quot;
    </pre>
<pre>    Dim patternScale As Double
    patternScale = 1#
    </pre>
<pre>    Dim patternAngle As Double
    patternAngle = 3.14159265358979 / 4 'In radians</pre>
<pre>    'Insert Hatch
    Dim dsHatch As DraftSight.Hatch
    Set dsHatch = dsSketchManager.<b>InsertHatchByBoundary</b>(boundaryPointCountArray, boundaryPoints, patternName, patternScale, patternAngle)
    </pre>
<pre>    If Not dsHatch Is Nothing Then
        'Change color of Hatch
        Dim dsColor As DraftSight.Color
        Set dsColor = dsHatch.<b>Color</b>
        dsColor.<b>SetNamedColor</b> dsNamedColor_Green
        dsHatch.<b>Color</b> = dsColor
        </pre>
<pre>        'Zoom to fit
        dsApp.<b>Zoom</b> dsZoomRange_Fit, Nothing, Nothing
    Else
        MsgBox (&quot;Hatch entity was not added to the current drawing.&quot;)
    End If
End Sub</pre>
<p>&nbsp;</p>

</body>

</html>
bee / draftsight deb

Products

About

Resources

Contact Gemfury
