Repository URL to install this package:
|
Version:
2016.3.0.4050 ▾
|
<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
' 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(, "DraftSight.Application")
'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 "There are no open documents in DraftSight."
</pre>
<pre> End If
End Sub</pre>
</body>
</html>