Pulling coordinate entity of multiple objects

[hasanyanizm]

Hello everybody,

I have written a code to receive all 12 coordinates of 3dface object in to a single array.

First I added object id's in to a single array by this code.

For i = 0 To ss.Count - 1
If ss.Item(i).ObjectName = "AcDbFace" Then
ReDim Preserve xucgenmodel(w)
xucgenmodel(w) = ss(i).ObjectID
w = w + 1
End If

And then by using objectid's I am trying to pull all coordinates into single array by this code;


For i = 0 To UBound(xucgenmodel)


ReDim Preserve Ucgencoords(11 * (i + 1))


Ucgencoords = ActiveDocument.ObjectIdToObject(xucgenmodel(i)).Coordinates


Next i

But here I have a problem each time it loops it resets the previous numbers and doesnt continue. Any help is appreciated.

NOTES: 1 3DFACE HAS 12 COORDİNATES (starting from item(0) to item(11). So if I have 10 3DFACE's I should have 10*12= 120 rows array.

[RICVB]

Hello everybody,

I have written a code to receive all 12 coordinates of 3dface object in to a single array.

First I added object id's in to a single array by this code.
For i = 0 To ss.Count - 1
If ss.Item(i).ObjectName = "AcDbFace" Then
ReDim Preserve xucgenmodel(w)
xucgenmodel(w) = ss(i).ObjectID
w = w + 1
End If

And then by using objectid's I am trying to pull all coordinates into single array by this code;

For i = 0 To UBound(xucgenmodel)


ReDim Preserve Ucgencoords(11 * (i + 1))


Ucgencoords = ActiveDocument.ObjectIdToObject(xucgenmodel(i)).Coordinates


Next i

But here I have a problem each time it loops it resets the previous numbers and doesnt continue. Any help is appreciated.

NOTES: 1 3DFACE HAS 12 COORDİNATES (starting from item(0) to item(11). So if I have 10 3DFACE's I should have 10*12= 120 rows array.

At every iteration you must add new coordinates starting from the array item right after the last one added in the previuous iteration
you could do something like

For i = 0 To UBound(xucgenmodel)

ReDim Preserve Ucgencoords(12*(i+1)-1)
for w = 0 to 11
Ucgencoords (12*i + w)= ActiveDocument.ObjectIdToObject(xucgenmodel(i)).Coordinates(w)
next w

Next i

where I also modfied your Ucgencoords redimming, since your "ReDim Preserve Ucgencoords(11 * (i + 1))" would lead to a [0 to 22] array at the second iteration (i=1) whereas there you would need a [0 to 23] array (i.e. a 12*2 = 24 elements array)
Finally I didn't test it, and may be it needs some type variables tuning

[Tommy]

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