1、 且第二个控制点与第一控制点距离取 1/3 * |Dot1_Dot3|,而不是1/6 * |Dot1_Dot3| 假如 1/2 * |Dot2_Dot3| =1 and =0 and =1Const Error10 = known_value is not on the curve (defined by given known_x and known_y)Const NoRoot = No RootConst MaxErr = 0.00000001Const MaxLoop = 1000Dim SizeX, SizeY As Long输入区域的大小Dim Dot1 As Vector输入区域
2、里面,用作计算贝塞尔控制点的四个节点Dim Dot2 As VectorDim Dot3 As VectorDim Dot4 As VectorDim BezierPt1 As Vector生成贝塞尔曲线的四个贝塞尔控制点Dim BezierPt2 As VectorDim BezierPt3 As VectorDim BezierPt4 As VectorDim OffsetTo2 As Vector第二,三个贝塞尔控制点跟起点,终点的距离关系Dim OffsetTo3 As VectorDim ValueType As Variant输入待查数值的类型,代表输入的是X坐标,求对应的Y坐标D
3、im Interpol_here As Boolean当前分段曲线是否包含待查数值Dim key_value, a, b, c, d As Double贝塞尔曲线插值多项式的系数Dim t1, t2, t3 As Variant贝塞尔曲线插值多项式的根Dim a3, a2, a1, a0 As DoubleDim size%Public Sub befit(ByRef known_x() As Double, ByRef known_y() As Double, size As Integer, known_value As Double, result() As Variant, Optio
4、nal StartKnot As Long = 1, Optional known_value_type As Variant = )-子过程方便VB中调用-主程序开始,至少要输入五个参数,第一个是X坐标系列,然后是Y坐标系列,第三个是坐标点数,第四个是待查数值,第五个是返回值第六个参数是从哪一段曲线开始查找,如果曲线可以返回多个值,那么分别指定起始节点就可以找出全部合要求的点第七个参数是待查数值的类型,代表输入x坐标求对应y坐标,则相反,是直接输入贝塞尔插值多项式的参数-Dim j As LongDim x1Value, y1Value, x2Value, y2Value, x3Value,
5、 y3Value As VariantDim ErrorMsg As VariantValueType = LCase(known_value_type)待查数值的类型转化为小写,并赋值到全局变量ValueTypekey_value = known_value待查数值赋值到全局变量key_valueErrorMsg = ErrorCheck(known_x, known_y, StartKnot) 检查输入错误If ErrorMsg NoError Then有错误就返回错误信息,退出程序 result = Array(ErrorMsg, ErrorMsg, ErrorMsg, ErrorMsg
6、, ErrorMsg, ErrorMsg) Exit SubEnd IfSizeX = UBound(known_x)For j = StartKnot To size SizeX - 1从指定的节点开始,没有指定节点就从1开始 Call FindFourDots(known_x, known_y, j) 找出输入X-Y点坐标里面,应该用于计算的四个结点 Call FindFourBezierPoints(Dot1, Dot2, Dot3, Dot4)根据四个结点计算四个贝塞尔控制点 Call FindABCD根据待查数值的类型,和贝塞尔控制点,计算贝塞尔插值多项式的系数 Call Find_
7、t检查贝塞尔曲线是否包含待查数值 If Interpol_here = True Then Exit ForNext jIf Interpol_here = True Then计算点坐标,并返回以下是由四个贝塞尔控制点决定的,贝塞尔曲线的参数方程 x1Value = (1 - t1) 3 * BezierPt1.x + 3 * t1 * (1 - t1) 2 * BezierPt2.x + 3 * t1 2 * (1 - t1) * BezierPt3.x + t1 3 * BezierPt4.x y1Value = (1 - t1) 3 * BezierPt1.y + 3 * t1 * (1
8、 - t1) 2 * BezierPt2.y + 3 * t1 2 * (1 - t1) * BezierPt3.y + t1 3 * BezierPt4.y x2Value = (1 - t2) 3 * BezierPt1.x + 3 * t2 * (1 - t2) 2 * BezierPt2.x + 3 * t2 2 * (1 - t2) * BezierPt3.x + t2 3 * BezierPt4.x y2Value = (1 - t2) 3 * BezierPt1.y + 3 * t2 * (1 - t2) 2 * BezierPt2.y + 3 * t2 2 * (1 - t2)
9、 * BezierPt3.y + t2 3 * BezierPt4.y x3Value = (1 - t3) 3 * BezierPt1.x + 3 * t3 * (1 - t3) 2 * BezierPt2.x + 3 * t3 2 * (1 - t3) * BezierPt3.x + t3 3 * BezierPt4.x y3Value = (1 - t3) 3 * BezierPt1.y + 3 * t3 * (1 - t3) 2 * BezierPt2.y + 3 * t3 2 * (1 - t3) * BezierPt3.y + t3 3 * BezierPt4.y result =
10、 Array(x1Value, y1Value, x2Value, y2Value, x3Value, y3Value)Else result = Array(Error10, Error10, Error10, Error10, Error10, Error10)End SubFunction ErrorCheck(ByRef known_x() As Double, ByRef known_y() As Double, StartKnot) As VariantErrorCheck = NoErrorSizeX = UBound(known_x) known_x.CountSizeY =
11、UBound(known_y) known_y.CountIf SizeX SizeY Then 假如输入的X坐标数目不等于Y坐标数目ErrorCheck = Error1Exit Function 3 Then输入的X-Y坐标对少于三个ErrorCheck = Error2If (StartKnot = SizeX) Then指定的起始节点超出范围ErrorCheck = Error3If (ValueType And ValueType 1) Or (ValueType = And key_value 0) Then t 类型的范围是0-1ErrorCheck = Error5End Fu
12、nctionSub FindFourDots(ByRef known_x() As Double, ByRef known_y() As Double, j)根据X-Y数值,及起始节点,找出用于计算的四个结点坐标 If j = 1 Then第一个结点 Dot2 = Dot1 Dot1.x = known_x(1) Dot1.y = known_y(1) Else Dot1.x = known_x(j - 1) Dot1.y = known_y(j - 1) End If Dot2.x = known_x(j) Dot2.y = known_y(j) Dot3.x = known_x(j + 1
13、) Dot3.y = known_y(j + 1) If j = SizeX - 1 Then最后一个结点 Dot4 = Dot3 Dot4.x = Dot3.x Dot4.y = Dot3.y Dot4.x = known_x(j + 2) Dot4.y = known_y(j + 2)Sub FindFourBezierPoints(Dot1 As Vector, Dot2 As Vector, Dot3 As Vector, Dot4 As Vector)Dim d12, d23, d34, d13, d14, d24 As Doubled12 = DistAtoB(Dot1, Dot2
14、)计算平面坐标系上的两点距离d23 = DistAtoB(Dot2, Dot3)d34 = DistAtoB(Dot3, Dot4)d13 = DistAtoB(Dot1, Dot3)d14 = DistAtoB(Dot1, Dot4)d24 = DistAtoB(Dot2, Dot4)BezierPt1 = Dot2BezierPt4 = Dot3OffsetTo2 = AsubB(Dot3, Dot1)向量减法OffsetTo3 = AsubB(Dot2, Dot4)If (d13 / 6 d23 / 2) And (d24 / 6 d23 / 2) Then If (Dot1.x Dot
15、2.x Or Dot1.y Dot2.y) Then OffsetTo2 = AmultiF(OffsetTo2, 1 / 6) If (Dot1.x = Dot2.x And Dot1.y = Dot2.y) Then OffsetTo2 = AmultiF(OffsetTo2, 1 / 3) If (Dot3.x Dot4.x Or Dot3.y = d23 / 2) And (d24 / 6 = d23 / 2) Then OffsetTo2 = AmultiF(OffsetTo2, d23 / 12) OffsetTo3 = AmultiF(OffsetTo3, d23 / 12)El
16、seIf (d13 / 6 = d23 / 2) Then OffsetTo2 = AmultiF(OffsetTo2, d23 / 2 / d13) OffsetTo3 = AmultiF(OffsetTo3, d23 / 2 / d13)ElseIf (d24 / 6 OffsetTo2 = AmultiF(OffsetTo2, d23 / 2 / d24) OffsetTo3 = AmultiF(OffsetTo3, d23 / 2 / d24)BezierPt2 = AaddB(BezierPt1, OffsetTo2)向量加法BezierPt3 = AaddB(BezierPt4,
17、OffsetTo3)Function DistAtoB(dota As Vector, dotb As Vector) As DoubleDistAtoB = (dota.x - dotb.x) 2 + (dota.y - dotb.y) 2) 0.5Function AaddB(dota As Vector, dotb As Vector) As VectorAaddB.x = dota.x + dotb.xAaddB.y = dota.y + dotb.yFunction AsubB(dota As Vector, dotb As Vector) As VectorAsubB.x = do
18、ta.x - dotb.xAsubB.y = dota.y - dotb.yFunction AmultiF(dota As Vector, MultiFactor As Double) As VectorAmultiF.x = dota.x * MultiFactorAmultiF.y = dota.y * MultiFactorSub FindABCD()If ValueType = Then参数类型是x, 需要解参数方程 f(t) = x,这里设定参数方程的系数a = -BezierPt1.x + 3 * BezierPt2.x - 3 * BezierPt3.x + BezierPt4.xb = 3 * BezierPt1.x - 6 * BezierPt2.x + 3 * BezierPt3.xc = -3 * BezierPt1.x + 3 * BezierPt2.xd = BezierPt1.x - key_value参数类型是x, 需要解参数方程 f(t) = y,这里设定参数方程的系数a = -BezierPt1.y + 3 * BezierPt2.y - 3 * BezierPt3
copyright@ 2008-2022 冰豆网网站版权所有
经营许可证编号:鄂ICP备2022015515号-1