This example shows how to:
'-------------------------------------------------------------- ' 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. Module1 in Modules ' b. Class1 in Class Modules ' 3. Add a reference to the DraftSight type library, ' install_dir\bin\dsAutomation.dll. ' 4. Start DraftSight. ' 5. Run the macro. ' ' Postconditions: ' 1. CommandPreNotify event is fired. Click OK to close the ' the message box. ' 2. Click anywhere in the drawing when you are prompted ' in the command window to Click to insert a point ' for the lower-left corner for the 3DS logo. ' 3. CommandPostNotify event is fired. Click OK 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 OK to close the ' the message box. ' 6. CommandPostNotify event is fired. Click OK to close the ' message box. ' 7. The Dassault Systemes logo is deleted. '----------------------------------------------------------------
' Module1
Option Explicit
Public dsAppEvents As Class1
Dim dsApp As DraftSight.Application Dim dsDoc As DraftSight.Document
Public commandPostNotifyCommand As String Public commandPreNotifyCommand As String
Sub Main()
Dim dsSketchManager As draftsight.SketchManager Dim dsSelectionManager As draftsight.SelectionManager Dim dsSelectionFilter As draftsight.SelectionFilter Dim dsEntityHelper As draftsight.EntityHelper
'Connect to DraftSight Set dsApp = GetObject(, "DraftSight.Application")
' Abort any command currently running in DraftSight to ' avoid nested commands dsApp.AbortRunningCommand
commandPostNotifyCommand = "" commandPreNotifyCommand = ""
'Get command message object Dim dsCommandMessage As CommandMessage Set dsCommandMessage = dsApp.GetCommandMessage
'Get active document Set dsDoc = dsApp.GetActiveDocument() If dsDoc Is Nothing Then MsgBox ("There are no open documents in DraftSight.") Return End If
'Set up events Set dsAppEvents = New Class1 Set dsAppEvents.app = dsApp
'Get model space Dim dsModel As Model Set dsModel = dsDoc.GetModel()
'Get Sketch Manager Set dsSketchManager = dsModel.GetSketchManager()
Dim x As Double Dim y As Double Dim z As Double
' 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.GetMathUtility Set dsMathPlane = dsMathUtility.CreateXYPlane Dim status As Boolean status = dsCommandMessage.PromptForPoint2("Click to insert a point for the lower-left corner for the 3DS logo", True, 0, 0, 0, x, y, z, dsMathPlane)
Dim spArray1(26) As Double Dim spArray2(23) As Double Dim spArray3(17) As Double
' 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#
Dim spline1 As DraftSight.Spline Set spline1 = dsSketchManager.InsertSpline(spArray1, True, 0, 0, 0, 0, 0, 0)
' 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#
Dim spline2 As DraftSight.Spline Set spline2 = dsSketchManager.InsertSpline(spArray2, True, 0, 0, 0, 0, 0, 0)
' 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#
Dim spline3 As DraftSight.Spline Set spline3 = dsSketchManager.InsertSpline(spArray3, True, 0, 0, 0, 0, 0, 0)
' Set the colors for the logo Dim color1 As DraftSight.Color Dim color2 As DraftSight.Color Dim color3 As DraftSight.Color
Set color1 = spline1.Color Set color2 = spline2.Color Set color3 = spline3.Color
color1.SetNamedColor (dsNamedColor_Blue) color2.SetNamedColor (dsNamedColor_Yellow) color3.SetNamedColor (dsNamedColor_Red)
spline1.Color = color1 spline2.Color = color2 spline3.Color = color3
' 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
'Get Selection Manager Set dsSelectionManager = dsDoc.GetSelectionManager
'Get selection filter Set dsSelectionFilter = dsSelectionManager.GetSelectionFilter
'Clear selection filter dsSelectionFilter.Clear
'Add Spline entities to the selection filter dsSelectionFilter.AddEntityType dsObjectType_e.dsSplineType
'Activate selection filter dsSelectionFilter.Active = True
'Get all layer names Dim layerNames As Variant layerNames = GetLayers(dsDoc)
Dim entityTypes As Variant Dim entityObjects As Variant
'Get Spline entities dsSketchManager.GetEntities dsSelectionFilter, layerNames, entityTypes, entityObjects
' Get EntityHelper Set dsEntityHelper = dsApp.GetEntityHelper
' Change the letter D in the logo from blue to yellow dsEntityHelper.SetColor entityObjects(0), color2
Stop ' Examine the drawing to verify that ' the color of D has changed from blue to yellow ' Click the Continue button
dsEntityHelper.SetColor entityObjects(0), color1
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.RunCommand("DELETE ALL" & Chr(10) & Chr(10), False)
End Sub
Public Function GetLayers(ByVal dsDoc As Document) As String() 'Get Layer Manager Dim dsLayerManager As DraftSight.LayerManager Dim dsLayers() As Object Set dsLayerManager = dsDoc.GetLayerManager dsLayers = dsLayerManager.GetLayers() Dim dslayerNames() As String Dim nbrLayers As Long nbrLayers = UBound(dsLayers) ReDim dslayerNames(nbrLayers)
Dim i As Long For i = 0 To nbrLayers Dim dsLayer As DraftSight.Layer Set dsLayer = dsLayers(i) dslayerNames(i) = dsLayer.Name Next
GetLayers = dslayerNames End Function
' Class1
Option Explicit
Public WithEvents app As DraftSight.Application Public Sub app_CommandPreNotify(ByVal commandPreNotifyCommand As String, ByVal doc As DraftSight.Document) MsgBox ("CommandPreNotify event was fired before " & commandPreNotifyCommand & " was executed.") End Sub
Public Sub app_CommandPostNotify(ByVal commandPostNotifyCommand As String, ByVal doc As DraftSight.Document) MsgBox ("CommandPostNotify event was fired after " & commandPostNotifyCommand & " was executed.") End Sub