Hi Robert
In this case try another routine
Attn: Both Acad and Excel must be open,
just minimize an Excel window
Option Explicit
Sub ShowCirclePoint()
Dim MyXL As Object
Dim xlsheet As Object
Dim xlFileName As String
xlFileName = "D:\My Documents\AutoCAD testing.xls"
Set MyXL = GetObject(xlFileName)
Set xlsheet = MyXL.Worksheets("AutoCAD")
Dim oSset As AcadSelectionSet
Dim fcode(0) As Integer
Dim fData(0) As Variant
Dim dxfcode, dxfdata
Dim i As Integer
Dim setName As String
Dim objAcadEntity As AcadEntity
Dim centerPoint(0 To 2) As Double
Dim circleObj As AcadCircle
Dim radius As Double
Dim cPoint As Variant
Dim mCir As Long
'Build filter to select circles
fcode(0) = 0
fData(0) = "CIRCLE" '<--entity type
dxfcode = fcode
dxfdata = fData
setName = "$Circle$"
On Error GoTo Err_Control
ZoomAll
'Make sure selection set does not exist
For i = 0 To ThisDrawing.SelectionSets.Count - 1
If ThisDrawing.SelectionSets.Item(i).Name = setName Then
ThisDrawing.SelectionSets.Item(i).Delete
Exit For
End If
Next i
Set oSset = ThisDrawing.SelectionSets.Add(setName)
oSset.Select acSelectionSetAll, , , dxfcode, dxfdata
MsgBox "Wait... "
xlsheet.Cells(1, 1) = "No."
xlsheet.Cells(1, 2) = "Easting"
xlsheet.Cells(1, 3) = "Northing"
xlsheet.Cells(1, 4) = "Elevation"
xlsheet.Cells(1, 5) = "Radius"
mCir = 1
'Process each citrcle
For Each objAcadEntity In oSset
Set circleObj = objAcadEntity
radius = circleObj.radius
cPoint = circleObj.Center
xlsheet.Cells(mCir + 1, 1) = mCir
xlsheet.Cells(mCir + 1, 2) = cPoint(0)
xlsheet.Cells(mCir + 1, 3) = cPoint(1)
xlsheet.Cells(mCir + 1, 4) = cPoint(2)
xlsheet.Cells(mCir + 1, 5) = radius
mCir = mCir + 1
Next
xlsheet.UsedRange.Columns.AutoFit
MyXL.SaveAs xlFileName, , , , False
Err_Control:
If Err.Number <> 0 Then
MsgBox Err.Description
End If
End Sub
Hth
~'J'~