[VBA程序]：将模型空间实体信息输出到EXCEL

自由的鱼

这里只输出了对象名，颜色，层名，线型

Sub outexcel()
Dim xlApp As Excel.Application
Dim xlbook As Excel.Workbook
Dim xlSheet As Excel.Worksheet
On Error Resume Next
Set xlApp = GetObject(, "excel.application")
If Err <> 0 Then
Err.Clear
Set xlApp = CreateObject("excel.application")
If Err <> 0 Then
MsgBox "无法启动excel"
Exit Sub
End If
End If
Set xlbook = xlApp.Workbooks.Add
Set xlSheet = xlbook.ActiveSheet
xlApp.Visible = True
xlSheet.Cells(1, 1) = "对象名"
xlSheet.Cells(1, 2) = "颜色"
xlSheet.Cells(1, 3) = "层名"
xlSheet.Cells(1, 4) = "线型"
Dim i As Integer
For i = 0 To ThisDrawing.ModelSpace.Count - 1
With ThisDrawing.ModelSpace(i)
xlSheet.Cells(i + 2, 1) = .ObjectName
xlSheet.Cells(i + 2, 2) = .Color
xlSheet.Cells(i + 2, 3) = .Layer
xlSheet.Cells(i + 2, 4) = .Linetype
End With
Next

End Sub