|
|
发表于 2002-9-3 14:43:00
|
显示全部楼层
取得该任意直线与两条平行线的交点，以及该直线的起点和端点。
判断这些点的纵坐标或横坐标大小关系。
如果起点和端点的横坐标都位于两交点的横坐标之间，就说明该直线位于两平行线之间。
判断纵坐标也可以。
按照这个思路编程如下。两边界线可以不平行。
Sub 两线夹线()
On Error Resume Next
Dim lineObj0 As AcadObject
Dim Pnt0 As Variant
ThisDrawing.Utility.GetEntity lineObj0, Pnt0, "选择要判断位置的直线"
If Err Then Exit Sub
lineObj0.Highlight (True)
Dim lineObj1 As AcadObject
Dim Pnt1 As Variant
ThisDrawing.Utility.GetEntity lineObj1, Pnt1, "选择边界直线1"
If Err Then Exit Sub
lineObj0.Highlight (False)
lineObj1.Highlight (True)
Dim lineObj2 As AcadObject
Dim Pnt2 As Variant
ThisDrawing.Utility.GetEntity lineObj2, Pnt2, "选择边界直线2"
If Err Then Exit Sub
lineObj1.Highlight (False)
lineObj2.Highlight (True)
Dim intersection1 As Variant
intersection1 = lineObj0.IntersectWith(lineObj1, acExtendBoth)
Dim intersection2 As Variant
intersection2 = lineObj0.IntersectWith(lineObj2, acExtendBoth)
Dim startpoint As Variant
startpoint = lineObj0.startpoint
Dim endpoint As Variant
endpoint = lineObj0.endpoint
If belong(startpoint(0), intersection1(0), intersection2(0)) = True Then
If belong(endpoint(0), intersection1(0), intersection2(0)) = True Then
MsgBox "该直线位于两直线中间。"
lineObj2.Highlight (False)
Debug.Print startpoint(0)
Debug.Print endpoint(0)
Debug.Print intersection1(0)
Debug.Print intersection2(0)
Exit Sub
End If
End If
MsgBox "该直线不在两直线中间。"
lineObj2.Highlight (False)
End Sub
Function belong(x, a, b) As Boolean
If x > a And x b And x |
|
置顶卡
