总结Excelhome论坛之揭开Excel平滑曲线的秘密（贝塞尔插值）

引用：资源地址：http://club.excelhome.net/dispbbs.asp?boardID=1&ID=135621&page=1&px=0

   Excel的平滑线散点图，可以根据两组分别代表X-Y坐标的散点数值产生曲线图    但是，却没有提供这个曲线图的公式，所以无法查找曲线上的点坐标    后来我在以下这个网页找到了详细的说明和示例程序 .............................................................................. http://www.xlrotor.com/Smooth_curve_bezier_example_file.zip ..............................................................................    根据其中采用的算法，进一步增添根据X坐标求Y坐标，或根据Y坐标求X坐标，更切合实际需求    这个自定义函数按照Excel的曲线算法 (三次贝塞尔分段插值), 计算平滑曲线上任意一点的点坐标

Excel的平滑曲线的大致算法是:    给出了两组X-Y数值以后，每一对X-Y坐标称为节点，然后在每两个节点之间画出三次贝塞尔曲线(下面简称曲线)    贝塞尔曲线的算法网上有很多资源，这里不介绍了，只作简单说明    每条曲线都由四个节点开始，计算出四个贝塞尔控制点，然后根据控制点画出唯一一条曲线    假设曲线的源数据是节点1 , 节点2, 节点3, 节点4(Dot1, Dot2, Dot3, Dot4)    那么贝塞尔控制点的计算如下                  程序作者: 海底眼(Mr. Dragon Pan)    Dot2是第一个控制点,也是曲点的起点，Dot3是第四个控制点也是曲线的终点

第二个控制点的位置是:        过第一个控制点(Dot2,起点)，与Dot1, Dot3的连线平行，且与Dot2距离为 1/6 * 线段Dot1_Dot3的长度        假如是图形的第一段曲线，取节点1,1,2,3进行计算,即 Dot2 = Dot1        且第二个控制点与第一控制点距离取 1/3 * |Dot1_Dot3|,而不是1/6 * |Dot1_Dot3|        假如 1/2 * |Dot2_Dot3| < 1/6 * |Dot1_Dot3|        那么第二个控制点与第一控制点距离取  1/2 * |Dot2_Dot3|,而不是1/6 * |Dot1_Dot3|

第三个控制点的位置是:        过第四个控制点(Dot3,终点)，与Dot2, Dot4的连线平行，且与Dot3距离为 1/6 * |Dot2_Dot4|        假如是图形的最后一段曲线，取节点Last-2,Last-1,Last,Last进行计算,即 Dot4 = Dot3        且第三个控制点与第四控制点距离取 1/3 * |Dot2_Dot4|,而不是1/6 * |Dot2_Dot4|        假如 1/2 * |Dot2_Dot3| < 1/6 * |Dot2_Dot4|        那么第二个控制点与第一控制点距离取  1/2 * |Dot2_Dot4|,而不是1/6 * |Dot2_Dot4| ...............................................................................................    这个自定义函数的计算流程是    Step1: 检查输入的X-Y数值是否有错误，如(输入不够三个点，X-Y的数量不一致,起始搜索节点超过范围等等)    Step2: 从参数指定的节点开始，计算出四个贝塞尔控制点，得到贝塞尔插值多项式方程，           然后代入已知的待求数值，看它能不能满足 f(t)=0 有解 (即曲线包含待查数值)    Step3: 如果 f(t)=0 有解，根据解出来的 t 值计算X-Y坐标，退出程序,否则继续检查下一段曲线    Step4: 如果所有分段曲线都不包含待查数值，退出程序 ...............................................................................................

函数：

Function BezierFit(known_x, known_y As Range, known_value, Optional StartKnot As Long = 1, Optional known_value_type As Variant = "x") As Variant Dim j As Long Dim x1Value, y1Value, x2Value, y2Value, x3Value, y3Value As Variant Dim ErrorMsg As Variant

ValueType = LCase(known_value_type)     '待查数值的类型转化为小写，并赋值到全局变量ValueType key_value = known_value                 '待查数值赋值到全局变量key_value

ErrorMsg = ErrorCheck(known_x, known_y, StartKnot)  '检查输入错误 If ErrorMsg <> NoError Then                         '有错误就返回错误信息，退出程序     BezierFit = Array(ErrorMsg, ErrorMsg, ErrorMsg, ErrorMsg, ErrorMsg, ErrorMsg)     Exit Function End If

For j = StartKnot To SizeX - 1              '从指定的节点开始，没有指定节点就从1开始     Call FindFourDots(known_x, known_y, j)  '找出输入X-Y点坐标里面，应该用于计算的四个结点     Call FindFourBezierPoints(Dot1, Dot2, Dot3, Dot4)   '根据四个结点计算四个贝塞尔控制点     Call FindABCD                           '根据待查数值的类型，和贝塞尔控制点,计算贝塞尔插值多项式的系数     Call Find_t                             '检查贝塞尔曲线是否包含待查数值     If Interpol_here = True Then Exit For Next j

If 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 - 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) * 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     BezierFit = Array(x1Value, y1Value, x2Value, y2Value, x3Value, y3Value) Else     BezierFit = Array(Error10, Error10, Error10, Error10, Error10, Error10) End If

End Function