Create Drag Arrow Manipulator Example (VBA)
This example shows how to create a drag arrow manipulator, which is
called a handle in the user interface.
Modules
'----------------------------------------------------------------
'
' Preconditions: Part or assembly is open and a face is
selected.'
'
' Postconditions: A drag arrow manipulator is created
on the selected face.
'
' NOTE: The drag arrow created in this example has no
functionality.
' You
must provide the code for your intended functionality.
'-----------------------------------------------------------------
Option Explicit
Dim
swManip As
SldWorks.Manipulator
Public
swDrag As
SldWorks.DragArrowManipulator
Dim
swDragHdlr As
swDragManipHdlr
Public
swFace As
SldWorks.face2
Sub main()
Dim
swApp As
SldWorks.SldWorks
Dim
swMathUtil As
SldWorks.MathUtility
Dim
swModel As
SldWorks.ModelDoc2
Dim
swModViewMgr As
SldWorks.ModelViewManager
Dim
swSelMgr As
SldWorks.SelectionMgr
Dim
vPickPt As
Variant
Dim
swPickPt As
SldWorks.MathPoint
Dim
boolstatus As Boolean
Set
swDragHdlr = New swDragManipHdlr
Set
swApp = Application.SldWorks
Set
swMathUtil = swApp.GetMathUtility
Set
swModel = swApp.ActiveDoc
Set
swSelMgr = swModel.SelectionManager
Set
swFace = swSelMgr.GetSelectedObject6(1,
0)
Dim
nVector(2) As
Double
Dim
vVector As
Variant
nVector(0)
= 0: nVector(1)
= 1: nVector(2)
= 0
vVector
= nVector
Dim
swN As
SldWorks.MathVector
Set
swN = swMathUtil.CreateVector((vVector))
vPickPt
= swSelMgr.GetSelectionPoint2(1,
-1)
Set
swPickPt = swMathUtil.CreatePoint((vPickPt))
Set
swModViewMgr = swModel.ModelViewManager
Set
swManip = swModViewMgr.CreateManipulator(SwConst.SwManipulatorType_e.swDragArrowManipulator,
swDragHdlr)
Set
swDrag = swManip.GetSpecificManipulator
swDrag.ShowOppositeDirection = True
swDrag.length = 0.1
swDrag.Direction = swN
swDrag.LengthOppositeDirection = 0.01
swDrag.origin = swPickPt
swManip.Show swModel
swDrag.LengthOppositeDirection = 0.1
swDrag.Update
Dim
origin As SldWorks.MathPoint
Set
origin = swDrag.origin
Dim
pt As Variant
pt
= origin.ArrayData
End Sub
'----------------------------------------------------
Class modules
'-----------------------------------------------------------------------------
Option Explicit
Implements SwManipulatorHandler2
______________________________________________________________________________
Private Function SwManipulatorHandler2_OnDelete(ByVal
pManipulator As Object) As Boolean
Debug.Print
"SwManipulatorHandler2_OnDelete"
End Function
______________________________________________________________________________
Private Sub SwManipulatorHandler2_OnDirectionFlipped(ByVal
pManipulator As Object)
Debug.Assert
False
Debug.Print
"SwManipulatorHandler2_OnDirectionFlipped"
End Sub
______________________________________________________________________________
Private Function SwManipulatorHandler2_OnDoubleValueChanged(ByVal
pManipulator As Object, ByVal Id As Long, Value As Double) As Boolean
'Debug.Assert
False
Debug.Print
"SwManipulatorHandler2_OnDoubleValueChanged"
Debug.Print
" ID
=
" & Id
Debug.Print
" Value
=
" & Value
End Function
______________________________________________________________________________
Private Sub SwManipulatorHandler2_OnEndDrag(ByVal pManipulator
As Object)
Debug.Print
"SwManipulatorHandler2_OnEndDrag"
End Sub
______________________________________________________________________________
Private Sub SwManipulatorHandler2_OnEndDrag(ByVal pManipulator
As Object, ByVal handleIndex As Long)
Debug.Print
"SwManipulatorHandler2_OnEndDrag"
Debug.Print
" HandleIndex
=
" & handleIndex
If
(handleIndex = swDragArrowManipulatorOptions_e.swDragArrowManipulatorDirection2)
Then
Debug.Print
" Direction1"
Else
Debug.Print
" Direction2"
End
If
End Sub
______________________________________________________________________________
Private Sub SwManipulatorHandler2_OnHandleRmbSelected(ByVal
pManipulator As Object, ByVal handleIndex As Long)
Debug.Print
"SwManipulatorHandler2_OnHandleRmbSelected"
Debug.Print
" handleIndex
=
" + handleIndex
End Sub
______________________________________________________________________________
Private Sub SwManipulatorHandler2_OnHandleSelected(ByVal
pManipulator As Object, ByVal handleIndex As Long)
Debug.Print
"SwManipulatorHandler2_OnHandleSelected"
Debug.Print
" HandleIndex
=
" + handleIndex
End Sub
______________________________________________________________________________
Private Sub SwManipulatorHandler2_OnItemSetFocus(ByVal
pManipulator As Object, ByVal Id As Long)
Debug.Assert
False
Debug.Print
"SwManipulatorHandler2_OnItemSetFocus"
Debug.Print
" ID
=
" & Id
End Sub
______________________________________________________________________________
Private Function SwManipulatorHandler2_OnLmbSelected(ByVal
pManipulator As Object) As Boolean
Debug.Assert
False
Debug.Print
"SwManipulatorHandler2_OnLmbSelected"
End Function
______________________________________________________________________________
Private Function SwManipulatorHandler2_OnStringValueChanged(ByVal
pManipulator As Object, ByVal Id As Long, Value As String) As Boolean
Debug.Assert
False
Debug.Print
"SwManipulatorHandler2_OnStringValueChanged"
Debug.Print
" ID
=
" & Id
Debug.Print
" Value
=
" & Value
End Function
______________________________________________________________________________
Private Sub SwManipulatorHandler2_OnUpdateDrag(ByVal pManipulator
As Object, ByVal handleIndex As Long, ByVal newPosMathPt As Object)
Debug.Print
"SwManipulatorHandler2_OnUpdateDrag"
Debug.Print
" HandleIndex
=
" & handleIndex
End Sub