|
|
以下代码，如果先画出直线，再画多段线就能求出交点
但如果先画多段线，再画直线就求不出交点（只要有一条多段线画的顺序在直线前边就不行），请帮忙看一下，在线等待
Sub Example_Select()
' 创建选择集
Dim ssetObj As AcadSelectionSet
On Error Resume Next
Set ssetObj = ThisDrawing.SelectionSets("SSET")
If Err Then
Err.Clear
Set ssetObj = ThisDrawing.SelectionSets.Add("SSET")
End If
ssetObj.Clear
'构造过滤机制
Dim groupCode(0) As Integer
Dim dataCode(0) As Variant
groupCode(0) = 0
dataCode(0) = "lwPolyline"
ssetObj.Select acSelectionSetAll, , , groupCode, dataCode
'获取直线的外框
Dim corner1 As Variant
Dim corner2 As Variant
Dim lineObj As AcadLine
Set lineObj = ThisDrawing.ModelSpace(0)
lineObj.GetBoundingBox corner1, corner2 'lineObj为位于0层的直线
ssetObj.Select acSelectionSetCrossing, corner1, corner2, groupCode, dataCode
'枚举交点，判断是否相交
Dim Pts As Variant
Dim i As Integer
Dim j As Integer
For i = 0 To ssetObj.Count - 1
Pts = ssetObj(i).IntersectWith(lineObj, acExtendNone)
If Not IsEmpty(Pts) Then
Debug.Print "多段线（" & ssetObj(i).Handle & "）与直线（" & lineObj.Handle & "）相交"
For j = 0 To UBound(Pts) Step 3
Debug.Print "交点：" & Pts(j) & "," & Pts(j + 1) & "," & Pts(j + 2)
Next
End If
Next
End Sub |
|
置顶卡
