引用:資源地址: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