Why Gemfury?
Push, build, and install
RubyGems
npm packages
Python packages
Maven artifacts
PHP packages
Go Modules
Debian packages
RPM packages
NuGet packages
bee
bee / draftsight deb
Repository URL to install this package:
|
Version:
2016.3.0.4050 ▾
|
<html>
<head>
<title>Insert Splines 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,Splines">
<meta name=MS-HKWD content="VBA examples,points">
<meta name=MS-HKWD content="VBA examples,prompts">
<meta name=MS-HKWD content="VBA examples,commands">
<meta name=MS-HKWD content="VBA examples,events">
<meta name=MS-HKWD content="VBA examples,notifications">
<meta name=MS-HKWD content="VBA examples,entities">
<meta name=MS-HKWD content="VBA examples,Layers">
<style>
<!--
.style7
{
text-align: left;
font-size: 11px;
}
-->
</style>
</head>
<body>
<h1>Insert Splines Example (VBA)</h1>
<p>This example shows how to:</p>
<ul>
<li><font face="Verdana" style="font-size: 8pt">construct several Splines, which are displayed as
the Dassault Systèmes logo in a DraftSight drawing. </font></li>
<li><font face="Verdana" style="font-size: 8pt">fire events before
and after commands are executed.</font></li>
<li><font face="Verdana" style="font-size: 8pt">select a group of entities
and modify members in that group of entities.</font></li>
<li><font face="Verdana" style="font-size: 8pt">execute a command using
IApplication::RunCommand.</font></li>
</ul>
<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. <b><a href="#Module1">Module1</a></b> in <b>Modules</b>
' b. <b><a href="#Class1">Class1</a></b> in <b>Class Modules </b>
' 3. Add a reference to the DraftSight type library,
' <i>install_dir</i>\<b>bin\dsAutomation.dll</b>.
' 4. Start DraftSight.
' 5. Run the macro.
'
' Postconditions:
' 1. CommandPreNotify event is fired. Click <b>OK</b> to close the
' the message box.
' 2. Click anywhere in the drawing when you are prompted
' in the command window to <b>Click to insert a point</b>
' <b>for the lower-left corner for the 3DS logo</b>.
' 3. CommandPostNotify event is fired. Click <b>OK</b> to close the
' message box.
' 4. The Dassault Systemes logo is constructed in the drawing.
' a. Examine the drawing to verify.
' b. Click the Continue button in the IDE.
' The Dassault Systemes logo's letter D is changed
' from blue to yellow.
' c. Click the Continue button in the IDE.
' The Dassault Systemes logo's letter D is changed
' back to blue.
' d. Click the Continue button in the IDE.
' 5. CommandPreNotify event is fired. Click <b>OK</b> to close the
' the message box.
' 6. CommandPostNotify event is fired. Click <b>OK</b> to close the
' message box.
' 7. The Dassault Systemes logo is deleted.
'----------------------------------------------------------------
</pre>
<pre><a name="Module1"></a>' <b>Module1</b></pre>
<pre>Option Explicit</pre>
<pre>Public dsAppEvents As Class1</pre>
<pre>Dim dsApp As DraftSight.Application
Dim dsDoc As DraftSight.Document</pre>
<pre>Public commandPostNotifyCommand As String
Public commandPreNotifyCommand As String</pre>
<pre>Sub Main() </pre>
<pre> Dim dsSketchManager As draftsight.SketchManager
Dim dsSelectionManager As draftsight.SelectionManager
Dim dsSelectionFilter As draftsight.SelectionFilter
Dim dsEntityHelper As draftsight.EntityHelper </pre>
<pre> 'Connect to DraftSight
Set dsApp = GetObject(, "DraftSight.Application") </pre>
<pre> ' Abort any command currently running in DraftSight to
' avoid nested commands
dsApp.<b>AbortRunningCommand</b></pre>
<pre> commandPostNotifyCommand = ""
commandPreNotifyCommand = ""</pre>
<pre> 'Get command message object
Dim dsCommandMessage As CommandMessage
Set dsCommandMessage = dsApp.<b>GetCommandMessage</b> </pre>
<pre> 'Get active document
Set dsDoc = dsApp.<b>GetActiveDocument</b>()
If dsDoc Is Nothing Then
MsgBox ("There are no open documents in DraftSight.")
Return
End If</pre>
<pre> 'Set up events
Set dsAppEvents = New Class1
Set dsAppEvents.app = dsApp</pre>
<pre> 'Get model space
Dim dsModel As Model
Set dsModel = dsDoc.<b>GetModel</b>()</pre>
<pre> 'Get Sketch Manager
Set dsSketchManager = dsModel.<b>GetSketchManager</b>() </pre>
<pre> Dim x As Double
Dim y As Double
Dim z As Double </pre>
<pre> ' Prompt to insert the lower-left corner point for the 3DS logo
Dim dsMathUtility As DraftSight.MathUtility
Dim dsMathPlane As DraftSight.MathPlane
Set dsMathUtility = dsApp.<b>GetMathUtility</b>
Set dsMathPlane = dsMathUtility.<b>CreateXYPlane</b>
Dim status As Boolean
status = dsCommandMessage.<b>PromptForPoint2</b>("Click to insert a point for the lower-left corner for the 3DS logo", True, 0, 0, 0, x, y, z, dsMathPlane)</pre>
<pre> Dim spArray1(26) As Double
Dim spArray2(23) As Double
Dim spArray3(17) As Double </pre>
<pre> ' Construct the D
spArray1(0) = x + 0.4513
spArray1(1) = y + 0.3825
spArray1(2) = z + 0#
spArray1(3) = x + 0.324
spArray1(4) = y + 0.1912
spArray1(5) = z + 0#
spArray1(6) = x + 0.1261
spArray1(7) = y + 0.0932
spArray1(8) = z + 0#
spArray1(9) = x + 0.2571
spArray1(10) = y + 0.3839
spArray1(11) = z + 0#
spArray1(12) = x + 0.0023
spArray1(13) = y + 0.0086
spArray1(14) = z + 0#
spArray1(15) = x + 0.2132
spArray1(16) = y + 0.0711
spArray1(17) = z + 0#
spArray1(18) = x + 0.5275
spArray1(19) = y + 0.4664
spArray1(20) = z + 0#
spArray1(21) = x + 0.428
spArray1(22) = y + 0.5052
spArray1(23) = z + 0#
spArray1(24) = x + 0.1237
spArray1(25) = y + 0.4568
spArray1(26) = z + 0# </pre>
<pre> Dim spline1 As DraftSight.Spline
Set spline1 = dsSketchManager.<b>InsertSpline</b>(spArray1, True, 0, 0, 0, 0, 0, 0) </pre>
<pre> ' Construct the S
spArray2(0) = x + 0.4659
spArray2(1) = y + 0.1472
spArray2(2) = 0#
spArray2(3) = x + 0.8218
spArray2(4) = y + 0.2052
spArray2(5) = z + 0#
spArray2(6) = x + 0.6099
spArray2(7) = y + 0.5472
spArray2(8) = z + 0#
spArray2(9) = x + 0.7898
spArray2(10) = y + 0.6372
spArray2(11) = z + 0#
spArray2(12) = x + 0.9877
spArray2(13) = y + 0.5952
spArray2(14) = z + 0#
spArray2(15) = x + 0.7158
spArray2(16) = y + 0.5472
spArray2(17) = z + 0#
spArray2(18) = x + 0.9318
spArray2(19) = y + 0.2232
spArray2(20) = z + 0#
spArray2(21) = x + 0.7818
spArray2(22) = y + 0.1112
spArray2(23) = z + 0# </pre>
<pre> Dim spline2 As DraftSight.Spline
Set spline2 = dsSketchManager.<b>InsertSpline</b>(spArray2, True, 0, 0, 0, 0, 0, 0) </pre>
<pre> ' Construct the 3
spArray3(0) = x + 0.6319
spArray3(1) = y + 0.8672
spArray3(2) = z + 0#
spArray3(3) = x + 0.33
spArray3(4) = y + 0.9233
spArray3(5) = z + 0#
spArray3(6) = x + 0.5
spArray3(7) = y + 0.9642
spArray3(8) = z + 0#
spArray3(9) = x + 0.7318
spArray3(10) = y + 0.8952
spArray3(11) = z + 0#
spArray3(12) = x + 0.6279
spArray3(13) = y + 0.6892
spArray3(14) = z + 0#
spArray3(15) = x + 0.369
spArray3(16) = y + 0.5563
spArray3(17) = z + 0# </pre>
<pre> Dim spline3 As DraftSight.Spline
Set spline3 = dsSketchManager.<b>InsertSpline</b>(spArray3, True, 0, 0, 0, 0, 0, 0)
</pre>
<pre> ' Set the colors for the logo
Dim color1 As DraftSight.Color
Dim color2 As DraftSight.Color
Dim color3 As DraftSight.Color </pre>
<pre> Set color1 = spline1.<b>Color</b>
Set color2 = spline2.<b>Color</b>
Set color3 = spline3.<b>Color</b> </pre>
<pre> color1.<b>SetNamedColor</b> (dsNamedColor_Blue)
color2.<b>SetNamedColor</b> (dsNamedColor_Yellow)
color3.<b>SetNamedColor</b> (dsNamedColor_Red) </pre>
<pre> spline1.<b>Color</b> = color1
spline2.<b>Color</b> = color2
spline3.<b>Color</b> = color3 </pre>
<pre> ' Examine the drawing to verify
' that the logo was created
' and that the letter D is blue, the
' letter S is yellow, and the non-letter
' is red
Stop
' Click the Continue button to
' change the colors of the 3DS logo</pre>
<pre> 'Get Selection Manager
Set dsSelectionManager = dsDoc.<b>GetSelectionManager</b>
</pre>
<pre> 'Get selection filter
Set dsSelectionFilter = dsSelectionManager.<b>GetSelectionFilter</b>
</pre>
<pre> 'Clear selection filter
dsSelectionFilter.Clear
</pre>
<pre> 'Add Spline entities to the selection filter
dsSelectionFilter.<b>AddEntityType</b> dsObjectType_e.dsSplineType
</pre>
<pre> 'Activate selection filter
dsSelectionFilter.<b>Active</b> = True
</pre>
<pre> 'Get all layer names
Dim layerNames As Variant
layerNames = GetLayers(dsDoc)
</pre>
<pre> Dim entityTypes As Variant
Dim entityObjects As Variant
</pre>
<pre> 'Get Spline entities
dsSketchManager.<b>GetEntities</b> dsSelectionFilter, layerNames, entityTypes, entityObjects
</pre>
<pre> ' Get EntityHelper
Set dsEntityHelper = dsApp.<b>GetEntityHelper</b> </pre>
<pre>
' Change the letter D in the logo from blue to yellow
dsEntityHelper.<b>SetColor</b> entityObjects(0), color2</pre>
<pre> Stop
' Examine the drawing to verify that
' the color of D has changed from blue to yellow
' Click the Continue button </pre>
<pre> dsEntityHelper.<b>SetColor</b> entityObjects(0), color1
</pre>
<pre>
Stop
' Examine the drawing to verify that
' the color of D has changed back to blue
' Click the Continue button to delete the logo
Dim state As Long
state = dsApp.<b>RunCommand</b>("DELETE ALL" & Chr(10) & Chr(10), False)</pre>
<pre>End Sub</pre>
<pre> Public Function GetLayers(ByVal dsDoc As Document) As String()
'Get Layer Manager
Dim dsLayerManager As DraftSight.LayerManager
Dim dsLayers() As Object
Set dsLayerManager = dsDoc.<b>GetLayerManager
</b> dsLayers = dsLayerManager.<b>GetLayers</b>()
Dim dslayerNames() As String
Dim nbrLayers As Long
nbrLayers = UBound(dsLayers)
ReDim dslayerNames(nbrLayers) </pre>
<pre> Dim i As Long
For i = 0 To nbrLayers
Dim dsLayer As DraftSight.<b>Layer</b>
Set dsLayer = dsLayers(i)
dslayerNames(i) = dsLayer.<b>Name</b>
Next </pre>
<pre> GetLayers = dslayerNames
End Function</pre>
<pre><a name="Class1"></a>' <b>Class1</b></pre>
<pre>Option Explicit</pre>
<pre>Public WithEvents app As DraftSight.Application
Public Sub app_<b>CommandPreNotify</b>(ByVal commandPreNotifyCommand As String, ByVal doc As DraftSight.Document)
MsgBox ("CommandPreNotify event was fired before " & commandPreNotifyCommand & " was executed.")
End Sub
</pre>
<pre> Public Sub app_C<b>ommandPostNotify</b>(ByVal commandPostNotifyCommand As String, ByVal doc As DraftSight.Document)
MsgBox ("CommandPostNotify event was fired after " & commandPostNotifyCommand & " was executed.")
End Sub</pre>
</body>
</html>