The Get3DFace will obtain all 3dface entities in the current open drawing, then extract all the coordinates to MyCords
Sub Get3DFace() Dim I As Long, N As Long
Dim MyCords() As Double
Dim NewCords() As Double
Dim MyFace As Acad3DFace
Dim txtset As AcadSelectionSet
Dim intCode(0) As Integer
Dim varData(0) As Variant
Set txtset = Aset("TextSet")
intCode(0) = 0: varData(0) = "3DFACE"
txtset.Select acSelectionSetAll, , , intCode, varData
For I = 0 To txtset.Count - 1
'Debug.Print TxtSet(I).TextString
If txtset(I).ObjectName = "AcDbFace" Then
Set MyFace = txtset(I)
If I = 0 Then
MyCords = MyFace.Coordinates
Else
N = UBound(MyCords, 1) + 1
ReDim Preserve MyCords(UBound(MyCords, 1) + 12)
'MyCords(N) = MyFace.Coordinates
NewCords = MyFace.Coordinates
Call AddElements(MyCords, NewCords, N, N + 11)
End If
End If
Next
End Sub
'
' This will add the elements of one array to another single line array
'
Private Sub AddElements(iAddArray() As Double, iAddToArray() As Double, iStr As Long, iEnd As Long)
Dim I As Long, N As Long
N = 0
For I = iStr To iEnd
iAddArray(I) = iAddToArray(N)
If N < 12 Then
N = N + 1
End If
Next
End Sub
'
' This gets a selecton set, it helps a lot in debugging, it will delete the existing selection set without doing anything to the members of the existing selection set.
'
Public Function Aset(iSSetName As String) As AcadSelectionSet
Dim ssetA As AcadSelectionSet
On Error Resume Next
Set ssetA = ThisDrawing.SelectionSets.Add(iSSetName)
If Err.Number <> 0 Then
Set ssetA = ThisDrawing.SelectionSets(iSSetName)
ssetA.Delete
Set ssetA = ThisDrawing.SelectionSets.Add(iSSetName)
Err.Clear
End If
On Error GoTo 0
Set Aset = ssetA
End Function