Insert Sketch Text and Hole Example (VBA)
This example shows how to insert sketch text and a hole at the selected
point on a face.
'-----------------------------------------------
'
' Preconditions: A model document is open and a face is
selected.
'
' Postconditions: The specified text and a hole are created
on the
' face
at the point of selection.
'
'-----------------------------------------------
Option Explicit
Dim swApp As SldWorks.SldWorks
Dim swPart As SldWorks.PartDoc
Dim swModel As SldWorks.ModelDoc2
Dim swSelMgr As SldWorks.SelectionMgr
Dim eTapLocations(9) As Variant
Dim boolstatus As Boolean
Function TransformPoint(ByVal Sketch1 As Sketch, ByVal
X As Double, ByVal Y As Double, ByVal Z As Double) As Variant
Dim
ptArr(2) As Double
ptArr(0)
= X
ptArr(1)
= Y
ptArr(2)
= Z
Dim
NewPt As Variant
Dim
swMathUtil As SldWorks.MathUtility
Set
swMathUtil = swApp.GetMathUtility
Dim
swMathPt As SldWorks.MathPoint
Set
swMathPt = swMathUtil.CreatePoint((ptArr))
Dim
params As Variant
params
= swMathPt.ArrayData
Dim
swMathTrans As SldWorks.MathTransform
Set
swMathTrans = Sketch1.ModelToSketchTransform
Set
swMathPt = swMathPt.MultiplyTransform(swMathTrans)
NewPt
= swMathPt.ArrayData()
TransformPoint
= NewPt
End Function
Sub main()
Set
swApp = Application.SldWorks
Set
swPart = swApp.ActiveDoc
Set
swModel = swApp.ActiveDoc
Set
swSelMgr = swPart.SelectionManager
Dim selFace As Face2
Dim selEnt As Entity
Dim selPt As Variant
Set selFace = swSelMgr.GetSelectedObject6(1,
-1)
Set selEnt = selFace
selPt = swSelMgr.GetSelectionPoint2(1,
-1)
Dim selData As SldWorks.SelectData
Set selData = swSelMgr.CreateSelectData
selData.X
= selPt(0)
selData.Y
= selPt(1)
selData.Z
= selPt(2)
Dim swSketchMgr As SldWorks.SketchManager
Set swSketchMgr = swModel.SketchManager
swSketchMgr .InsertSketch
True
selPt = TransformPoint(swModel.IGetActiveSketch2,
selPt(0), selPt(1), selPt(2))
Dim skText As SketchText
Set skText = swModel.InsertSketchText(selPt(0),
selPt(1), selPt(2), "Hole", 0, 0, 0, 100, 100)
Dim params As Variant
params = skText.GetCoordinates
swSketchMgr.InsertSketch
True
boolstatus = selEnt.Select4(False,
selData)
Dim holeFeat As SldWorks.Feature
Dim swFeatMgr As SldWorks.FeatureManager
Set swFeatMgr = swModel.FeatureManager
Set holeFeat = swFeatMgr.SimpleHole(0.001,
True, False, False, 0, 0, 0.001, 0.001, False, False, False, False, 0,
0, False, False, False, False, 1, 1)
End Sub