Excel批量反算桩号.doc

新建一个Excel表，按ALT+F11进入Excel VB编辑器。依次点击——插入——模块，将下面的内容全部复制到右边的空白窗口里面（曲线元素请自行修改，下面有说明）。保存后就可以在这个新建的Excel表里用了（如果出现 #NAME？ 请百度 “Excel启用宏”）。 中桩X =XPS(DKI,1) 中桩Y =XPS(DKI,2) 中桩方位角 =XPS(DKI,3) 中桩高程 =SHU(DKI) 坐标反算桩号 =ZHUANG(X,Y,1) 坐标反算距中桩距离 =ZHUANG(X,Y,2) 从下面开始复制到结束*************************** Function XPS(DKI, Z) 辛普森公式， 5800程序改编 Dim QX As Variant Dim A, B, C, D, E, F, G As Double Dim P, Q, I, J, M, N, K As Double 曲线元素，请自行更改 ElseIf DKI终点桩号 THEN QX=Array(起点桩号，终点桩号，起点X，起点Y，起点方位角（弧度），起点半径，终点半径） If DKI 20058.839 Then QX = Array(0, 0, 0, 0, 0, 0, 0) ElseIf DKI 20238.839 Then QX = Array(20058.839, 20238.839, 4201152.834, 465521.276, 5.65395484192746, 0, 1500) ElseIf DKI 20816.464 Then QX = Array(20238.839, 20816.464, 4201300.426, 465418.29, 5.71395484980653, 1500, 1500) ElseIf DKI 20996.464 Then QX = Array(20816.464, 20996.464, 4201834.24, 465207.124, 6.09903818731417, 1500, 0) ElseIf DKI 21116.464 Then QX = Array(20996.464, 21116.464, 4202012.345, 465181.272, 6.15903858304419, 0, -1244.01) ElseIf DKI 21538.232 Then QX = Array(21116.464, 21538.232, 4202131.155, 465164.502, 6.11080747575542, -1244.01, -1244.01) ElseIf DKI 21658.232 Then QX = Array(21538.232, 21658.232, 4202526.61, 465023.77, 5.77176839646516, -1244.01, 0) ElseIf DKI 21850.133 Then QX = Array(21658.232, 21850.133, 4202629.304, 464961.713, 5.72353724069503, 0, 0) ElseIf DKI 21970.133 Then QX = Array(21850.133, 21970.133, 4202791.929, 464859.835, 5.72353724069503, 0, 1252.482) ElseIf DKI 22050.81 Then QX = Array(21970.133, 22050.81, 4202894.615, 464797.767, 5.77144211685777, 1252.482, 1252.482) ElseIf DKI 22310.81 Then QX = Array(22050.81, 22310.81, 4202966.18, 464760.552, 5.83585582000829, 1252.482, 2900) ElseIf DKI 23162.892 Then QX = Array(22310.81, 23162.892, 4203208.994, 464668.271, 5.98447753865125, 2900, 2900) ElseIf DKI 23418.664 Then