Option Explicit
Dim xlApp As Object
Dim xlBook As Object
Dim xlSheet As Object
'将CAD的图形数据写入Excel
Public Sub CadToExcel()
Dim sset As AcadSelectionSet
Dim filterType(0) As Integer, filterData(0) As Variant
On Error Resume Next
Set sset = ThisDrawing.SelectionSets.Add("ToExcel")
If Err.Number <> 0 Then
Err.Clear
Set sset = ThisDrawing.SelectionSets.Item("ToExcel")

ThisDrawing.ModelSpace.AddCircle dblCenter, dblRadius
Case "AcDbLine"
Dim dblStartP(2) As Double, dblEndP(2) As Double
strTemp = Split(xlSheet.Range(("B" & i)), ",") &#39;读入起点坐标数据
For j = 0 To 2: dblStartP(j) = Val(strTemp(j)): Next j
strTemp = (Split(xlSheet.Range(("C" & i)), ","))&#39;读入终点坐标数据
For j = 0 To 2: dblEndP(j) = Val(strTemp(j)): Next j
ThisDrawing.ModelSpace.AddLine dblStartP, dblEndP
Case "AcDbArc"
Dim dblStartAngle As Double, dblEndAngle As Double
dblRadius = Val(xlSheet.Range(("B" & i))) &#39;读入半径数据
strTemp = Split(xlSheet.Range(("C" & i)), ",")&#39;读入圆心坐标数据
For j = 0 To 2: dblCenter(j) = Val(strTemp(j)): Next j
dblStartAngle = Val(xlSheet.Range(("D" & i))) &#39;读入起始角数据
dblEndAngle = Val(xlSheet.Range(("E" & i))) &#39;读入终止角数据
ThisDrawing.ModelSpace.AddArc dblCenter, dblRadius, dblStartAngle, dblEndAngle
End Select
Next i
xlBook.Close
xlApp.Quit
Set xlSheet = Nothing
Set xlBook = Nothing
Set xlApp = Nothing

End Sub