Hide Table of Contents

Rotate and Copy Entities Example (VBA)

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


Provide feedback on this topic

SOLIDWORKS welcomes your feedback concerning the presentation, accuracy, and thoroughness of the documentation. Use the form below to send your comments and suggestions about this topic directly to our documentation team. The documentation team cannot answer technical support questions. Click here for information about technical support.

* Required

 
*Email:  
Subject:   Feedback on Help Topics
Page:   Rotate and Copy Entities Example (VBA)
*Comment:  
*   I acknowledge I have read and I hereby accept the privacy policy under which my Personal Data will be used by Dassault Systèmes

Print Topic

Select the scope of content to print:



x

We have detected you are using a browser version older than Internet Explorer 7. For optimized display, we suggest upgrading your browser to Internet Explorer 7 or newer.

 Never show this message again
x

Web Help Content Version: API Help (English only) 2019 SP04

To disable Web help from within SOLIDWORKS and use local help instead, click Help > Use SOLIDWORKS Web Help.

To report problems encountered with the Web help interface and search, contact your local support representative. To provide feedback on individual help topics, use the “Feedback on this topic” link on the individual topic page.