rainman 发表于 2002-9-2 12:32:00

关于直线判断的问题……

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



leeyeafu 发表于 2002-9-2 14:36:00

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

rainman 发表于 2002-9-2 17:07:00

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

leeyeafu 发表于 2002-9-3 09:31:00




首先，你要判断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)pt1 Then IsInner = False
   dy1 = pt2(1) - objLine2.StartPoint(1)
   dx1 = dx * dy1 / dy
   If objLine2.StartPoint(0) + dx1pt1 Then IsInner = False
   dy1 = pt2(1) - objLine1.StartPoint(1)
   dx1 = dx * dy1 / dy
   If objLine1.StartPoint(0) + dx1

rainman 发表于 2002-9-3 10:52:00

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

leeyeafu 发表于 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 xb And x
页: [1]
查看完整版本: 关于直线判断的问题……