有vb的，使用过，可是使用。 你改改：思想是把多折线分成单直线，然后循环。有好几种特殊情况要单独分析，这个程序没有设计好，复杂度有点高，你可以重新设计一下。 Option ExplicitPublic Type PointBaseParall '基线的顶点 X_b As Double Y_b As Double End TypePublic 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).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
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表示左边（以前进方向为准）
设直线方程是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的平方啊～～～～～
/// <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 };
}
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'画线机所求平行线
你改改：思想是把多折线分成单直线，然后循环。有好几种特殊情况要单独分析，这个程序没有设计好，复杂度有点高，你可以重新设计一下。
Option ExplicitPublic Type PointBaseParall '基线的顶点
X_b As Double
Y_b As Double
End TypePublic 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
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
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