Rotate and Copy 3D Sketch About Coordinates Example (VBA)
This example shows how to rotate and copy 3D sketches.
'-------------------------------------
' Preconditions: Document with two 3D sketches,
' named
3DSketch1 and 3DSketch2,
' is
open.
'
' Postconditions:
' 1. The 3DSketch2 sketch is copied and rotated around
' the
center point of the 3DSketch1 sketch's arc.
' 2. The 3DSketch1 sketch is rotated around the center point of
' its
arc.
'-------------------------------------
Option Explicit
Sub main()
Dim
SwApp As SldWorks.SldWorks
Dim
swModel As SldWorks.ModelDoc2
Dim
swSelMgr As SldWorks.SelectionMgr
Dim
swModelDocExt As SldWorks.ModelDocExtension
Dim
swSelData As SldWorks.SelectData
Dim
swSketchMgr As SldWorks.SketchManager
Dim
swSketch As SldWorks.Sketch
Dim
boolStatus As Boolean
Dim
varSketchSegments As Variant
Dim
i As Integer
Set
SwApp = Application.SldWorks
'
If SolidWorks not running, then exit macro
If
SwApp Is Nothing Then Exit Sub
'
Document with two 3D sketches, named 3DSketch2 and
'
3DSketch1, is open and active
Set
swModel = SwApp.ActiveDoc
If
swModel Is Nothing Then
MsgBox
"Failed to open document."
Exit
Sub
End
If
Set
swModelDocExt = swModel.Extension
Set
swSelMgr = swModel.SelectionManager
Set
swSelData = swSelMgr.CreateSelectData
Set
swSketchMgr = swModel.SketchManager
'
Select 3DSketch2 sketch
boolStatus
= swModelDocExt.SelectByID2("3DSketch2",
"SKETCH", 0, 0, 0, False, 0, Nothing, 0)
If
boolStatus = False Then
MsgBox
"Failed to select 3DSketch2 sketch."
Exit
Sub
End
If
'
Open 3DSketch2 sketch in edit mode
swModel.EditSketch
Set
swSketch = swSketchMgr.ActiveSketch
If
swSketch Is Nothing Then
MsgBox
"Failed to get pointer to 3DSketch2 sketch."
Exit
Sub
End
If
'
Select all sketch segments in 3DSketch2 sketch
varSketchSegments
= swSketch.GetSketchSegments()
For
i = 0 To UBound(varSketchSegments)
boolStatus
= varSketchSegments(i).select4(True,
swSelData)
If
boolStatus = False Then MsgBox "Failed to select sketch segment instance."
& i & "."
Next
i
'
Copy and rotate 3DSketch2 sketch about center
'
point of 3DSketch1 sketch's arc
Debug.Print
"Rotating and copying 3DSketch2 sketch about the center point of 3DSketch1's
arc? " & swSketchMgr.RotateOrCopy3DAboutXYZ(True,
1, True, -0.09925811702374, 0.004131001848179, 0, 1.5707963267949, 0,
0)
swModel.ClearSelection2 True
'
Exit 3DSketch2 sketch
swSketchMgr.InsertSketch True
'
Select 3DSketch1 sketch
boolStatus
= swModelDocExt.SelectByID2("3DSketch1",
"SKETCH", 0, 0, 0, False, 0, Nothing, 0)
If
boolStatus = False Then
MsgBox
"Failed to select 3DSketch1 sketch."
Exit
Sub
End
If
'
Edit 3DSketch1 sketch
swModel.EditSketch
Set
swSketch = swModel.GetActiveSketch2
If
swSketch Is Nothing Then
MsgBox
"Failed to get pointer to 3DSketch1 sketch."
Exit
Sub
End
If
'
Select all sketch segments in 3DSketch1 sketch
varSketchSegments
= swSketch.GetSketchSegments()
For
i = 0 To UBound(varSketchSegments)
boolStatus
= varSketchSegments(i).select4(True,
swSelData)
If
boolStatus = False Then
MsgBox
"Failed to select sketch segment instance." & i & "."
Exit
Sub
End
If
Next
i
'
Rotate 3DSketch1 sketch about the
'
center point of its own arc
Debug.Print
"Rotating 3DSketch1 sketch about the center point of its arc? "
& swSketchMgr.RotateOrCopy3DAboutXYZ(False,
1, True, -0.09925811702374, 0.004131001848179, 0, 1.5707963267949, 0,
0)
swModel.ClearSelection2 True
'
Exit 3DSketch1 sketch
swSketchMgr.InsertSketch True
End Sub