Hello,

I would like to retrieve the coordinates of the vertices of a pre-selected rectangular face, but with coordinates relative to the active sketch.

The correct coordinates relative to the pre-selected face in the figure should be:

X 0 Y -49.27602687

X 30-Y 49.27602687

X 30 Y 28.00416462

X 0 Y 28.00416462

But the macro doesn't work correctly,

Could you help me? I enclose also the model on which to test and a picture on the face to be selected for testing.

Thanks to all

Here my macro

' Preconditions:
'       (1) Part or Assembly is open.
'       (2) Face of a component is selected.
'
' Postconditions: The four vertex coordinate relative to active sketch are return
'
'
'--------------------------------------

Option Explicit

Sub main()

    Dim pSWApp                      As SldWorks.SldWorks
    Dim pModel                      As SldWorks.ModelDoc2
    Dim pSelMgr                     As SldWorks.SelectionMgr
    Dim pSketch                     As SldWorks.Sketch
    Dim pSketchSeg                  As SldWorks.SketchSegment
    Dim pFace                       As SldWorks.Face2
    Dim swLoop                      As SldWorks.Loop2
    Dim swEdge                      As SldWorks.Edge
    Dim vEdgeArr                    As Variant
    Dim vEdge                       As Variant
    Dim swCurve                     As SldWorks.Curve
    Dim swSketch                    As SldWorks.Sketch
    Dim swSketchSeg                 As SldWorks.SketchSegment
    Dim swXForm                     As SldWorks.MathTransform
    Dim swMathUtil                  As SldWorks.MathUtility
    Dim swMathStartPt               As SldWorks.MathPoint
    Dim swMathEndPt                 As SldWorks.MathPoint

    Dim vMidPts                     As Variant
    Dim vCurveParam                 As Variant
    Dim nStartPt(2)                 As Double
    Dim nEndPt(2)                   As Double
    Dim nEdgeCount                  As Long
    Dim i                           As Long
    Dim j                           As Long
    Dim bRet                        As Boolean
    Dim boolstatus                  As Boolean

    Set pSWApp = CreateObject("SldWorks.Application")
    Set pModel = pSWApp.ActiveDoc
    Set pSelMgr = pModel.SelectionManager
    Set pFace = pSelMgr.GetSelectedObject6(1, 0)

    If pFace Is Nothing Then
        boolstatus = pSWApp.SendMsgToUser2("Please select a face", _
                                            swMbWarning, swMbOk)
        Exit Sub
    End If

    pModel.InsertSketch2 True
    pModel.SetAddToDB True
    pModel.SetDisplayWhenAdded False  'Doesn't show the changes during
                                                           'the program execution
             
    Set pSketch = pModel.GetActiveSketch2
    Set swXForm = pSketch.ModelToSketchTransform 'Transform from model to sketch
    Set swMathUtil = pSWApp.GetMathUtility
   
    'Find loops of closed edges on the selected surface
    Set swLoop = pFace.GetFirstLoop
    While Not swLoop Is Nothing
        i = i + 1
        Debug.Print "Loop(" & i & ")"
        Debug.Print "  IsOuter    = " & swLoop.IsOuter
        Debug.Print "  IsSingular = " & swLoop.IsSingular
        Debug.Print ""
       
        'Find the outer loop
        If swLoop.IsOuter Then
            vEdgeArr = swLoop.GetEdges: Debug.Assert UBound(vEdgeArr) >= 0
            nEdgeCount = swLoop.GetEdgeCount
           
            'Even number of edges are available here.
            If Not nEdgeCount Mod 2 = 0 Then
                boolstatus = pSWApp.SendMsgToUser2( _
                        "Please select the rectangular face...", _
                        swMbWarning, swMbOk)
                        pModel.InsertSketch2 True
                        bRet = pModel.EditRebuild3: Debug.Assert bRet
                Exit Sub
            End If
               

'Here start the problem
            i = 0
            For Each vEdge In vEdgeArr
                Set swEdge = vEdge
                vCurveParam = swEdge.GetCurveParams2

                For j = 0 To 1
                    nStartPt(j) = vCurveParam(j)
                    nEndPt(j) = vCurveParam(j)
                Set swMathStartPt = swMathUtil.CreatePoint((nStartPt))
                Set swMathStartPt = swMathStartPt.MultiplyTransform(swXForm)
                Set swMathEndPt = swMathUtil.CreatePoint((nEndPt))
                Set swMathEndPt = swMathEndPt.MultiplyTransform(swXForm)
               
                Debug.Print "Edge " & j & " X:" & (swMathStartPt.ArrayData(0) * 1000#) & " Y:" & (swMathStartPt.ArrayData(1) * 1000#) & " Z:" & (swMathStartPt.ArrayData(2) * 1000#)

                Next j

            Next vEdge

        End If
        Set swLoop = swLoop.GetNext
    Wend
      
    pModel.SetDisplayWhenAdded True
    pModel.SetAddToDB False

End Sub