3D Objects properties

[tuli01]

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