Sub Example_IntersectWith()
Dim xlApp As Object ' This Line ,Not set Excel , run Excel 'Dim xlsheet As Object ' 发生错误时跳到下一个语句继续执行 On
Error
Resume
Next ' 连接Excel应用程序 Set xlApp =
GetObject(, "Excel.Application") If Err.Number <> 0 Then Set xlApp = CreateObject("Excel.Application") xlApp.Visible
= True xlApp.Workbooks.Add End If ' 返回当前活动的工作表 'Set xlsheet = xlApp.ActiveSheet Set xlSheet = xlApp.sheets(1)
' This example creates a line and circle and finds the points at ' which they intersect. Dim oBject As
AcadEntity, oBject1 As
AcadEntity Dim ii As Integer, jj As Integer Dim Ppt As Variant nn = 1 For ii = 0 To ThisDrawing.ModelSpace.Count - 1 Set oBject =
ThisDrawing.ModelSpace.Item(ii) For jj = 0 To ThisDrawing.ModelSpace.Count - 1 Set oBject1 =
ThisDrawing.ModelSpace.Item(jj) Ppt = oBject1.IntersectWith(oBject, acExtendOtherEntity) xlSheet.Cells(nn, 1).Value
= Format(Ppt(0), "0.0") xlSheet.Cells(nn, 2).Value
= Format(Ppt(1), "0.0") xlSheet.Cells(nn, 3).Value
= Ppt(2) Debug.Print Ppt(0), Ppt(1), Ppt(2) Debug.Print nn, oBject.Handle, oBject1.Handle xlSheet.Cells(nn, 4).Value
= nn nn = nn + 1 Next jj Next ii End Sub 直接用调用Excel
|