利用Excel-vba工程测量坐标计算
工具/原料
EXCEL
VBA
方法/步骤
1、打开office-excel
2、ALT+F11插入模块,如图所示
3、粘贴如下代码Publici1Publicfsz蟠校盯昂dlcAsDoubleFunctionzs(ByR髫潋啜缅eflx_name,k,z,b)Iflx_name=""Thenzs="【线路名称不能为空】"SetWb=NothingExitFunctionEndIfIfTypeName(pqxb)<>"Variant()"Thenpqxb=ThisWorkbook.Sheets("平曲线").Range("a1:i"&ThisWorkbook.Sheets("平曲线").[b65536].End(xlUp).Row)sqxb=ThisWorkbook.Sheets("竖曲线").Range("a1:g"&ThisWorkbook.Sheets("竖曲线").[b65536].End(xlUp).Row)Fori=LBound(pqxb)+1ToUBound(pqxb)Ifpqxb(i,1)<>""Thensuoyouluxian.Addpqxb(i,1)EndIfNextiEndIfDimi0AsLongFori0=1Tosuoyouluxian.CountIflx_name=i0Thenlx_name=suoyouluxian.Item(i0)ExitForEndIfNexti0Fori1=2ToUBound(pqxb)Iflx_name=pqxb(i1,1)ThenExitForEndIfNexti1Ifi1>UBound(pqxb)Thenzs="没有找到【"&lx_name&"】的路线名"ExitFunctionElse'下面这个if语句主要是用于反算里程使用，如果只使用正算功能则不需要判断Ifk=-1Thenk=pqxb(i1,2)EndIf'找出终点里程Fori3=i1ToUBound(pqxb)Ifpqxb(i3,1)<>""Andpqxb(i3,1)<>lx_nameThenfszdlc=pqxb(i3-1,2)+pqxb(i3-1,6)ExitForEndIfNexti3Fori2=i1ToUBound(pqxb)If(pqxb(i2,1)=""Orpqxb(i2,1)=lx_name)And(k>=pqxb(i2,2)Andk<=pqxb(i2,2)+pqxb(i2,6))Then线元起点里程=pqxb(i2,2)线元起点X=pqxb(i2,3)线元起点Y=pqxb(i2,4)线元起点弧度制方位角=dfmtorad(CDbl(pqxb(i2,5)))线元长度=pqxb(i2,6)起点半径=pqxb(i2,7)终点半径=pqxb(i2,8)左负1右1直线0=pqxb(i2,9)zs=xyzs(线元起点里程,线元起点X,线元起点Y,线元起点弧度制方位角,线元长度,起点半径,终点半径,左负1右1直线0,k,z,b)SetWb=NothingExitFunctionElseIfpqxb(i2,1)<>""Andpqxb(i2,1)<>lx_nameThenExitForEndIfNexti2EndIfzs=lx_name&"的计算范围【"&pqxb(i1,2)&"—"&pqxb(i2-1,2)+pqxb(i2-1,6)&"】"EndFunctionFunctiondfmtorad(dfmAsDouble)dfm=dfm+0.0000000000001DimdAsDoubleDimfAsDoubleDimmAsDoubled=Fix(dfm)f=Fix(dfm*100-d*100)m=Fix(dfm*10000-d*10000-f*100)dfmtorad=(d+f/60+m/3600)*3.1415926/180EndFunction'线元法计算'参数:起点里程,起点x,起点y,起点方位角弧度,,线元长度,起点半径，终点半径，方向左-1,右1,直线0,计算点的里程，宽度，右夹角十进制PrivateFunctionxyzs(线元起点里程,线元起点X,线元起点Y,线元起点弧度制方位角,线元长度,_起点半径,终点半径,左负1右1直线0,jsk,右角_十进制,jsb)AsVariantIf起点半径=0Then起点半径=9.999E+102EndIfIf终点半径=0Then终点半径=9.999E+102EndIfDimf0AsSinglef0=线元起点弧度制方位角DimqAsIntegerq=左负1右1直线0DimcAsSinglec=1/起点半径DimdAsDoubled=(起点半径-终点半径)/2/线元长度/起点半径/终点半径Dimrr(1To4)AsSingleDimvv(1To4)AsSinglerr(1)=0.1739274226rr(2)=0.3260725774rr(3)=rr(2)rr(4)=rr(1)vv(1)=0.0694318442vv(2)=0.3300094782vv(3)=1-vv(2)vv(4)=1-vv(1)DimiAsInteger,WAsDouble,xsAsDouble,ysAsDouble,ffAsDoubleW=jsk-线元起点里程xs=0ys=0Fori=1To4ff=f0+q*vv(i)*W*(c+vv(i)*W*d)xs=xs+rr(i)*Cos(ff)ys=ys+rr(i)*Sin(ff)NextiDimfhz3AsDoublefhz3=f0+q*W*(c+W*d)If(fhz3<0)Thenfhz3=fhz3+2*3.1415926EndIfIf(fhz3>=2*3.1415926)Thenfhz3=fhz3-2*3.1415926EndIfDimfhzdfmAsDoublefhzdfm=fhz3*180/3.1415926DimfhzdAsIntegerfhzd=Int(fhzdfm)Dimfhzffhzf=Int((fhzdfm-fhzd)*60)Iffhzf<10Thenfhzf=0&fhzfEndIfDimfhzmfhzm=Int((((fhzdfm-fhzd)*60)-fhzf)*60)fhzf=Int((fhzdfm-fhzd)*60)Iffhzm<10Thenfhzm=0&fhzmEndIfDimfhz1AsDoublefhz1=Format(线元起点X+W*xs+jsb*Cos(fhz3+右角_十进制*3.1415926/180),"0.000")Dimfhz2AsDoublefhz2=Format(线元起点Y+W*ys+jsb*Sin(fhz3+右角_十进制*3.1415926/180),"0.000")xyzs=Array(fhz1,fhz2,fhz3,fhzd&"°"&fhzf&"′"&fhzm&"″")EndFunction
4、点击保存格式选择为:.xlam
5、关闭excel打开excel选项勾选开发者选项
6、选择刚才保存的位置
7、任意单元格中输入zs即可使用该自定义函数到此结束
