快速计算任何难度的道路中线边线坐标

1、EXCEL快速计算任何难度的道路中线、边线坐标q = 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.

2、806 kjd = 160.9966 ls = 30 r = 75 khy = 129.4763 kyh = 182.3385 '曲线区域i = 2 '从第二格开始读取数据所以定义I=2 ii = 1 '桩号从第一个开始启用，所以定义II=2Do k(ii) = Workbooks("单交点平曲线.xls").Worksheets("sheet1").Cells(i, 1) '定义桩号等于读取数据 If Workbooks("单交点平曲线.xls").Worksheets("sheet1&qu

3、ot;).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 The

4、n '若计算点在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和

5、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, ByVa

6、l 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

7、("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

8、 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点（因为以直缓点起算）到待求桩号的弧度长度

9、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点方位角（此角作用是用来推算曲线是左偏还是

10、右偏） '调入偏角判定 nq = n(fwq, fwh) '计算偏角方向，左偏为-1右偏为1 '计算坐标 x = u * Cos(fwq) - nq * v * Sin(fwq) + xzh y = u * Sin(fwq) + nq * v * Cos(fwq) + yzhd = (90 * (2 * l - ls) / pi / r) * pi / 180 '计算圆曲线上的偏角（此句要点为角度必须转换为弧度即：pi/180） fw = fwq + d * nq '计算前进方位角 zdfm = dfm(fw) '将弧度形式的前进方位角转换度分秒

11、形式 '输出坐标值以弧度和度分秒形式的前进方位角 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&

12、quot;).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

13、 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(xh

14、z, 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

15、 - (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 Workb

16、ooks("单交点平曲线.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 D

17、ouble) 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 '由增量判断方位角所在象限，不

18、同象限取不同的值 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 '当在大地坐标中偏量在第四象

19、限上的值时 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) '因为拆分出来的秒数经常占到十多位，所以只取

20、秒数的前八位 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+

21、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

22、+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

23、+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+

24、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+RADIA

25、NS(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(