Sub GetObjName() 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 .Range("A" & i) = i - 1 pt1 = Ent.ObjectID pt2 = Ent.ObjectName .Range("B" & i) = Ent.ObjectName i = i + 1 Next Ent End With ExcelApp.ActiveWorkbook.SaveAs "D:\ACADtext.xls" ExcelApp.Workbooks.Close ExcelApp.Quit End Sub |