急求：C#已知一条线（含三条线段）求平行线代码

[qiansong113]

条件： 1、从屏幕上通过鼠标随机输入一条线，至少3个线段。（如下图 黑色 部分）
2、通过对话框输入2个垂距（A和B）。
结果： 生成与输入线平行的二条线（两侧各一条）
与输入线的距离分别为已输入的垂距。

[Hide1984]

从屏幕上输入一根线，那么这条直线是知道的。
设直线方程是y=ax+b(1) // 其中，a,b为常数，x,y为变量。
那么，平行线方程是y = ax + K(2) //K为变量，垂线A所在方程为 y = -ax + k(3)
分别对直线1和3已及2和3求交点。
假设交点为(x1，y1),(x2,y2) //都是包含变量K的。
然后y2-y1的平方加上X2-X1的平方就是A的平方啊～～～～～

[qiansong113]

能给点具体的代码么./.对于我这个第一次接触图形方面问题的菜鸟有点难懂

[qiansong113]

555

[aa_0910]

感觉挺有趣的，帮顶。。。。

[zhoujk]

在网上找一段代码，已经两条线段分别以端点的坐标(x,y)来定义。求它们的交点。如果无法返回交点，则它们是平行线。如果你找不到，告诉我，我在我的机机上找一下，如果没删的话，就发给你

[chxg99]

可以参考GIS中线段缓存区算法的代码。

[zteclx]

可以看看计算机图形学

[qiansong113]

5楼的大哥。。。一条线。三个线段。有2个已知焦点。以前从来没有做过这一块。所以搞不会，求您施舍一下 。555

[快乐的不老仙翁]

从楼上各位的讨论，给你一个思路。
首先，初始条件有三条线，每个线段就是一个有起始点坐标以及斜率的对象数组。这样就有了这样一组对象数据集合，你的第一个目标是判断这个集合中是否存在两个元素数组中有相同的斜率（你也可以限制起始点不同，这样可以避免重叠的两条线）。如果有，你需要算出这两个数组之间的距离。然后去构造两个新的对象加到这个集合中，至于根据这个集合去画线就很简单了。

[ATGO]

试试：


/// <summary>
/// 获取线点a(x1, y1) 点b(x2, y2)平行向左右移动offset后的矩形区域
/// </summary>
/// <param name="p_p1"></param>
/// <param name="p_p2"></param>
/// <param name="p_offset"></param>
/// <returns></returns>
public Point[] GetPoints(int x1, int y1, int x2, int y2, int p_offset)
{
double k = (((x2 - x1) == 0) ? 0 : (double)(y2 - y1) / (x2 - x1));

double sink = Math.Pow(Math.Pow(k, 2) / (1 + Math.Pow(k, 2)), 1 / 2);
double cosk = Math.Pow(1 / (Math.Pow(k, 2) + 1), 1 / 2);

if (k < 0)
cosk = -cosk;
else if ((y2 - y1) == 0)
sink = 0;
else if ((x2 - x1) == 0)
cosk = 0;

double ax = x1 + p_offset * sink;
double ay = y1 - p_offset * cosk;
double bx = x1 - p_offset * sink;
double by = y1 + p_offset * cosk;

double cx = x2 + p_offset * sink;
double cy = y2 - p_offset * cosk;
double dx = x2 - p_offset * sink;
double dy = y2 + p_offset * cosk;

Point a = new Point((int)ax, (int)ay);
Point c = new Point((int)cx, (int)cy);

Point b = new Point((int)bx, (int)by);
Point d = new Point((int)dx, (int)dy);
return new Point[] { a, c, d, b };
}

[qiansong113]

哪位仁兄能给点具体的代码或者算法。小弟确实不懂

[qiansong113]

