坐标反算程序模块

PublicConstPIAsDouble=3.14159265358979'定义桩号点PublicTypeStaPointMileAsDouble'里程xAsDouble'x坐标yAsDouble'y坐标zAsDouble'高程aAsDouble'切线方位角bAsDouble'RoAsDouble'曲率EndType'定义基本曲线PublicTypeCurveSecST_StaAsStaPointEN_StaAsStaPointEndTypeSubZqb()DimPM(3,5)AsDoubleDimzy,i,jAsIntegerDimST1,ST2,pj,Jdjj,sttAsDoubleDimq1,q2,p1,p2,t1,t2,ly,LL,EHAsDoubleDimJDAsStringWithSheets(平面资料)JD=.Cells(2,2)PM(1,1)=.Cells(2,3)PM(1,2)=.Cells(2,4)stt=.Cells(2,8)EndWithSheets(直曲表).SelectRows(6:500).ClearContentsCells(6,1)=JDCells(6,2)=PM(1,1)Cells(6,3)=PM(1,2)Cells(6,4)=sttWithSheets(平面资料)Fori=2To8000If.Cells(i+2,3)=ThenPM(1,1)=.Cells(i,3)PM(1,2)=.Cells(i,4)JD=.Cells(i+1,2)Forj=3To7PM(2,j-2)=.Cells(i+1,j)Nextj'计算方位角ST1=Fwj(PM(1,1),PM(1,2),PM(2,1),PM(2,2))Jdjj=jj(PM(1,1),PM(1,2),PM(2,1),PM(2,2))'填写直曲表Cells(i+5,1)=JDCells(i+5,2)=PM(2,1)Cells(i+5,3)=PM(2,2)Cells(i+5,20)=JdjjCells(i+5,19)=Cells(i+5,20)-Cells(i+4,11)-Cells(i+5,10)Cells(i+5,4)=Cells(i+4,18)+Cells(i+5,19)Cells(i+5,21)=toDay(ST1)CallxyysExitSubEndIf'-------------------------------------------PM(1,1)=.Cells(i,3)PM(1,2)=.Cells(i,4)JD=.Cells(i+1,2)Forj=3To7PM(2,j-2)=.Cells(i+1,j)PM(3,j-2)=.Cells(i+2,j)Nextj'计算方位角、偏角ST1=Fwj(PM(1,1),PM(1,2),PM(2,1),PM(2,2))ST2=Fwj(PM(2,1),PM(2,2),PM(3,1),PM(3,2))Jdjj=jj(PM(1,1),PM(1,2),PM(2,1),PM(2,2))pj=Ang(ST2-ST1)Ifpj-PIThenpj=pj+2*PIIfpjPIThenpj=pj-2*PIzy=1Ifpj0Thenzy=-1pj=Abs(pj)'计算曲线要素q1=PM(2,4)/2-PM(2,4)^3/(240*PM(2,3)^2)+PM(2,4)^5/(34560*PM(2,3)^4)q2=PM(2,5)/2-PM(2,5)^3/(240*PM(2,3)^2)+PM(2,5)^5/(34560*PM(2,3)^4)p1=PM(2,4)^2/(24*PM(2,3))-PM(2,4)^4/(2688*PM(2,3)^3)+PM(2,4)^6/(506880*PM(2,3)^5)p2=PM(2,5)^2/(24*PM(2,3))-PM(2,5)^4/(2688*PM(2,3)^3)+PM(2,5)^6/(506880*PM(2,3)^5)t1=q1+(PM(2,3)+p2-(PM(2,3)+p1)*Cos(pj))/Sin(pj)t2=q2+(PM(2,3)+p1-(PM(2,3)+p2)*Cos(pj))/Sin(pj)ly=PM(2,3)*pj-(PM(2,4)+PM(2,5))/2LL=ly+PM(2,4)+PM(2,5)EH=(PM(2,3)+p1/2+p2/2)/Cos(pj/2)-PM(2,3)'计算主点桩号'填写直曲表Cells(i+5,1)=JDCells(i+5,2)=PM(2,1)Cells(i+5,3)=PM(2,2)Ifzy=1ThenCells(i+5,6)=toDay(pj)ElseCells(i+5,5)=toDay(pj)EndIfCells(i+5,7)=PM(2,3)'半径Cells(i+5,8)=PM(2,4)'第一缓和曲线Cells(i+5,9)=PM(2,5)'第二缓和曲线Cells(i+5,10)=t1'第一切线长Cells(i+5,11)=t2'第二切线长Cells(i+5,12)=LL'曲线长Cells(i+5,13)=EH'外距Cells(i+5,20)=Jdjj'交点间距Cells(i+5,19)=Cells(i+5,20)-Cells(i+4,11)-Cells(i+5,10)'夹直线长度Cells(i+5,21)=toDay(ST1)'计算方位角Cells(i+5,22)=zy'路线左右偏代码Cells(i+5,14)=Cells(i+4,4)-Cells(i+4,10)+Cells(i+4,12)+Cells(i+5,19)'ZH点桩号Cells(i+5,4)=Cells(i+5,14)+Cells(i+5,10)'交点桩号Cells(i+5,18)=Cells(i+5,14)+Cells(i+5,12)'HZ点桩号Cells(i+5,15)=Cells(i+5,14)+Cells(i+5,8)'HY点桩号Cells(i+5,17)=Cells(i+5,18)-Cells(i+5,9)'YH点桩号Cells(i+5,16)=Cells(i+5,15)+ly/2#'QZ点桩号NextiEndWithEndSubSubxyys()'生成线元数据DimbtAsDoubleDimi,jAsIntegeri=7j=7bt=0.0005Cells(6,24)=Cells(6,4)Cells(6,30)=Cells(7,21)Cells(6,31)=Cells(6,2)Cells(6,32)=Cells(6,3)DoWhileCells(i,7)Cells(j,24)=Cells(i,14)IfAbs(Cells(j,24)-Cells(j-1,24))btThenCells(j,26)=0Cells(j,27)=0j=j+1EndIfCells(j,24)=Cells(i,15)IfAbs(Cells(j,24)-Cells(j-1,24))btThenCells(j,26)=0Cells(j,27)=Cells(i,7)*Cells(i,22)j=j+1EndIfCells(j,24)=Cells(i,17)IfAbs(Cells(j,24)-Cells(j-1,24))btThenCells(j,26)=Cells(i,7)*Cells(i,22)Cells(j,27)=Cells(j,26)j=j+1EndIfCells(j,24)=Cells(i,18)IfAbs(Cells(j,24)-Cells(j-1,24))btThenCells(j,26)=Cells(i,7)*Cells(i,22)Cells(j,27)=0j=j+1EndIfi=i+1LoopCells(j,24)=Cells(i,4)Cells(j,26)=0Cells(j,27)=0CallxyjsEndSub''求线元内任意长度L内的坐标及切线方位角，采用Gauss-Legendre公式计算SubGetStaCoor(secAsCurveSec,staAsStaPoint)Dimf(2,4)AsDoubleDimL,LL,GetaiAsDoubleDimS1,S2,a0,c0,c1,HAsDoubleDimiAsIntegerL=sta.Mile-sec.ST_Sta.MileLL=sec.EN_Sta.Mile-sec.ST_Sta.MileIfAbs(LL)0.001Thensta=sec.ST_StaElse'求点的切线方位角及曲率Withsecsta.Ro=.ST_Sta.Ro+(.EN_Sta.Ro-.ST_Sta.Ro)*L/LLGetai=.ST_Sta.a+(sta.Ro+.ST_Sta.Ro)*L/2sta.a=Ang(Getai)EndWithf(1,1)=0.0694318442f(1,2)=0.3300094782f(1,3)=1-f(1,2)f(1,4)=1-f(1,1)f(2,1)=0.1739274226f(2,2)=0.3260725774f(2,3)=f(2,2)f(2,4)=f(2,1)S1=0#S2=0#a0=sec.ST_Sta.ac0=sec.ST_Sta.Roc1=sec.EN_Sta.RoH=(c1-c0)*L*L/(2#*LL)Fori=1To4S1=S1+f(2,i)*Cos(a0+c0*L*f(1,i)+H*f(1,i)*f(1,i))S2=S2+f(2,i)*Sin(a0+c0*L*f(1,i)+H*f(1,i)*f(1,i))Nextista.x=sec.ST_Sta.x+L*S1sta.y=sec.ST_Sta.y+L*S2EndIfEndSub'线元要素计算Subxyjs()DimiAsIntegerDimsecAsCurveSecDimstaAsStaPointDimSta1AsStaPointi=7DoWhileCells(i,24)Cells(i,25)=Cells(i,24)-Cells(i-1,24)Cells(i,28)=curve(Cells(i,26))Cells(i,29)=curve(Cells(i,27))Cells(i,33)=ltype(Cells(i,26),Cells(i,27))Withsec.ST_Sta.Mile=Cells(i-1,24).Ro=Cells(i,28).a=toRad(Cells(i-1,30)).x=Cells(i-1,31).y=Cells(i-1,32)EndWithWithsec.EN_Sta.Mile=Cells(i,24).Ro=Cells(i,29)EndWithIfCells(i,33)=2ThenCells(i,34)=GetA(sec)EndIfsta.Mile=sec.EN_Sta.MileCallGetStaCoor(sec,sta)Cells(i,30)=toDay(sta.a)Cells(i,31)=sta.xCells(i,32)=sta.yi=i+1LoopEndSub''求缓和曲线参数FunctionGetA(secAsCurveSec)WithsecIf.ST_Sta.Ro.EN_Sta.RoThenGetA=Sqr((.EN_Sta.Mile-.ST_Sta.Mile)/Abs(.EN_Sta.Ro-.ST_Sta.Ro))EndIfEndWithEndFunction'返回线元类型Functionltype(xAsDouble,yAsDouble)AsInteger'0-圆曲线，1-直线，2-缓和曲线DimeAsDoublee=0.00001IfAbs(x)eAndAbs(x-y)eThenltype=1ElseIfAbs(x-y)eThenltype=0Elseltype=2EndIfEndFunction'返回曲率Functioncurve(RAsDouble)AsDouble