本帖最后由 作者 于 2008-9-24 9:33:20 编辑
直线方程 y=kx+b 第一条直线方程 b1=y1-k1*x1 第二条直线方程 b2=y2-k2*x1 交点X,Y一定在第一条和第二条直线上 y=k1*x+b1 y=k2*x+b2 联解 x= (b2-b1)/(k1-k2) y= k2x+b2 程序如下 Sub mLSs() Dim Aa(3) As Variant Aa(0) = Array(-10, 3) Aa(1) = Array(20, 50) Aa(2) = Array(14, 10) Aa(3) = Array(-20, 56) Dim pp(0 To 2) As Double, ppp(0 To 2) As Double Dim kkk As Double Kab = (Aa(1)(1) - Aa(0)(1)) / (Aa(1)(0) - Aa(0)(0)) kkk = -1 / Kab k1 = (Aa(1)(1) - Aa(0)(1)) / (Aa(1)(0) - Aa(0)(0)) k2 = (Aa(3)(1) - Aa(2)(1)) / (Aa(3)(0) - Aa(2)(0)) b1 = Aa(1)(1) - k1 * Aa(1)(0) b2 = Aa(3)(1) - k2 * Aa(3)(0) x = (b2 - b1) / (k1 - k2) y = k2 * x + b2 Debug.Print x, y ii = 0 For jj = 0 To 1 pp(jj) = Aa(ii)(jj) ppp(jj) = Aa(ii + 1)(jj) Next jj Set ll = ThisDrawing.ModelSpace.AddLine(pp, ppp) ll.color = 1 ii = 2 For jj = 0 To 1 pp(jj) = Aa(ii)(jj) ppp(jj) = Aa(ii + 1)(jj) Next jj Set ll = ThisDrawing.ModelSpace.AddLine(pp, ppp) ll.color = 2
End Sub
带功能函数 'Vertical Point Function VerticalPoint(lineVar As Variant, Delta As Double) As Variant Dim Kab, Kac Kab = (lineVar(1)(1) - lineVar(0)(1)) / (lineVar(1)(0) - lineVar(0)(0)) Kac = -1 / Kab VerticalPoint = Array(lineVar(1)(0) + Delta / Sqr(1 + Kac ^ 2), lineVar(1)(1) - Delta / Sqr(1 + (1 / Kac) ^ 2), 0) End Function ' Paralle Line Function yParallelLine(linePoint As Variant, K As Double, Y As Double, Z As Double) 'As Variant Dim tempX As Double tempX = (Y - linePoint(1)) / K + linePoint(0) yParallelLine = Array(tempX, Y, Z) End Function ' Slope in Xy Plane Function xySlope(Point1 As Variant, Point2) As Double xySlope = (Point2(1) - Point1(1)) / (Point2(0) - Point1(0)) End Function
|