[讨论]：EXCEL快速计算任何难度的道路中线、边线坐标

duyuanxun123

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
'直线区域
pi = 3.14159265358979
xzq = 71862.642
yzq = 63474.651
kq = 0 '因为直线连接终点为ZH点，与圆曲线起点为同一点，所以在直线区域不定义ZH点参数
'直线区域
'曲线区域
xzh = 71858.3267
yzh = 63375.2684
kzh = 99.4763
xhz = 71909.3687
yhz = 63283.8076 '曲线区域定义内容有：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
'曲线区域
i = 2 '从第二格开始读取数据所以定义I=2
ii = 1 '桩号从第一个开始启用，所以定义II=2
Do
k(ii) = Workbooks("单交点平曲线.xls").Worksheets("sheet1").Cells(i, 1) '定义桩号等于读取数据
If Workbooks("单交点平曲线.xls").Worksheets("sheet1").Cells(i, 1) = "" Then Exit Do '当没有数据读取时退出循环
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之间则调入前段缓和曲线程序
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之间则调入圆曲线程序
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之间则调入后段缓和曲线程序
Call hhhqx(xzh, yzh, kzh, xhz, yhz, khz, xjd, yjd, kjd, ls, r, k(ii))
Else
MsgBox ("笨啊！！数据已超出计算范围了") '若出现超出范围的桩号则给与提示并退出程序
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) '首先调入方位角程序计算直线方位角
x = xzq + (k(ii) - kq) * Cos(fw) '然后根据桩号和长度计算出坐标值
y = yzq + (k(ii) - kq) * Sin(fw)
zdfm = dfm(fw) '将弧度形式的前进方位角转换度分秒形式
'输出坐标值以弧度和度分秒形式的前进方位角
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 '曲线内移值
m = ls / 2 - ls ^ 3 / 240 / r ^ 2 '曲线切线长增量
u = r * Sin(ly / r) + m '偏量坐标计算
v = r * (1 - Cos(ly / r)) + p
'调入方位角
fwq = fwj(xjd, xzh, yjd, yzh) '计算ZH点方位角
fwh = fwj(xhz, xjd, yhz, yjd) '计算HZ点方位角（此角作用是用来推算曲线是左偏还是右偏）
'调入偏角判定
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 '计算圆曲线上的偏角（此句要点为角度必须转换为弧度即：pi/180）
fw = fwq + d * nq '计算前进方位角
zdfm = dfm(fw) '将弧度形式的前进方位角转换度分秒形式
'输出坐标值以弧度和度分秒形式的前进方位角
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 qhhqx(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点的距离
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)
'调入方位角计算
fwq = fwj(xjd, xzh, yjd, yzh) '计算ZH点方位角
fwh = fwj(xhz, xjd, yhz, yjd) '计算HZ点方位角（此角作用是用来推算曲线是左偏还是右偏）
'调入偏角判定
nq = n(fwq, fwh) '计算偏角方向，左偏为-1右偏为1
'结果计算
Rem x = xzh + s * Cos(fwq + nq * t)
Rem y = yzh + s * Sin(fwq + nq * t)
x = u * Cos(fwq) - nq * v * Sin(fwq) + xzh '经过测试，计算结果中的两种公式计算结果是一样的
y = u * Sin(fwq) + nq * v * Cos(fwq) + yzh
d = (90 * l * l / pi / r / ls) * pi / 180 '计算缓和曲线上的偏角（此句要点为角度必须转换为弧度即：pi/180）
fw = fwq + d * nq '计算前进方位角
zdfm = dfm(fw) '将弧度形式的前进方位角转换度分秒形式
'输出坐标值以弧度和度分秒形式的前进方位角
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)
'调入方位角计算
fwq = fwj(xjd, xzh, yjd, yzh) '计算ZH点方位角
fwh = fwj(xhz, xjd, yhz, yjd) '计算HZ点方位角（此角作用是用来推算曲线是左偏还是右偏）
'调入偏角判定
nh = n(fwh, fwq) '计算偏角方向，左偏为-1右偏为1（注意：因为是从后HZ点起算，所以必须将HZ点方位角放在前ZH放在后）
'结果计算
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)) '经过测试，计算结果中的两种公式计算结果是一样的
y = yhz - (u * Sin(fwh) + nh * v * Cos(fwh))
d = (90 * l * l / pi / r / ls) * pi / 180 '计算缓和曲线上的偏角（此句要点为角度必须转换为弧度即：pi/180）
fw = fwh + d * nh '计算前进方位角
zdfm = dfm(fw) '将弧度形式的前进方位角转换度分秒形式
'输出坐标值以弧度和度分秒形式的前进方位角
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 '将弧度转化为度
jd = Int(ao) '计算度
jf = Int(ao * 60 - jd * 60) '计算分
jmx = (ao - jd - jf / 60) * 3600 '计算秒
jm = Left(jmx, 8) '因为拆分出来的秒数经常占到十多位，所以只取秒数的前八位
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))

smile911

用VBA编的好东西！～

engineerlzk

可以计算卵形曲线吗？

duyuanxun123

什么曲线
卵形曲线？
有这样的曲线。我真不知道。反正我用他还可以

engineerlzk

就是不完整的缓和曲线。完整缓和曲线为半径由∞→R的缓和曲线，卵形曲线为半径由R→r的缓和曲线。