總結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

發表評論
所有評論
還沒有人評論,想成為第一個評論的人麼? 請在上方評論欄輸入並且點擊發布.
相關文章