|
|
发表于 2007-11-16 23:08:00
|
显示全部楼层
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 |
|
置顶卡
