This example shows how to rotate and copy selected entities.
'-------------------------------------------------------------- ' 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, ' install_dir\bin\dsAutomation.dll. ' 4. Start DraftSight and open a new document. ' 5. Construct these three entities: Circle, Spline, and Ellipse. ' 6. Run the macro. ' ' Postconditions: ' 1. When the prompt appears in the DraftSight command window, ' select the Circle and Ellipse entities and press ' the Enter key. The selected entities are rotated. ' 2. Execution stops so that you can examine the drawing to ' verify that the selected entities were rotated. Click the ' Continue button in the IDE to continue. ' 3. The selected entities are copied. '---------------------------------------------------------------- Option Explicit
Dim dsApp As DraftSight.Application
Sub main()
'Connect to DraftSight application Set dsApp = GetObject(, "DraftSight.Application") 'Abort any command currently running in DraftSight 'to avoid nested commands dsApp.AbortRunningCommand
'Get active document Dim dsDoc As DraftSight.Document Set dsDoc = dsApp.GetActiveDocument() If dsDoc Is Nothing Then MsgBox ("There are no open documents in DraftSight.") Return End If
'Get model space Dim dsModel As DraftSight.Model Set dsModel = dsDoc.GetModel()
'Get Sketch Manager Dim dsSketchMgr As DraftSight.SketchManager Set dsSketchMgr = dsModel.GetSketchManager()
'Get Selection Manager Dim dsSelectionMgr As DraftSight.SelectionManager Set dsSelectionMgr = dsDoc.GetSelectionManager
'Get selection filter Dim dsSelectionFilter As DraftSight.SelectionFilter Set dsSelectionFilter = dsSelectionMgr.GetSelectionFilter
'Clear selection filter dsSelectionFilter.Clear
'Add Circle and Ellipse entity types to the selection filter Dim entityType As Variant Dim entityArray As Variant entityArray = Array(dsObjectType_e.dsCircleType, dsObjectType_e.dsEllipseArcType)
For Each entityType In entityArray dsSelectionFilter.AddEntityType (entityType) Next
'Activate selection filter dsSelectionFilter.Active = True
'Get command message object Dim dsCommandMessage As CommandMessage Set dsCommandMessage = dsApp.GetCommandMessage
'Clear previous selection dsSelectionMgr.ClearSelections (dsSelectionSetType_Previous)
'Prompt user to select the Circle and the Ellipse Dim singleSelection As Boolean singleSelection = False Dim prompt As String prompt = "Select the Circle and Ellipse entities" Dim errorMessage As String errorMessage = "Unknown entity"
Dim statusSelect As Boolean statusSelect = dsCommandMessage.PromptForSelection(singleSelection, prompt, errorMessage)
If statusSelect Then
'Get number of selected entities Dim count As Long count = dsSelectionMgr.GetSelectedObjectCount(dsSelectionSetType_e.dsSelectionSetType_Previous) If count <> 2 Then Debug.Print ("You did not select the two entities. Rerun the macro and try again.") End End If
Dim dsEntityType As dsObjectType_e Dim dsEntities() As Object Dim dsEntityTypes() As dsObjectType_e ReDim dsEntities(count - 1) ReDim dsEntityTypes(count - 1)
'Get selected entities Dim index As Long index = 0 For index = 0 To (count - 1) Dim selectedEntity As Object Set selectedEntity = dsSelectionMgr.GetSelectedObject(dsSelectionSetType_Previous, index, dsEntityType) dsEntityTypes(index) = dsEntityType Set dsEntities(index) = selectedEntity Next
'Rotation parameters Dim pivotPointX As Double pivotPointX = 0# Dim pivotPointY As Double pivotPointY = 0# Dim rotateAngle As Double rotateAngle = 3.14159265358979 / 4 ' In radians
'Rotate entities dsSketchMgr.RotateEntities pivotPointX, pivotPointY, rotateAngle, dsEntityTypes, dsEntities
'Stop execution 'Examine the document Stop
'Click the Continue button in the IDE
'Copy parameters Dim displacementX As Double displacementX = 2# Dim displacementY As Double displacementY = 2# Dim displacementZ As Double displacementZ = 0#
'Copy entities dsSketchMgr.CopyEntities displacementX, displacementY, displacementZ, dsEntityTypes, dsEntities
End If
End Sub