[Quote=引用 7 楼 okokwukai 的回复:]
从楼上各位的讨论，给你一个思路。
首先，初始条件有三条线，每个线段就是一个有起始点坐标以及斜率的对象数组。这样就有了这样一组对象数据集合，你的第一个目标是判断这个集合中是否存在两个元素数组中有相同的斜率（你也可以限制起始点不同，这样可以避免重叠的两条线）。如果有，你需要算出这两个数组之间的距离。然后去构造两个新的对象加到这个集合中，至于根据这个集合去画线就很简单了。
[/Quote]这个问题我也一直在想。也许是我编程能力不行吧。 总是没有办法吧算法转化成代码

[chxg99]

大体思路如下：
1、计算输入线段所在直线的斜率K
2、通过K求与之垂直直线的斜率k’=-1/k(K<>0);
3、假设垂线通过线段的一个端点，从而在其上求一点p（x，y）使得P到该段点的距离为输入的垂距A或者B，从而得到关于P点x，y坐标的方程组，解得p点坐标。
4、通过另一端点求的另一点P‘（x'，y'）
5、通过pp'画线机所求平行线

[qiansong113]

数学基本上都还给老师了、14楼的意思是通过点到直线的距离公式去求交点的坐标。可是方程组对我来说有点难度

[魏生]

有vb的，使用过，可是使用。
你改改：

思想是把多折线分成单直线，然后循环。有好几种特殊情况要单独分析，这个程序没有设计好，复杂度有点高，你可以重新设计一下。


Option Explicit

Public Type PointBaseParall '基线的顶点
X_b As Double
Y_b As Double
End Type

Public Type LineParallel '平行线的顶点
x() As Double '第一维表示左右，第二维表示点号
y() As Double
End Type


Option Explicit

'传入：基线顶点坐标，偏移量，条数，哪一边（0左，1右，2两边）
'传出：平行线的顶点坐标
Private Sub ParallelPoint(PtBase() As PointBaseParall, dis As Double, numLines As Integer, sID As Integer, LnPara() As LineParallel)

Dim PtBaseOne As PointBaseParall
Dim PtBaseTwo As PointBaseParall
Dim PtBaseThree As PointBaseParall

If UBound(PtBase) = 1 Then '如果只有两个点
PtBaseOne = PtBase(0)
PtBaseTwo = PtBase(1)

If PtBaseOne.Y_b = PtBaseTwo.Y_b Then '垂直于x轴
Dim c1 As Integer
If PtBaseTwo.X_b > PtBaseOne.X_b Then
For c1 = 0 To numLines - 1
LnPara(c1).y(0, 0) = PtBaseOne.Y_b + dis * (c1 + 1) '第一点
LnPara(c1).x(0, 0) = PtBaseOne.X_b
LnPara(c1).y(1, 0) = PtBaseOne.Y_b - dis * (c1 + 1)
LnPara(c1).x(1, 0) = PtBaseOne.X_b

LnPara(c1).y(0, 1) = PtBaseTwo.Y_b + dis * (c1 + 1) '第二点
LnPara(c1).x(0, 1) = PtBaseTwo.X_b
LnPara(c1).y(1, 1) = PtBaseTwo.Y_b - dis * (c1 + 1)
LnPara(c1).x(1, 1) = PtBaseTwo.X_b
Next c1
Else
For c1 = 0 To numLines - 1
LnPara(c1).y(0, 0) = PtBaseOne.Y_b - dis * (c1 + 1) '第一点
LnPara(c1).x(0, 0) = PtBaseOne.X_b
LnPara(c1).y(1, 0) = PtBaseOne.Y_b + dis * (c1 + 1)
LnPara(c1).x(1, 0) = PtBaseOne.X_b

