Get x,y,z Locations of Points in Sketch Example (VBA)

This example shows how to get the x, y, and z locations of the points in the selected sketch.

 

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

'

' 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

End 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

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