Insert Splines Example (VBA)

This example shows how to:

• construct several Splines, which are displayed as the Dassault Systèmes logo in a DraftSight drawing.
• fire events before and after commands are executed.
• select a group of entities and modify members in that group of entities.
• execute a command using IApplication::RunCommand.

'--------------------------------------------------------------
' 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