EXCEL快速計算任何難度的道路中線、邊線坐標

主程序
Public i As Integer
Public pi As Double
Sub TP()
Dim ii As Integer
Dim k(1000) As Double
Dim xzq, yzq, kq, xzh, yzh, kzh, xjd, yjd, kjd, khy, kyh As Double
'直線區(qū)域
pi = 3.14159265358979
xzq = 71862.642
yzq = 63474.651
kq = 0 '因為直線連接終點為ZH點，與圓曲線起點為同一點，所以在直線區(qū)域不定義ZH點參數(shù)
'直線區(qū)域
'曲線區(qū)域
xzh = 71858.3267
yzh = 63375.2684
kzh = 99.4763
xhz = 71909.3687
yhz = 63283.8076 '曲線區(qū)域定義內(nèi)容有：ZH（坐標、里程）、HZ（坐標、里程）、JD（坐標、里程）
khz = 212.3392 'R（半徑）、LS（緩和曲線長度）、HY（里程）、YH（里程）
xjd = 71855.658
yjd = 63313.806
kjd = 160.9966
ls = 30
r = 75
khy = 129.4763
kyh = 182.3385
'曲線區(qū)域

i = 2 '從第二格開始讀取數(shù)據(jù)所以定義I=2
ii = 1 '樁號從第一個開始啟用，所以定義II=2

Do
k(ii) = Workbooks("單交點平曲線.xls").Worksheets("sheet1").Cells(i, 1) '定義樁號等于讀取數(shù)據(jù)
If Workbooks("單交點平曲線.xls").Worksheets("sheet1").Cells(i, 1) = "" Then Exit Do '當沒有數(shù)據(jù)讀取時退出循環(huán)
If k(ii) < kq Then '若計算點超過計算起點給予提示并退出程序
MsgBox ("豬�。�！你的輸入的樁號居然超過計算起點樁號")
Exit Sub
ElseIf k(ii) <= kzh Then '若計算點在ZH點前，則進入直線程序
Call zx(xzq, yzq, kq, xzh, yzh, kzh, k(ii))
ElseIf kzh < k(ii) And k(ii) <= khy Then '若計算點在ZH和HY之間則調(diào)入前段緩和曲線程序
Call qhhqx(xzh, yzh, kzh, xhz, yhz, khz, xjd, yjd, kjd, ls, r, k(ii))
ElseIf khy < k(ii) And k(ii) <= kyh Then '若計算點在HY和YH之間則調(diào)入圓曲線程序
Call yqx(xzh, yzh, kzh, xhz, yhz, khz, xjd, yjd, kjd, ls, r, k(ii))
ElseIf kyh < k(ii) And k(ii) <= khz Then '若計算點在YH和HZ之間則調(diào)入后段緩和曲線程序
Call hhhqx(xzh, yzh, kzh, xhz, yhz, khz, xjd, yjd, kjd, ls, r, k(ii))
Else
MsgBox ("笨�。�！數(shù)據(jù)已超出計算范圍了") '若出現(xiàn)超出范圍的樁號則給與提示并退出程序
Exit Sub
End If
i = i + 1
ii = ii + 1
Loop
End Sub

直線模塊
Sub zx(ByVal xzq As Double, ByVal yzq As Double, ByVal kq As Double, ByVal xzh As Double, ByVal yzh As Double, ByVal kzh As Double, ParamArray k())
fw = fwj(xzh, xzq, yzh, yzq) '首先調(diào)入方位角程序計算直線方位角
x = xzq + (k(ii) - kq) * Cos(fw) '然后根據(jù)樁號和長度計算出坐標值
y = yzq + (k(ii) - kq) * Sin(fw)
zdfm = dfm(fw) '將弧度形式的前進方位角轉(zhuǎn)換度分秒形式
'輸出坐標值以弧度和度分秒形式的前進方位角
Workbooks("單交點平曲線.xls").Worksheets("sheet1").Cells(i, 2) = x
Workbooks("單交點平曲線.xls").Worksheets("sheet1").Cells(i, 3) = y
Workbooks("單交點平曲線.xls").Worksheets("sheet1").Cells(i, 4) = fw
Workbooks("單交點平曲線.xls").Worksheets("sheet1").Cells(i, 5) = zdfm
End Sub

