等高线土方量计算

读取图上坐标！
读坐标展点程序展点到CAD上的点坐标。

加载文件，运行DQZB即可
不过好象CAD2000能用 2004及05都不兼容

计算直线，缓和曲线，圆曲线，切线上，法线上，有夹角的线上（都所谓边桩）

任意点坐标，卡西欧计算器4500

道路坐标计算软件，免费

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

前缓和段
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 >

边桩公式(此公式在电子表格中直接输入)：
=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自动计算曲线坐标．给大家研究研究．欢迎在此基础上开发增加新模块．

谢了！很不错呵