LnPara(c1).y(0, 1) = PtBaseTwo.Y_b - dis * (c1 + 1) '第二点
LnPara(c1).x(0, 1) = PtBaseTwo.X_b
LnPara(c1).y(1, 1) = PtBaseTwo.Y_b + dis * (c1 + 1)
LnPara(c1).x(1, 1) = PtBaseTwo.X_b
Next c1
End If
ElseIf PtBaseOne.X_b = PtBaseTwo.X_b Then '垂直于y轴
If PtBaseTwo.Y_b > PtBaseOne.Y_b Then
For c1 = 0 To numLines - 1
LnPara(c1).x(0, 0) = PtBaseOne.X_b - dis * (c1 + 1) '第一点
LnPara(c1).y(0, 0) = PtBaseOne.Y_b
LnPara(c1).x(1, 0) = PtBaseOne.X_b + dis * (c1 + 1)
LnPara(c1).y(1, 0) = PtBaseOne.Y_b

LnPara(c1).x(0, 1) = PtBaseTwo.X_b - dis * (c1 + 1) '第二点
LnPara(c1).y(0, 1) = PtBaseTwo.Y_b
LnPara(c1).x(1, 1) = PtBaseTwo.X_b + dis * (c1 + 1)
LnPara(c1).y(1, 1) = PtBaseTwo.Y_b
Next c1
Else
For c1 = 0 To numLines - 1
LnPara(c1).x(0, 0) = PtBaseOne.X_b + dis * (c1 + 1) '第一点
LnPara(c1).y(0, 0) = PtBaseOne.Y_b
LnPara(c1).x(1, 0) = PtBaseOne.X_b - dis * (c1 + 1)
LnPara(c1).y(1, 0) = PtBaseOne.Y_b

LnPara(c1).x(0, 1) = PtBaseTwo.X_b + dis * (c1 + 1) '第二点
LnPara(c1).y(0, 1) = PtBaseTwo.Y_b
LnPara(c1).x(1, 1) = PtBaseTwo.X_b - dis * (c1 + 1)
LnPara(c1).y(1, 1) = PtBaseTwo.Y_b
Next c1
End If
Else
Dim slope As Double '斜率
Dim cVer As Double '垂直于原直线的方程Y=AX+C的c
Dim cBase As Double '原直线方程Y=AX+C的c
Dim cParaLeft As Double '平行于原直线的方程Y=AX+C的c
Dim cParaRight As Double

slope = (PtBaseTwo.Y_b - PtBaseOne.Y_b) / (PtBaseTwo.X_b - PtBaseOne.X_b)
cVer = PtBaseOne.Y_b + PtBaseOne.X_b / slope
cBase = PtBaseOne.Y_b - PtBaseOne.X_b * slope

If PtBaseTwo.X_b > PtBaseOne.X_b Then
For c1 = 0 To numLines - 1
LnPara(c1).y(0, 0) = PtBaseOne.Y_b + Sqr((dis * (c1 + 1)) ^ 2 / (slope ^ 2 + 1))
LnPara(c1).x(0, 0) = -slope * (LnPara(c1).y(0, 0) - PtBaseOne.Y_b) + PtBaseOne.X_b
LnPara(c1).y(1, 0) = PtBaseOne.Y_b - Sqr((dis * (c1 + 1)) ^ 2 / (slope ^ 2 + 1))
LnPara(c1).x(1, 0) = -slope * (LnPara(c1).y(1, 0) - PtBaseOne.Y_b) + PtBaseOne.X_b

LnPara(c1).y(0, 1) = PtBaseTwo.Y_b + Sqr((dis * (c1 + 1)) ^ 2 / (slope ^ 2 + 1))
LnPara(c1).x(0, 1) = -slope * (LnPara(c1).y(0, 1) - PtBaseTwo.Y_b) + PtBaseTwo.X_b
LnPara(c1).y(1, 1) = PtBaseTwo.Y_b - Sqr((dis * (c1 + 1)) ^ 2 / (slope ^ 2 + 1))
LnPara(c1).x(1, 1) = -slope * (LnPara(c1).y(1, 1) - PtBaseTwo.Y_b) + PtBaseTwo.X_b
Next c1
Else
For c1 = 0 To numLines - 1
LnPara(c1).y(0, 0) = PtBaseOne.Y_b - Sqr((dis * (c1 + 1)) ^ 2 / (slope ^ 2 + 1))
LnPara(c1).x(0, 0) = -slope * (LnPara(c1).y(0, 0) - PtBaseOne.Y_b) + PtBaseOne.X_b
LnPara(c1).y(1, 0) = PtBaseOne.Y_b + Sqr((dis * (c1 + 1)) ^ 2 / (slope ^ 2 + 1))
LnPara(c1).x(1, 0) = -slope * (LnPara(c1).y(1, 0) - PtBaseOne.Y_b) + PtBaseOne.X_b