圓曲線模塊
Sub yqx(ByVal xzh As Double, ByVal yzh As Double, ByVal kzh As Double, ByVal xhz As Double, ByVal yhz As Double, ByVal khz As Double, ByVal xjd As Double, ByVal yjd As Double, ByVal kjd As Double, ByVal ls As Double, ByVal r As Double, ParamArray k())
l = Abs(k(ii) - kzh) '計算ZH點（因為以直緩點起算）到待求樁號的弧度長度
ly = l - ls / 2 '計算圓弧長度
p = ls ^ 2 / 24 / r - ls ^ 4 / 2688 / r ^ 3 '曲線內(nèi)移值
m = ls / 2 - ls ^ 3 / 240 / r ^ 2 '曲線切線長增量
u = r * Sin(ly / r) + m '偏量坐標計算
v = r * (1 - Cos(ly / r)) + p
'調(diào)入方位角
fwq = fwj(xjd, xzh, yjd, yzh) '計算ZH點方位角
fwh = fwj(xhz, xjd, yhz, yjd) '計算HZ點方位角（此角作用是用來推算曲線是左偏還是右偏）
'調(diào)入偏角判定
nq = n(fwq, fwh) '計算偏角方向，左偏為-1右偏為1
'計算坐標
x = u * Cos(fwq) - nq * v * Sin(fwq) + xzh
y = u * Sin(fwq) + nq * v * Cos(fwq) + yzh

d = (90 * (2 * l - ls) / pi / r) * pi / 180 '計算圓曲線上的偏角（此句要點為角度必須轉(zhuǎn)換為弧度即：pi/180）
fw = fwq + d * nq '計算前進方位角
zdfm = dfm(fw) '將弧度形式的前進方位角轉(zhuǎn)換度分秒形式
'輸出坐標值以弧度和度分秒形式的前進方位角
Workbooks("單交點平曲線.xls").Worksheets("sheet1").Cells(i, 2) = x
Workbooks("單交點平曲線.xls").Worksheets("sheet1").Cells(i, 3) = y
Workbooks("單交點平曲線.xls").Worksheets("sheet1").Cells(i, 4) = fw
Workbooks("單交點平曲線.xls").Worksheets("sheet1").Cells(i, 5) = zdfm
End Sub

后緩和段模塊
Sub hhhqx(ByVal xzh As Double, ByVal yzh As Double, ByVal kzh As Double, ByVal xhz As Double, ByVal yhz As Double, ByVal khz As Double, ByVal xjd As Double, ByVal yjd As Double, ByVal kjd As Double, ByVal ls As Double, ByVal r As Double, ParamArray k())
l = Abs(k(ii) - khz) '計算測點到HZ點的距離（后緩和曲線是以HZ點為起點）
u = l - l ^ 5 / 40 / r ^ 2 / ls ^ 2 + l ^ 9 / r ^ 4 / ls ^ 4 / 3456 '計算偏量
v = l ^ 3 / 6 / r / ls - l ^ 7 / 336 / r ^ 3 / ls ^ 3
Rem t = Atn(v / u)
Rem s = Sqr(u ^ 2 + v ^ 2)
'調(diào)入方位角計算
fwq = fwj(xjd, xzh, yjd, yzh) '計算ZH點方位角
fwh = fwj(xhz, xjd, yhz, yjd) '計算HZ點方位角（此角作用是用來推算曲線是左偏還是右偏）
'調(diào)入偏角判定
nh = n(fwh, fwq) '計算偏角方向，左偏為-1右偏為1（注意：因為是從后HZ點起算，所以必須將HZ點方位角放在前ZH放在后）
'結(jié)果計算
Rem x = xzh + s * Cos(fwq + nq * t)
Rem y = yzh + s * Sin(fwq + nq * t)
x = xhz - (u * Cos(fwh) - nh * v * Sin(fwh)) '經(jīng)過測試，計算結(jié)果中的兩種公式計算結(jié)果是一樣的
y = yhz - (u * Sin(fwh) + nh * v * Cos(fwh))

