关于直线判断的问题……
在VBA中已知两平行直线和任意一直线的Object,如何判断此任意直线是否处于两平行线之间.这不是一个太难的算法，但需平行线的具体描述
基本思路是判断线段的左端点（可用线段的X坐标值确定）是否在左侧平行线的右侧，线段的右端点是否在另一平行线左侧。我理解平行线是几何意义上的直线，即两端无限延长。为了编程方便，请告知平行线的具体描述，也就是说，程序中用什么属性来确定平行线的位置，比如说，方向、通过点......
在程序中两条平行线是用Offset得到的......
即已知一条直线的Object1,Object1= ThisDrawing.ModelSpace.AddLine(startPoint, endPoint),Object2=Object1.Offset(H).现在的问题是任意一条直线Object3,如何判断Object3是否在Object1, Object2之间?
给你个思路
首先，你要判断Object1和Object2的左右位置关系，Object3两端点的左右关系。下面的代码示例做了Object1和Object2的位置判断。Object3在两平行线之间，即pt1在Object1右侧，pt2在Object2左侧。
如图，计算与pt1同样Y坐标值，在Object1上点的X坐标，并与pt1(x)比较得到位置关系。以下示例代码未加注释，结合图形就不难理解。（约定pt1在pt2左侧）
Private Function IsInner(pt1 As Variant, pt2 As Variant) As Boolean
Dim dx, dy, dx1, dy1 As Double
dx = objLine1.StartPoint(0) - objLine1.EndPoint(0)
dy = objLine1.StartPoint(1) - objLine1.EndPoint(1)
If objLine1.StartPoint(0) < objLine2.StartPoint(0) Then
dy1 = pt1(1) - objLine1.StartPoint(1)
dx1 = dx * dy1 / dy
If objLine1.StartPoint(0) + dx1 > pt1 Then IsInner = False
dy1 = pt2(1) - objLine2.StartPoint(1)
dx1 = dx * dy1 / dy
If objLine2.StartPoint(0) + dx1 < pt1 Then IsInner = False
Else
dy1 = pt1(1) - objLine2.StartPoint(1)
dx1 = dx * dy1 / dy
If objLine2.StartPoint(0) + dx1 > pt1 Then IsInner = False
dy1 = pt2(1) - objLine1.StartPoint(1)
dx1 = dx * dy1 / dy
If objLine1.StartPoint(0) + dx1 < pt1 Then IsInner = False
End If
IsInner = True
End Function
谢谢!你的思路提醒了我……
其实判断Object3是否在两平行线之间,既是判断Object3的两端点分别与两平行线固定一侧的端点之连线的斜率和平行线的斜率的比较问题.这是显然的，但...
你那样做会有些问题：1、Object1斜率为负，如何判断？另外k1,k2的负值判断？
2、斜率可以是无穷大，你要预先处理这种情况，否则程序将会溢出错。
3、你仔细想想，当pt1与object1.StartPoint的连线不同角度范围(0-90,90-180,180-270,270-360)会有不同的结果，要进行不同的处理。
因此，你的方法实现起来应该更麻烦。
也可以使用夹角判断,考虑一下……
办法多多，方便就好
<p>取得该任意直线与两条平行线的交点，以及该直线的起点和端点。</p><p>判断这些点的纵坐标或横坐标大小关系。</p><p>如果起点和端点的横坐标都位于两交点的横坐标之间，就说明该直线位于两平行线之间。</p><p>判断纵坐标也可以。</p><p>按照这个思路编程如下。两边界线可以不平行。</p><p>Sub 两线夹线()<br/> On Error Resume Next<br/> Dim lineObj0 As AcadObject<br/> Dim Pnt0 As Variant<br/> ThisDrawing.Utility.GetEntity lineObj0, Pnt0, "选择要判断位置的直线"<br/> If Err Then Exit Sub<br/> lineObj0.Highlight (True)<br/> Dim lineObj1 As AcadObject<br/> Dim Pnt1 As Variant<br/> ThisDrawing.Utility.GetEntity lineObj1, Pnt1, "选择边界直线1"<br/> If Err Then Exit Sub<br/> lineObj0.Highlight (False)<br/> lineObj1.Highlight (True)<br/> Dim lineObj2 As AcadObject<br/> Dim Pnt2 As Variant<br/> ThisDrawing.Utility.GetEntity lineObj2, Pnt2, "选择边界直线2"<br/> If Err Then Exit Sub<br/> lineObj1.Highlight (False)<br/> lineObj2.Highlight (True)<br/> <br/> Dim intersection1 As Variant<br/> intersection1 = lineObj0.IntersectWith(lineObj1, acExtendBoth)<br/> Dim intersection2 As Variant<br/> intersection2 = lineObj0.IntersectWith(lineObj2, acExtendBoth)<br/> Dim startpoint As Variant<br/> startpoint = lineObj0.startpoint<br/> Dim endpoint As Variant<br/> endpoint = lineObj0.endpoint<br/> <br/> If belong(startpoint(0), intersection1(0), intersection2(0)) = True Then<br/> If belong(endpoint(0), intersection1(0), intersection2(0)) = True Then<br/> MsgBox "该直线位于两直线中间。"<br/> lineObj2.Highlight (False)<br/> Debug.Print startpoint(0)<br/> Debug.Print endpoint(0)<br/> Debug.Print intersection1(0)<br/> Debug.Print intersection2(0)<br/> Exit Sub<br/> End If<br/> End If<br/> MsgBox "该直线不在两直线中间。"<br/> lineObj2.Highlight (False)<br/>End Sub</p><p>Function belong(x, a, b) As Boolean<br/> If x > a And x < b Or x > b And x < a Then<br/> belong = True<br/> Else<br/> belong = False<br/> End If<br/>End Function</p>
页:
[1]