LnPara(c1).y(0, 1) = PtBaseTwo.Y_b - Sqr((dis * (c1 + 1)) ^ 2 / (slope ^ 2 + 1))
LnPara(c1).x(0, 1) = -slope * (LnPara(c1).y(0, 1) - PtBaseTwo.Y_b) + PtBaseTwo.X_b
LnPara(c1).y(1, 1) = PtBaseTwo.Y_b + Sqr((dis * (c1 + 1)) ^ 2 / (slope ^ 2 + 1))
LnPara(c1).x(1, 1) = -slope * (LnPara(c1).y(1, 1) - PtBaseTwo.Y_b) + PtBaseTwo.X_b
Next c1
End If

End If

Else

Dim i As Integer
For i = LBound(PtBase) To UBound(PtBase) - 2

PtBaseOne = PtBase(i) '以三个点为单位向前推进
PtBaseTwo = PtBase(i + 1)
PtBaseThree = PtBase(i + 2)

Dim isFirstPoint As Boolean '判断是否为起点
Dim isLastPoint As Boolean '判断是否为终点

isFirstPoint = False
If i = LBound(PtBase) Then
isFirstPoint = True
End If

isLastPoint = False
If i = UBound(PtBase) - 2 Then
isLastPoint = True
End If


Dim slopeBase(1) As Double '基线连续两点间的斜率
Dim slopePara(1) As Double '平行线连续两点间的斜率

ReDim cBigFirstPara(numLines - 1) As Double '平行线方程 y=ax+c 中的c，第一维表示两条直线，第二位表示同一直线2个值
ReDim cSmallFirstPara(numLines - 1) As Double '第一条基线的平行线方程 y=ax+c 中的c，大的那个（有两个）
ReDim cBigSecondPara(numLines - 1) As Double
ReDim cSmallSecondPara(numLines - 1) As Double '第二条基线的平行线方程 y=ax+c 中的c，大的那个（有两个）

ReDim XCorssLeftTemp(numLines - 1) As Double '临时存储满足条件的平行线交点
ReDim YCorssLeftTemp(numLines - 1) As Double
ReDim XCorssRightTemp(numLines - 1) As Double
ReDim YCorssRightTemp(numLines - 1) As Double

'当基线的第一条直线垂直于x轴
If PtBaseOne.X_b - PtBaseTwo.X_b = 0 Then

slopePara(1) = (PtBaseTwo.Y_b - PtBaseThree.Y_b) / (PtBaseTwo.X_b - PtBaseThree.X_b)

Dim case1 As Integer
For case1 = 0 To numLines - 1

[魏生]

