AnsweredAssumed Answered

HELP on macro for Convert sketchpoint coordinate to assembly

Question asked by roberto gennari on Jan 17, 2017
Latest reply on Jan 18, 2017 by William Cruz

Hallo,

I need to convert the coordiante of the sketch point to assembly coordiante.

I tried this macro to convert but the result in wrong, the correct result are the coordiante in the lower of frame of SolidWorks (see the image)

The part in the assembly is traslate in X axis of 100 mm about, so the assembly origin and the part origin insn't the same.

The macro return the point coordinate reference to the part(model) not the conversion of the assembly coordinate.

 

have you any idea how to fix it?

 

Thanks a lot

Roberto

 

' Preconditions:

'       (1) Part, assembly or drawing is open.

'       (2) If a part or assembly, then a sketch is being edited.

'       (3) If a part or assembly, then an entity is selected in

'           the sketch.

'       (4) If a drawing, then an entity is selected.

'

' Postconditions: None

'

' NOTES:

'       (1) If the sketch is a 3D sketch, then the selected sketch

'           point is automatically in model coordinates.

'       (2) If the sketch is a 3D sketch, then its transform is the

'           unit transform.

'

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

Option Explicit

Public Function GetModelCoordinates(swApp As SldWorks.SldWorks, swSketch As SldWorks.Sketch, vPtArr As Variant) As Variant

    Dim swMathPt                    As SldWorks.MathPoint

    Dim swMathUtil                  As SldWorks.MathUtility

    Dim swMathTrans                 As SldWorks.MathTransform

    Set swMathUtil = swApp.GetMathUtility

    Set swMathPt = swMathUtil.CreatePoint(vPtArr)

    ' Is a unit transform if 3D sketch; for example, selected sketch

    ' point is automatically in model space

    Set swMathTrans = swSketch.ModelToSketchTransform

    Set swMathTrans = swMathTrans.Inverse

    Set swMathPt = swMathPt.MultiplyTransform(swMathTrans)

    GetModelCoordinates = swMathPt.ArrayData

End Function

Sub main()

    Dim swApp                       As SldWorks.SldWorks

    Dim swModel                     As SldWorks.ModelDoc2

    Dim swSelMgr                    As SldWorks.SelectionMgr

    Dim swSketch                    As SldWorks.Sketch

    Dim vSketchSelPt                As Variant

    Dim vModelSelPt                 As Variant

    Dim i                           As Long

   

    Set swApp = Application.SldWorks

    Set swModel = swApp.ActiveDoc

    Set swSelMgr = swModel.SelectionManager

    Set swSketch = swModel.GetActiveSketch2

   

    vSketchSelPt = swSelMgr.GetSelectionPointInSketchSpace(1)

    vModelSelPt = GetModelCoordinates(swApp, swSketch, vSketchSelPt)

   

    Debug.Print "File = " & swModel.GetPathName

    Debug.Print "  Is3D sketch          = " & swSketch.Is3D

    Debug.Print "  SelPt (sketch space) = (" & vSketchSelPt(0) * 1000# & ", " & vSketchSelPt(1) * 1000# & ", " & vSketchSelPt(2) * 1000# & ") mm"

    Debug.Print "  SelPt (model  space) = (" & vModelSelPt(0) * 1000# & ", " & vModelSelPt(1) * 1000# & ", " & vModelSelPt(2) * 1000# & ") mm"

End Sub

 

 

Result in the immediate window

 

  Is3D sketch          = Falso

  SelPt (sketch space) = (138, 283.85, 0) mm

  SelPt (model  space) = (138, 283.85, 6.81797779247439) mm

 

I need:

X-19.5 Y283.85 Z 6.8179

Outcomes