This example shows how to get the x, y, and z locations of the points in the selected sketch.
这个例子展示了如何在选中的草图中获取x、y和z的位置。
'---------------------------------------------
'
' Preconditions: Model document is open and a sketch is selected.
'
' Postconditions: None
'
'----------------------------------------------
Option Explicit
Sub ProcessSketchPoint _
( _
swApp As SldWorks.SldWorks, _
swModel As SldWorks.ModelDoc2, _
swSkPt As SldWorks.SketchPoint _
)
Dim vID                    As Variant
Dim swSketch                As SldWorks.sketch
Dim swMathUtil              As SldWorks.MathUtility
Dim swXform                As SldWorks.MathTransform
Dim nPt(2)                  As Double
Dim vPt                    As Variant
Dim swMathPt                As SldWorks.MathPoint
Set swSketch = swSkPt.GetSketch
vID = swSkPt.GetId
Debug.Print "    ID = [" & vID(0) & "," & vID(1) & "]"
If swSketch.Is3D Then
' Point is already is in model space
Debug.Print "      Point (model)    = (" & swSkPt.x * 1000# & ", " & swSkPt.y * 1000# & ", " & swSkPt.z * 1000# & ") mm"
Else
nPt(0) = swSkPt.x:  nPt(1) = swSkPt.y:  nPt(2) = swSkPt.z
vPt = nPt
Set swXform = swSketch.ModelToSketchTransform
Set swXform = swXform.Inverse
Set swMathUtil = swApp.GetMathUtility
Set swMathPt = swMathUtil.CreatePoint((vPt))
Set swMathPt = swMathPt.MultiplyTransform(swXform)
Debug.Print "      Point (model)    = (" & swMathPt.ArrayData(0) * 1000# & ", " & swMathPt.ArrayData(1) * 1000# & ", " & swMathPt.ArrayData(2) * 1000# & ") mm"
Debug.Print "      Point (sketch)  = (" & swSkPt.x * 1000# & ", " & swSkPt.y * 1000# & ", " & swSkPt.z * 1000# & ") mm"
End If
printformEnd Sub
Sub main()
Dim swApp                  As SldWorks.SldWorks
Dim swModel                As SldWorks.ModelDoc2
Dim swSelMgr                As SldWorks.SelectionMgr
Dim swFeat                  As SldWorks.feature
Dim swSketch                As SldWorks.sketch
Dim vSkPtArr                As Variant
Dim vSkPt                  As Variant
Dim swSkPt                  As SldWorks.SketchPoint
Dim i                      As Long
Dim bRet                    As Boolean
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
Set swSelMgr = swModel.SelectionManager
Set swFeat = swSelMgr.GetSelectedObject6(1, 0)
Set swSketch = swFeat.GetSpecificFeature2
Debug.Print "Feature = " & swFeat.Name
Debug.Print "  Sketch Points:"
vSkPtArr = swSketch.GetSketchPoints2: If IsEmpty(vSkPtArr) Then Exit Sub
For Each vSkPt In vSkPtArr
Set swSkPt = vSkPt
ProcessSketchPoint swApp, swModel, swSkPt
Next vSkPt
End Sub

版权声明：本站内容均来自互联网，仅供演示用，请勿用于商业和其他非法用途。如果侵犯了您的权益请与我们联系QQ:729038198，我们将在24小时内删除。