If PtBaseTwo.Y_b > PtBaseOne.Y_b Then
XCorssLeftTemp(case1) = PtBaseOne.X_b - dis * (case1 + 1)
YCorssLeftTemp(case1) = slopePara(1) * XCorssLeftTemp(case1) + PtBaseThree.Y_b - slopePara(1) * PtBaseThree.X_b + Sgn(PtBaseThree.X_b - PtBaseTwo.X_b) * dis * (case1 + 1)
XCorssRightTemp(case1) = PtBaseOne.X_b + dis * (case1 + 1)
YCorssRightTemp(case1) = slopePara(1) * XCorssRightTemp(case1) + PtBaseThree.Y_b - slopePara(1) * PtBaseThree.X_b - Sgn(PtBaseThree.X_b - PtBaseTwo.X_b) * dis * (case1 + 1)
ElseIf PtBaseTwo.Y_b < PtBaseOne.Y_b Then
XCorssLeftTemp(case1) = PtBaseOne.X_b + dis * (case1 + 1)
YCorssLeftTemp(case1) = slopePara(1) * XCorssLeftTemp(case1) + PtBaseThree.Y_b - slopePara(1) * PtBaseThree.X_b + Sgn(PtBaseThree.X_b - PtBaseTwo.X_b) * dis * (case1 + 1)
XCorssRightTemp(case1) = PtBaseOne.X_b - dis * (case1 + 1)
YCorssRightTemp(case1) = slopePara(1) * XCorssRightTemp(case1) + PtBaseThree.Y_b - slopePara(1) * PtBaseThree.X_b - Sgn(PtBaseThree.X_b - PtBaseTwo.X_b) * dis * (case1 + 1)
End If

Next case1

'当基线的第二条直线垂直于x轴
ElseIf PtBaseTwo.X_b - PtBaseThree.X_b = 0 Then

slopePara(0) = (PtBaseOne.Y_b - PtBaseTwo.Y_b) / (PtBaseOne.X_b - PtBaseTwo.X_b)

Dim case2 As Integer
For case2 = 0 To numLines - 1

If PtBaseThree.Y_b > PtBaseTwo.Y_b Then
XCorssLeftTemp(case2) = PtBaseTwo.X_b - dis * (case2 + 1)
YCorssLeftTemp(case2) = slopePara(0) * XCorssLeftTemp(case2) + PtBaseOne.Y_b - slopePara(0) * PtBaseOne.X_b + Sgn(PtBaseTwo.X_b - PtBaseOne.X_b) * dis * (case2 + 1)
XCorssRightTemp(case2) = PtBaseTwo.X_b + dis * (case2 + 1)
YCorssRightTemp(case2) = slopePara(0) * XCorssRightTemp(case2) + PtBaseOne.Y_b - slopePara(0) * PtBaseOne.X_b - Sgn(PtBaseTwo.X_b - PtBaseOne.X_b) * dis * (case2 + 1)
ElseIf PtBaseThree.Y_b < PtBaseTwo.Y_b Then
XCorssLeftTemp(case2) = PtBaseTwo.X_b + dis * (case2 + 1)
YCorssLeftTemp(case2) = slopePara(0) * XCorssLeftTemp(case2) + PtBaseOne.Y_b - slopePara(0) * PtBaseOne.X_b + Sgn(PtBaseTwo.X_b - PtBaseOne.X_b) * dis * (case2 + 1)
XCorssRightTemp(case2) = PtBaseTwo.X_b - dis * (case2 + 1)
YCorssRightTemp(case2) = slopePara(0) * XCorssRightTemp(case2) + PtBaseOne.Y_b - slopePara(0) * PtBaseOne.X_b - Sgn(PtBaseTwo.X_b - PtBaseOne.X_b) * dis * (case2 + 1)
End If
Next case2

'两条直线都不垂直于x轴
Else

slopeBase(0) = (PtBaseOne.Y_b - PtBaseTwo.Y_b) / (PtBaseOne.X_b - PtBaseTwo.X_b)
slopeBase(1) = (PtBaseTwo.Y_b - PtBaseThree.Y_b) / (PtBaseTwo.X_b - PtBaseThree.X_b)

'平行线连续两点间的斜率
slopePara(0) = slopeBase(0)
slopePara(1) = slopeBase(1)

