Sub GetCenter() Dim ExcelApp As New Excel.Application Dim ExcelWkbk As Excel.Workbook Set ExcelWkbk = ExcelApp.Workbooks.Add Dim i As Integer i = 2 Dim Ent As AcadEntity Dim pt1 As Variant, pt2 As Variant With ExcelWkbk.Worksheets("Sheet1") For Each Ent In ThisDrawing.ModelSpace If Ent.ObjectName = "AcDbCircle" Then .Range("A" & i) = i - 1 pt1 = Ent.Center .Range("B" & i) = pt1(0) .Range("C" & i) = pt1(1) i = i + 1 End If Next Ent End With ExcelApp.ActiveWorkbook.SaveAs "D:\AcDCenter.xls" ExcelApp.Workbooks.Close ExcelApp.Quit End Sub 结果在"D:\AcDCenter.xls"里 |