‘本例演示判断两个图元是否交叉？有几个交点？交点坐标分别是什么？
‘绑定 AutoCAD
Dim I As Integer, J As Integer
Dim oAutoCAD As Object
Call BindAutoCAD(True)
‘打开并绑定文件 D:/Test.dwg
Dim oDraw As Object ‘AutoCAD 多文档之一
Set oDraw = oAutoCAD.Application.Documents.Open(“D:/Test.dwg”)
‘建立选择集
Dim oSelset As Object, oItem As Object
Dim TempName As String
TempName = SelName(8)
If SetExist(oDraw, TempName) Then oDraw.SelectionSets.Item(TempName).Delete
Set oSelset = oDraw.SelectionSets.Add(TempName)
oDraw.Activate
‘屏幕选择多个图元填入选择集，列出前两个图元之间交点的坐标
Dim IntersectPoint As Variant
oSelset.SelectOnScreen
‘Debug.Print “oSelSet.Count” & Space$(1) &”=” & Space$(1) & oSelSet.Count
If oSelset.Count > 1 Then ‘最少两个,但只认前两个
‘ Find the intersection points between the oSelSet(0) and the oSelSet(1)
IntersectPoint = oSelset(0).IntersectWith(oSelset(1), 0)
‘ acExtendNone Does not extend either object.
‘ acExtendThisEntity Extends the base object.
‘ acExtendOtherEntity Extends the object passed as an argument.
‘ acExtendBoth Extends both objects.
‘ Print all the intersection points
If VarType(IntersectPoint) <> vbEmpty Then
For I = LBound(IntersectPoint) To UBound(IntersectPoint) Step 3
Debug.Print “Intersection[” & (I + 3) / 3 & “/” & (UBound(IntersectPoint) – LBound(IntersectPoint) + 1) / 3 & “]:” & Space$(1) & _
IntersectPoint(I) & “,” & IntersectPoint(I + 1) & “,” & IntersectPoint(I + 2)
Next I
Else
Debug.Print “No intersection points.”
End If
End If
‘解除绑定,释放资源
oSelset.Delete
Set oSelset = Nothing
Set oItem = Nothing