'平行线方程 y=ax+c 中的c
Dim ls As Integer
For ls = 1 To numLines
cBigFirstPara(ls - 1) = Sqr((dis * ls) ^ 2 * slopePara(0) ^ 2 + (dis * ls) ^ 2) - slopePara(0) * PtBaseOne.X_b + PtBaseOne.Y_b
cSmallFirstPara(ls - 1) = -Sqr((dis * ls) ^ 2 * slopePara(0) ^ 2 + (dis * ls) ^ 2) - slopePara(0) * PtBaseOne.X_b + PtBaseOne.Y_b
cBigSecondPara(ls - 1) = Sqr((dis * ls) ^ 2 * slopePara(1) ^ 2 + (dis * ls) ^ 2) - slopePara(1) * PtBaseThree.X_b + PtBaseThree.Y_b
cSmallSecondPara(ls - 1) = -Sqr((dis * ls) ^ 2 * slopePara(1) ^ 2 + (dis * ls) ^ 2) - slopePara(1) * PtBaseThree.X_b + PtBaseThree.Y_b
Next ls

'求平行线的交点，分左右两边
Dim s As Integer
For s = 0 To numLines - 1
If PtBase(i + 2).X_b - PtBase(i + 1).X_b > 0 And PtBase(i + 1).X_b - PtBase(i).X_b > 0 Then

XCorssLeftTemp(s) = (cBigFirstPara(s) - cBigSecondPara(s)) / (slopePara(1) - slopePara(0)) '平行线交点的x值
YCorssLeftTemp(s) = (slopePara(1) * cBigFirstPara(s) - slopePara(0) * cBigSecondPara(s)) / (slopePara(1) - slopePara(0)) '平行线交点的y值

XCorssRightTemp(s) = (cSmallFirstPara(s) - cSmallSecondPara(s)) / (slopePara(1) - slopePara(0)) '平行线交点的x值
YCorssRightTemp(s) = (slopePara(1) * cSmallFirstPara(s) - slopePara(0) * cSmallSecondPara(s)) / (slopePara(1) - slopePara(0)) '平行线交点的y值

ElseIf PtBase(i + 2).X_b - PtBase(i + 1).X_b > 0 And PtBase(i + 1).X_b - PtBase(i).X_b < 0 Then

XCorssLeftTemp(s) = (cSmallFirstPara(s) - cBigSecondPara(s)) / (slopePara(1) - slopePara(0)) '平行线交点的x值
YCorssLeftTemp(s) = (slopePara(1) * cSmallFirstPara(s) - slopePara(0) * cBigSecondPara(s)) / (slopePara(1) - slopePara(0)) '平行线交点的y值

XCorssRightTemp(s) = (cBigFirstPara(s) - cSmallSecondPara(s)) / (slopePara(1) - slopePara(0)) '平行线交点的x值
YCorssRightTemp(s) = (slopePara(1) * cBigFirstPara(s) - slopePara(0) * cSmallSecondPara(s)) / (slopePara(1) - slopePara(0)) '平行线交点的y值

ElseIf PtBase(i + 2).X_b - PtBase(i + 1).X_b < 0 And PtBase(i + 1).X_b - PtBase(i).X_b > 0 Then

XCorssLeftTemp(s) = (cBigFirstPara(s) - cSmallSecondPara(s)) / (slopePara(1) - slopePara(0)) '平行线交点的x值
YCorssLeftTemp(s) = (slopePara(1) * cBigFirstPara(s) - slopePara(0) * cSmallSecondPara(s)) / (slopePara(1) - slopePara(0)) '平行线交点的y值

XCorssRightTemp(s) = (cSmallFirstPara(s) - cBigSecondPara(s)) / (slopePara(1) - slopePara(0)) '平行线交点的x值
YCorssRightTemp(s) = (slopePara(1) * cSmallFirstPara(s) - slopePara(0) * cBigSecondPara(s)) / (slopePara(1) - slopePara(0)) '平行线交点的y值

ElseIf PtBase(i + 2).X_b - PtBase(i + 1).X_b < 0 And PtBase(i + 1).X_b - PtBase(i).X_b < 0 Then

XCorssLeftTemp(s) = (cSmallFirstPara(s) - cSmallSecondPara(s)) / (slopePara(1) - slopePara(0)) '平行线交点的x值
YCorssLeftTemp(s) = (slopePara(1) * cSmallFirstPara(s) - slopePara(0) * cSmallSecondPara(s)) / (slopePara(1) - slopePara(0)) '平行线交点的y值

