ACAD - VBA - Extracting 3D objects peoperties

[tuli]

Hello,

I have this routine (see below) which prints to a file the coordinates of polylines and lines selected from the screen.
I would like to enhance this routine by allowing it to get the information from 3D objects. I was not able to find anything on the topic. Is it possible at all?
To be clear, what I want to do is:
"Windows select" or "object by object" select from the screen different 3D objects which might be primitives (or results of 3d objects editing) and print on an ascii file their properties (as if I would "select/rightclick/properties/geometry")
For a sphere that would be Center X/Center Y/Center Z etc.

Please let me know

Tuli


Public Sub SelectionSetInfo()
Dim sset As AcadSelectionSet
Dim ACADObj As Variant
Dim i As Integer
Dim fileid As Integer
Dim startpoint As Variant
Dim endpoint As Variant
Dim coordinates As Variant

'if sset with the name mentioned above already exists - delete it
For Each sset In ThisDrawing.SelectionSets
If sset.Name = ssetname Then
sset.Delete
Exit For
End If
Next sset
'add new sset
Set sset = ThisDrawing.SelectionSets.Add(ssetname)
'ask user to select something
sset.SelectOnScreen
'if there are no selected objects
If sset.Count = 0 Then
MsgBox "You have not selected any object.", , "Error"
sset.Delete
Exit Sub
End If

fileid = 1

'here you can use all sset object properties
'it is important to pay attention on object type
'for example Line object does not have Center Property
'and Circle object does not have EndPoint

'you can not only get some properties but
'set them
'for example you can change object color

For Each ACADObj In sset

Print #fileid, "ID=" & Trim(Str(ACADObj.ObjectID))
Print #fileid, "Name=" & ACADObj.ObjectName
Select Case ACADObj.ObjectName
Case "AcDbLine"
Print #fileid, "AcDbLine"
startpoint = ACADObj.startpoint
endpoint = ACADObj.endpoint
For i = 0 To 2
Print #fileid, "StartPoint(" & Trim(Str(i)) & ")=" & Trim(Str(startpoint(i)))
Next i
For i = 0 To 2
Print #fileid, "EndPoint(" & Trim(Str(i)) & ")=" & Trim(Str(endpoint(i)))
Next i
Case "AcDbPolyline"
Print #fileid, "AcDbPolyLine"
coordinates = ACADObj.coordinates
For i = 0 To UBound(coordinates)
Print #fileid, "Coordinate(" & Trim(Str(i)) & ")=" & Trim(Str(coordinates(i)))
Next i
End Select
ACADObj.color = color

Next ACADObj

Close #fileid

End Sub

 

[TCARPENTER1]

Hi Tuli,

Check the help files under the Acad3DSolid object - this should get you going.

HTH
Todd

 

[tuli]

I might be new to this but which "Help" ?

Here in the forum or in Autocad?

Tx
T

 

[TCARPENTER1]

Hi Tuli,

The help file from AutoCAD. Select the help pulldown, and then go to the developers/customization area and look for the AutoCAD VBA section. Or even easier, in the VBA editor from AutoCAD, just type Acad3DSolid, then place your cursor over it and press F1.

HTH
Todd