Move Copy Sketch Entities Example (VBA)

This example shows how to move, copy, and move and copy sketch entities.

 

'-------------------------------------

'

' Preconditions: Model document that has a sketch

'                named Sketch1 is open and that sketch

'                has Arc1 and Line1 entities.

'

' Postconditions: None

'

'--------------------------------------

Option Explicit

 

Dim swApp As SldWorks.SldWorks

 

Sub main()

 

    Dim swModel            As SldWorks.ModelDoc2

    Dim swModelExtension   As SldWorks.ModelDocExtension

    Dim swPart             As SldWorks.PartDoc

    Dim swFeature          As SldWorks.Feature

    Dim swSketchMgr        As SldWorks.SketchManager

    Dim bValue             As Boolean

    Dim lIdx               As Long

    Dim bCopy              As Boolean

    Dim lNumCopies         As Long

    Dim aBasePoint(2)      As Double

    Dim aMoveVector(2)     As Double

    

    Set swApp = Application.SldWorks

    Set swModel = swApp.ActiveDoc    

    Set swModelExtension = swModel.Extension    

    Set swPart = swModel

    Set swSketchMgr = swModel.SketchManager

    

    Set swFeature = swPart.FeatureByName("Sketch1")

    bValue = swFeature.Select2(False, 0)

    swModel.EditSketch

    

    aBasePoint(0) = 0#

    aBasePoint(1) = 0#

    aBasePoint(2) = 0#

 

    aMoveVector(0) = 0.1

    aMoveVector(1) = 0#

    aMoveVector(2) = 0#

    

    For lIdx = 0 To 2

        swModel.ClearSelection2 True

        bValue = swModelExtension.SelectByID2("Arc1", "SKETCHSEGMENT", 0#, 0#, 0#, False, 0, Nothing, 0)

        bValue = swModelExtension.SelectByID2("Line1", "SKETCHSEGMENT", 0#, 0#, 0#, True, 0, Nothing, 0)

        Select Case (lIdx)

            Case 0

' Move

                bCopy = False

                lNumCopies = 0

            Case 1

' Move and copy once

                bCopy = True

                lNumCopies =

            Case 2

' Move and copy twice

                bCopy = True

                lNumCopies = 2

        End Select

        If (Not bCopy) Then

            lNumCopies = 0

        End If

        swModelExtension.MoveOrCopy bCopy, lNumCopies, True, aBasePoint(0), aBasePoint(1), 0#, aBasePoint(0) + aMoveVector(0), aBasePoint(1) + aMoveVector(1), aBasePoint(2) + aMoveVector(2)

        swModel.ClearSelection2 True

        ' Examine the model document to see what has changed

        Stop

        ' Undo so that you can do it again, but differently

        swModel.EditUndo2 1

    Next lIdx

    swSketchMgr.Insert3DSketch True    

End Sub