Sub GetFacePoints()
    Dim oFace As Face
    Set oFace = ThisApplication.ActiveDocument.SelectSet(1)
    Dim tolerance As Double
    Dim vertexCount As Long
    Dim facetCount As Long
    Dim vertexCoordinates() As Double
    Dim normalVectors() As Double
    Dim vertexIndices() As Long
    
    tolerance = 0.01
    
    Call oFace.CalculateFacets(tolerance, vertexCount, facetCount, vertexCoordinates, normalVectors, vertexIndices)
    
    Call CreateStrokesWorkPoints(vertexCoordinates)
    
End Sub
Sub CreateStrokesWorkPoints(vertexCoordinates() As Double)
    Dim part As PartDocument
    Set part = ThisApplication.ActiveDocument
    
    Dim wPoints As workPoints
    Set wPoints = part.ComponentDefinition.workPoints
    
    For i = 0 To UBound(vertexCoordinates) Step 3
        Call wPoints.AddFixed(ThisApplication.TransientGeometry.CreatePoint(vertexCoordinates(i), vertexCoordinates(i + 1), vertexCoordinates(i + 2)))
    Next
    
End Sub