XCorssRightTemp(s) = (cBigFirstPara(s) - cBigSecondPara(s)) / (slopePara(1) - slopePara(0)) '平行线交点的x值
YCorssRightTemp(s) = (slopePara(1) * cBigFirstPara(s) - slopePara(0) * cBigSecondPara(s)) / (slopePara(1) - slopePara(0)) '平行线交点的y值

End If
Next s

End If

[魏生]

Dim k As Integer
For k = 0 To numLines - 1
If sID = 0 Then
LnPara(k).x(0, i + 1) = XCorssLeftTemp(k) '取左边值
LnPara(k).y(0, i + 1) = YCorssLeftTemp(k)
ElseIf sID = 1 Then
LnPara(k).x(1, i + 1) = XCorssRightTemp(k) '取右边值
LnPara(k).y(1, i + 1) = YCorssRightTemp(k)
End If
Next k


'求平行线起点和终点的坐标：基线的垂线和平行线的交点
If isFirstPoint = True Then '必须包含起点或终点的时候才求
ReDim cParaStart(numLines - 1) As Double '起点平行线方程 y=ax+c 中的c
ReDim cVerStart(numLines - 1) As Double '起点端垂线方程y=x/a+c 中的c

Dim fp As Integer
Dim p As Integer
For fp = 0 To numLines - 1
For p = 0 To 1 '0表示左边（以前进方向为准）

If PtBaseOne.Y_b = PtBaseTwo.Y_b Then '平行于x轴

If PtBaseTwo.X_b > PtBaseOne.X_b Then
LnPara(fp).x(p, LBound(PtBase)) = PtBase(LBound(PtBase)).X_b
LnPara(fp).y(0, LBound(PtBase)) = PtBase(LBound(PtBase)).Y_b + (dis * (fp + 1)) '开始方向
LnPara(fp).y(1, LBound(PtBase)) = PtBase(LBound(PtBase)).Y_b - (dis * (fp + 1))
ElseIf PtBaseTwo.X_b < PtBaseOne.X_b Then
LnPara(fp).x(p, LBound(PtBase)) = PtBase(LBound(PtBase)).X_b
LnPara(fp).y(0, LBound(PtBase)) = PtBase(LBound(PtBase)).Y_b - (dis * (fp + 1)) '开始方向
LnPara(fp).y(1, LBound(PtBase)) = PtBase(LBound(PtBase)).Y_b + (dis * (fp + 1))
End If

ElseIf PtBaseOne.X_b = PtBaseTwo.X_b Then '垂直于x轴

If PtBaseTwo.Y_b > PtBaseOne.Y_b Then
LnPara(fp).x(0, LBound(PtBase)) = PtBase(LBound(PtBase)).X_b - (dis * (fp + 1)) '开始方向
LnPara(fp).x(1, LBound(PtBase)) = PtBase(LBound(PtBase)).X_b + (dis * (fp + 1))
LnPara(fp).y(p, LBound(PtBase)) = PtBase(LBound(PtBase)).Y_b
ElseIf PtBaseTwo.Y_b < PtBaseOne.Y_b Then
LnPara(fp).x(0, LBound(PtBase)) = PtBase(LBound(PtBase)).X_b + (dis * (fp + 1)) '开始方向
LnPara(fp).x(1, LBound(PtBase)) = PtBase(LBound(PtBase)).X_b - (dis * (fp + 1))
LnPara(fp).y(p, LBound(PtBase)) = PtBase(LBound(PtBase)).Y_b
End If

Else
cParaStart(fp) = LnPara(fp).y(p, i + 1) - slopePara(0) * LnPara(fp).x(p, i + 1)
cVerStart(fp) = PtBaseOne.Y_b + PtBaseOne.X_b / slopePara(0)