d = (90 * l * l / pi / r / ls) * pi / 180 '計算緩和曲線上的偏角（此句要點為角度必須轉(zhuǎn)換為弧度即：pi/180）
fw = fwh + d * nh '計算前進方位角
zdfm = dfm(fw) '將弧度形式的前進方位角轉(zhuǎn)換度分秒形式
'輸出坐標值以弧度和度分秒形式的前進方位角
Workbooks("單交點平曲線.xls").Worksheets("sheet1").Cells(i, 2) = x
Workbooks("單交點平曲線.xls").Worksheets("sheet1").Cells(i, 3) = y
Workbooks("單交點平曲線.xls").Worksheets("sheet1").Cells(i, 4) = fw
Workbooks("單交點平曲線.xls").Worksheets("sheet1").Cells(i, 5) = zdfm
End Sub

偏角模塊
Function n(ByVal fw1 As Double, ByVal fw2 As Double) As Double
pj = fw1 + pi - fw2 '前進的右角pj
If pj - pi > 0 Then '當右角pj-pi 〉0時為左偏否則為右偏
n = -1
Else: n = 1
End If
End Function

方位角模塊
Function fwj(ByVal x1 As Double, ByVal x2 As Double, ByVal y1 As Double, ByVal y2 As Double) As Double
'計算增量
x0 = x1 - x2
y0 = y1 - y2
'由增量判斷方位角所在象限，不同象限取不同的值
If x0 = 0 And y0 > 0 Then
fwj = pi / 2 '當在大地坐標中偏量在X軸上的值時
ElseIf x0 = 0 And y0 < 0 Then
fwj = 3 * pi / 2 '當在大地坐標中偏量在負X軸上的值時
ElseIf x0 < 0 Then
fwj = Atn(y0 / x0) + pi '當在大地坐標中偏量在第二第三象限上的值時
ElseIf x0 > 0 And y0 < 0 Then
fwj = Atn(y0 / x0) + 2 * pi '當在大地坐標中偏量在第四象限上的值時
Else
fwj = Atn(y0 / x0) '當在大地坐標中偏量在第一象限上的值時
End If
End Function

度分秒模塊
Function dfm(ByVal ao As Double) As Variant
ao = ao * 180 / pi '將弧度轉(zhuǎn)化為度
jd = Int(ao) '計算度
jf = Int(ao * 60 - jd * 60) '計算分
jmx = (ao - jd - jf / 60) * 3600 '計算秒
jm = Left(jmx, 8) '因為拆分出來的秒數(shù)經(jīng)常占到十多位，所以只取秒數(shù)的前八位
dfm = jd & "°" & jf & "′" & jm & "″" '連接度分秒
End Function

