关于直线判断的问题……

rainman

在VBA中已知两平行直线和任意一直线的Object,如何判断此任意直线是否处于两平行线之间.

leeyeafu

基本思路是判断线段的左端点（可用线段的X坐标值确定）是否在左侧平行线的右侧，线段的右端点是否在另一平行线左侧。
我理解平行线是几何意义上的直线，即两端无限延长。为了编程方便，请告知平行线的具体描述，也就是说，程序中用什么属性来确定平行线的位置，比如说，方向、通过点......

rainman

即已知一条直线的Object1,  Object1= ThisDrawing.ModelSpace.AddLine(startPoint, endPoint),  Object2=Object1.Offset(H).
现在的问题是任意一条直线Object3,如何判断Object3是否在Object1, Object2之间?

leeyeafu

首先，你要判断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

rainman

其实判断Object3是否在两平行线之间,既是判断Object3的两端点分别与两平行线固定一侧的端点之连线的斜率和平行线的斜率的比较问题.

leeyeafu

你那样做会有些问题：
1、Object1斜率为负，如何判断？另外k1,k2的负值判断？
2、斜率可以是无穷大，你要预先处理这种情况，否则程序将会溢出错。
3、你仔细想想，当pt1与object1.StartPoint的连线不同角度范围(0-90,90-180,180-270,270-360)会有不同的结果，要进行不同的处理。
因此，你的方法实现起来应该更麻烦。

rainman

leeyeafu

dianbotang

取得该任意直线与两条平行线的交点，以及该直线的起点和端点。

判断这些点的纵坐标或横坐标大小关系。

如果起点和端点的横坐标都位于两交点的横坐标之间，就说明该直线位于两平行线之间。

判断纵坐标也可以。

按照这个思路编程如下。两边界线可以不平行。

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 Or x > b And x < a Then
    belong = True
  Else
    belong = False
  End If
End Function