LnPara(fp).x(p, LBound(PtBase)) = (slopePara(0) * (cVerStart(fp) - cParaStart(fp))) / (slopePara(0) ^ 2 + 1)
LnPara(fp).y(p, LBound(PtBase)) = (slopePara(0) ^ 2 * cVerStart(fp) + cParaStart(fp)) / (slopePara(0) ^ 2 + 1)
End If
Next p
Next fp
End If

If isLastPoint = True Then '必须包含终点的时候才求
ReDim cParaLast(numLines - 1) As Double '终点平行线方程 y=ax+c 中的c
ReDim cVerLast(numLines - 1) As Double '终点端垂线方程y=x/a+c 中的c

Dim ep As Integer
Dim q As Integer
For ep = 0 To numLines - 1
For q = 0 To 1 '0表示左边（以前进方向为准）

If PtBaseTwo.Y_b = PtBaseThree.Y_b Then '平行于x轴

If PtBaseThree.X_b < PtBaseTwo.X_b Then
LnPara(ep).x(q, UBound(PtBase)) = PtBase(UBound(PtBase)).X_b
LnPara(ep).y(0, UBound(PtBase)) = PtBase(UBound(PtBase)).Y_b - (dis * (ep + 1)) '结束方
LnPara(ep).y(1, UBound(PtBase)) = PtBase(UBound(PtBase)).Y_b + (dis * (ep + 1))
ElseIf PtBaseThree.X_b > PtBaseTwo.X_b Then
LnPara(ep).x(q, UBound(PtBase)) = PtBase(UBound(PtBase)).X_b
LnPara(ep).y(0, UBound(PtBase)) = PtBase(UBound(PtBase)).Y_b + (dis * (ep + 1)) '结束方向
LnPara(ep).y(1, UBound(PtBase)) = PtBase(UBound(PtBase)).Y_b - (dis * (ep + 1))
End If

ElseIf PtBaseTwo.X_b = PtBaseThree.X_b Then '垂直于x轴

If PtBaseThree.Y_b < PtBaseTwo.Y_b Then
LnPara(ep).y(q, UBound(PtBase)) = PtBase(UBound(PtBase)).Y_b
LnPara(ep).x(0, UBound(PtBase)) = PtBase(UBound(PtBase)).X_b + (dis * (ep + 1)) '结束方向
LnPara(ep).x(1, UBound(PtBase)) = PtBase(UBound(PtBase)).X_b - (dis * (ep + 1))
ElseIf PtBaseThree.Y_b > PtBaseTwo.Y_b Then
LnPara(ep).y(q, UBound(PtBase)) = PtBase(UBound(PtBase)).Y_b
LnPara(ep).x(0, UBound(PtBase)) = PtBase(UBound(PtBase)).X_b - (dis * (ep + 1)) '结束方向
LnPara(ep).x(1, UBound(PtBase)) = PtBase(UBound(PtBase)).X_b + (dis * (ep + 1))
End If

Else
cParaLast(ep) = LnPara(ep).y(q, i + 1) - slopePara(1) * LnPara(ep).x(q, i + 1)
cVerLast(ep) = PtBaseThree.Y_b + PtBaseThree.X_b / slopePara(1)

LnPara(ep).x(q, UBound(PtBase)) = (slopePara(1) * (cVerLast(ep) - cParaLast(ep))) / (slopePara(1) ^ 2 + 1)
LnPara(ep).y(q, UBound(PtBase)) = (slopePara(1) ^ 2 * cVerLast(ep) + cParaLast(ep)) / (slopePara(1) ^ 2 + 1)
End If
Next q
Next ep

End If

Next i

End If

End Sub

[chxg99]

楼上的高手啊！考虑的很全面，楼主可以转换一下啊

[qiansong113]

谢了..几天没上来看了。我已经做出来了。#17楼的大哥写的很对哦。。跟我所用的方法差不多。在这里我会给分的

[chxg99]

楼主代码可否共享一下啊