Why Gemfury? Push, build, and install  RubyGems npm packages Python packages Maven artifacts PHP packages Go Modules Debian packages RPM packages NuGet packages

Repository URL to install this package:

Details    
draftsight / opt / dassault-systemes / DraftSight / APISDK / Create_Linear_Pattern_Example_VBA.htm
Size: Mime:
<html>

<head>
<title>Create Linear pattern 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,linear patterns">
</head>


<body>
<h1>Create Linear Pattern Example (VBA)</h1>

<p>This example shows how to create a linear pattern.</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. Draws a Circle.
' 2. Draws a 2D PolyLine.
' 3. Creates a linear pattern using the Circle and 2D PolyLine
'&nbsp;&nbsp;&nbsp;&nbsp;entities.
' 4. Zooms the drawing to fit.
' 5. Examine the drawing.
'----------------------------------------------------------------
Option Explicit
Sub main()
    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 dsPolyLine As DraftSight.PolyLine
    </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
        Dim centerX As Double
        centerX = 5#
        </pre>
<pre>        Dim centerY As Double
        centerY = 5#
        </pre>
<pre>        Dim centerZ As Double
        centerZ = 0#
        </pre>
<pre>        Dim radius As Double
        radius = 3#
        </pre>
<pre>        'Draw a Circle
        Set dsCircle = dsSketchManager.<b>InsertCircle</b>(centerX, centerY, centerZ, radius)
        </pre>
<pre>        'Draw a 2D PolyLine
        Dim coordinates(0 To 7) As Double
        coordinates(0) = 10: coordinates(1) = 4
        coordinates(2) = 10: coordinates(3) = 6
        coordinates(4) = 14: coordinates(5) = 6
        coordinates(6) = 14: coordinates(7) = 4
        Dim Closed As Boolean
        Closed = True
        </pre>
<pre>        'Construct a 2D PolyLine
        Set dsPolyLine = dsSketchManager.<b>InsertPolyline2D</b>(coordinates, Closed)
        </pre>
<pre>        'Linear pattern parameters
        Dim numberElementsOnVerticalAxis As Long
        numberElementsOnVerticalAxis = 4
        </pre>
<pre>        Dim numberElementsOnHorizontalAxis As Double
        numberElementsOnHorizontalAxis = 5
        </pre>
<pre>        Dim spacingonVerticalAxis As Double
        spacingonVerticalAxis = 20
        </pre>
<pre>        Dim spacingOnHorizontalAxis As Double
        spacingOnHorizontalAxis = 40
        </pre>
<pre>        Dim patternAngle As Double
        patternAngle = 3.14159265358979 / 4 'In radians
        </pre>
<pre>        'Prepare list of entity types
        Dim dsEntityTypes(0 To 1) As Long
        dsEntityTypes(0) = dsObjectType_e.dsCircleType
        dsEntityTypes(1) = dsObjectType_e.dsPolyLineType
        </pre>
<pre>        'Prepare list of entities
        Dim dsEntities(0 To 1) As Object
        Set dsEntities(0) = dsCircle
        Set dsEntities(1) = dsPolyLine
        </pre>
<pre>        'Create linear pattern
        dsSketchManager.<b>PatternLinear</b> numberElementsOnVerticalAxis, numberElementsOnHorizontalAxis, spacingonVerticalAxis, spacingOnHorizontalAxis, patternAngle, dsEntityTypes, dsEntities
        </pre>
<pre>        'Zoom to fit
        dsApp.<b>Zoom</b> dsZoomRange_e.dsZoomRange_Fit, Nothing, Nothing
       </pre>
<pre>        
    Else
        </pre>
<pre>        MsgBox &quot;There are no open documents in DraftSight.&quot;
        </pre>
<pre>    End If
End Sub</pre>

</body>

</html>