邊樁公式(此公式在電子表格中直接輸入)：
=B2+J2*COS(D2+RADIANS(L2)+PI()) =C2+J2*SIN(D2+RADIANS(L2)+PI()) =B2+K2*COS(D2+RADIANS(M2)) =C2+K2*SIN(D2+RADIANS(M2))
=B3+J3*COS(D3+RADIANS(L3)+PI()) =C3+J3*SIN(D3+RADIANS(L3)+PI()) =B3+K3*COS(D3+RADIANS(M3)) =C3+K3*SIN(D3+RADIANS(M3))
=B4+J4*COS(D4+RADIANS(L4)+PI()) =C4+J4*SIN(D4+RADIANS(L4)+PI()) =B4+K4*COS(D4+RADIANS(M4)) =C4+K4*SIN(D4+RADIANS(M4))
=B5+J5*COS(D5+RADIANS(L5)+PI()) =C5+J5*SIN(D5+RADIANS(L5)+PI()) =B5+K5*COS(D5+RADIANS(M5)) =C5+K5*SIN(D5+RADIANS(M5))
=B6+J6*COS(D6+RADIANS(L6)+PI()) =C6+J6*SIN(D6+RADIANS(L6)+PI()) =B6+K6*COS(D6+RADIANS(M6)) =C6+K6*SIN(D6+RADIANS(M6))
=B7+J7*COS(D7+RADIANS(L7)+PI()) =C7+J7*SIN(D7+RADIANS(L7)+PI()) =B7+K7*COS(D7+RADIANS(M7)) =C7+K7*SIN(D7+RADIANS(M7))
=B8+J8*COS(D8+RADIANS(L8)+PI()) =C8+J8*SIN(D8+RADIANS(L8)+PI()) =B8+K8*COS(D8+RADIANS(M8)) =C8+K8*SIN(D8+RADIANS(M8))
=B9+J9*COS(D9+RADIANS(L9)+PI()) =C9+J9*SIN(D9+RADIANS(L9)+PI()) =B9+K9*COS(D9+RADIANS(M9)) =C9+K9*SIN(D9+RADIANS(M9))
=B10+J10*COS(D10+RADIANS(L10)+PI()) =C10+J10*SIN(D10+RADIANS(L10)+PI()) =B10+K10*COS(D10+RADIANS(M10)) =C10+K10*SIN(D10+RADIANS(M10))
=B11+J11*COS(D11+RADIANS(L11)+PI()) =C11+J11*SIN(D11+RADIANS(L11)+PI()) =B11+K11*COS(D11+RADIANS(M11)) =C11+K11*SIN(D11+RADIANS(M11))
=B12+J12*COS(D12+RADIANS(L12)+PI()) =C12+J12*SIN(D12+RADIANS(L12)+PI()) =B12+K12*COS(D12+RADIANS(M12)) =C12+K12*SIN(D12+RADIANS(M12))
=B13+J13*COS(D13+RADIANS(L13)+PI()) =C13+J13*SIN(D13+RADIANS(L13)+PI()) =B13+K13*COS(D13+RADIANS(M13)) =C13+K13*SIN(D13+RADIANS(M13))
=B14+J14*COS(D14+RADIANS(L14)+PI()) =C14+J14*SIN(D14+RADIANS(L14)+PI()) =B14+K14*COS(D14+RADIANS(M14)) =C14+K14*SIN(D14+RADIANS(M14))
=B15+J15*COS(D15+RADIANS(L15)+PI()) =C15+J15*SIN(D15+RADIANS(L15)+PI()) =B15+K15*COS(D15+RADIANS(M15)) =C15+K15*SIN(D15+RADIANS(M15))
=B16+J16*COS(D16+RADIANS(L16)+PI()) =C16+J16*SIN(D16+RADIANS(L16)+PI()) =B16+K16*COS(D16+RADIANS(M16)) =C16+K16*SIN(D16+RADIANS(M16))
=B17+J17*COS(D17+RADIANS(L17)+PI()) =C17+J17*SIN(D17+RADIANS(L17)+PI()) =B17+K17*COS(D17+RADIANS(M17)) =C17+K17*SIN(D17+RADIANS(M17))
=B18+J18*COS(D18+RADIANS(L18)+PI()) =C18+J18*SIN(D18+RADIANS(L18)+PI()) =B18+K18*COS(D18+RADIANS(M18)) =C18+K18*SIN(D18+RADIANS(M18))
=B19+J19*COS(D19+RADIANS(L19)+PI()) =C19+J19*SIN(D19+RADIANS(L19)+PI()) =B19+K19*COS(D19+RADIANS(M19)) =C19+K19*SIN(D19+RADIANS(M19))
=B20+J20*COS(D20+RADIANS(L20)+PI()) =C20+J20*SIN(D20+RADIANS(L20)+PI()) =B20+K20*COS(D20+RADIANS(M20)) =C20+K20*SIN(D20+RADIANS(M20))
=B21+J21*COS(D21+RADIANS(L21)+PI()) =C21+J21*SIN(D21+RADIANS(L21)+PI()) =B21+K21*COS(D21+RADIANS(M21)) =C21+K21*SIN(D21+RADIANS(M21))
=B22+J22*COS(D22+RADIANS(L22)+PI()) =C22+J22*SIN(D22+RADIANS(L22)+PI()) =B22+K22*COS(D22+RADIANS(M22)) =C22+K22*SIN(D22+RADIANS(M22))
=B23+J23*COS(D23+RADIANS(L23)+PI()) =C23+J23*SIN(D23+RADIANS(L23)+PI()) =B23+K23*COS(D23+RADIANS(M23)) =C23+K23*SIN(D23+RADIANS(M23))
呵呵，這個就是傳說已久的EXCEL自動計算曲線坐標．給大家研究研究．歡迎在此基礎上開發(fā)增加新模塊．