EXCEL交点法线路正反算VB源码1(初始化及公共函数)

OptionExplicitPublicConstMIN=0.0000000001PublicConstMAX=1E+20PublicConstLIMIT=0.000001'Point数据类型(类似于单位向量)PublicTypePointXAsDoubleYAsDoubleAzimuthAsDouble'点的切向角EndType'交点数据类型PublicTypeJDXAsDouble'交点的坐标YAsDoubleAngleAsDouble'交点的转角Lh1AsDouble'入口段缓和曲线的长度RadiusAsDouble'圆曲线半径Lh2AsDouble'出口段缓和曲线长度FlagAsInteger'左转为负，右转为正OffsetAsDouble'隧道曲线段偏移量pointZHAsPoint'直缓点坐标里程pegZHAsDoublepointHYAsPoint'缓圆点坐标里程pegHYAsDoublepointYHAsPoint'圆缓点坐标里程pegYHAsDoublepointHZAsPoint'缓直点坐标里程pegHZAsDoubleEndType'长短链数据类型TypePegBreakinPEGAsDouble'来向桩号outPEGAsDouble'去向桩号D_PEGAsDouble'去向-来向，（短链为正，长链为负）EndTypePublicJDs()AsJD'交点数组PublicN_JDAsInteger'交点数量（不包括起点和终点）PublicPegBreaks()AsPegBreak'长短链数组PublicN_BreakAsInteger'长短链数量'反算方位角'计算结果以弧度形式返回FunctionToAzimuth(DXAsDouble,DYAsDouble)AsDoubleIfDX0ThenToAzimuth=Atn(DY/DX)ElseIfDX0ThenToAzimuth=Atn(DY/DX)+Application.Pi()ElseIfDY0ThenToAzimuth=Application.Pi()/2ElseIfDY0ThenToAzimuth=-Application.Pi()/2ElseToAzimuth=0EndIfEndIfEndFunction'输出角度格式方位角PublicFunctionDMS(RadAsDouble)AsStringDimD1,D2,D3,Tem,Angle,S1'将输入的弧度值转化为角度，并归化为小于360°的正数Angle=Rad/Application.Pi()*180DoWhileAngle0Angle=Angle+360LoopDoWhileAngle360Angle=Angle-360LoopD1=Fix(Angle+MIN)'提取度数（整数部分）Tem=(Angle-D1)*3600'余数换算为秒D2=Fix(Tem/60+MIN)'提取分位D3=Round(Tem-D2*60)'提取秒位DMS=CStr(D1)+°+CStr(D2)+′+CStr(D3)+″'转换为字符串EndFunction'坐标累进'函数不计算点的切向角，计算过程中点的切向角置零，因此需在调用本函数之后计算切向角PublicFunctionVector(PointAAsPoint,LengthAsDouble,AzimuthAsDouble)AsPointDimPointBAsPointPointB.X=PointA.X+Length*Cos(Azimuth)PointB.Y=PointA.Y+Length*Sin(Azimuth)PointB.Azimuth=0'切向角置零Vector=PointBEndFunction'计算切线支距坐标'仅用于Curve函数PrivateSubTangent(RadiusAsDouble,LhAsDouble,Arc_HAsDouble,ByRefzXAsDouble,ByRefzYAsDouble)zX=Arc_H-Arc_H^5/(40*(Radius*Lh)^2)+Arc_H^9/(3456*(Radius*Lh)^4)_-Arc_H^13/(599040*(Radius*Lh)^6)+Arc_H^17/(175472640*(Radius*Lh)^8)zY=Arc_H^3/(6*(Radius*Lh))-Arc_H^7/(336*(Radius*Lh)^3)+Arc_H^11/(42240*(Radius*Lh)^5)_-Arc_H^15/(9676800*(Radius*Lh)^7)+Arc_H^19/(3530096640#*(Radius*Lh)^9)EndSub'正算曲线段加桩点坐标'1、计算Position交点位置曲线段的加桩点坐标；'2、函数中的Arc指由直线段指向圆曲线段的弧长。PublicFunctionCurve(PositionAsInteger,ArcAsDouble,ModelAsString)AsPointDimBJAsDoubleDimzXAsDoubleDimzYAsDoubleDimAngle_XAsDoubleDimLength_XAsDoubleDimAzimuth_XAsDoubleDimPoint_JAsPoint'弧长参数的有效性判断（不可为负）IfArc0ThenArc=0EndIf'入口缓和曲线段IfLCase(Trim(Model))=frontThenIfJDs(Position).Lh1MINThen'当入口段无缓和曲线时PointZH等于PointHYCurve=JDs(Position).pointZHExitFunctionEndIfBJ=Arc^2/(2*JDs(Position).Radius*JDs(Position).Lh1)'计算转角CallTangent(JDs(Position).Radius,JDs(Position).Lh1,Arc,zX,zY)'计算切线支距坐标Length_X=Sqr(zX^2+zY^2)'计算弦长Angle_X=ToAzimuth(zX,zY)'计算弦切角Azimuth_X=JDs(Position).pointZH.Azimuth+JDs(Position).Flag*Angle_X'计算弦向（由直缓点指向中桩点）方位角Point_J=Vector(JDs(Position).pointZH,Length_X,Azimuth_X)'计算中桩坐标Point_J.Azimuth=JDs(Position).pointZH.Azimuth+JDs(Position).Flag*BJ'计算中桩切向角Curve=Point_J'圆曲线段ElseIfLCase(Trim(Model))=circleThenAngle_X=Arc/(2*JDs(Position).Radius)'计算弦切角Length_X=2*JDs(Position).Radius*Sin(Angle_X)'计算弦长Azimuth_X=JDs(Position).pointHY.Azimuth+JDs(Position).Flag*Angle_X'计算弦向（由缓圆点指向中桩点）方位角Point_J=Vector(JDs(Position).pointHY,Length_X,Azimuth_X)'计算中桩坐标Point_J.Azimuth=JDs(Position).pointHY.Azimuth+JDs(Position).Flag*2*Angle_X'计算中桩点切向角（转角=2*弦切角）Curve=Point_J'出口缓和曲线段ElseIfLCase(Trim(Model))=backThenIfJDs(Position).Lh1MINThen'当出口段无缓和曲线时PointHZ等于PointYHCurve=JDs(Position).pointHZExitFunctionEndIfBJ=Arc^2/(2*JDs(Position).Radius*JDs(Position).Lh2)'计算转角CallTangent(JDs(Position).Radius,JDs(Position).Lh2,Arc,zX,zY)'计算切线支距坐标Length_X=Sqr(zX^2+zY^2)'计算弦长Angle_X=ToAzimuth(zX,zY)'计算弦切角Azimuth_X=JDs(Position).pointHZ.Azimuth+Application.Pi()-JDs(Position).Flag*Angle_X'计算弦向（由缓直点指向中桩点）方位角Point_J=Vector(JDs(Position).pointHZ,Length_X,Azimuth_X)'计算中桩坐标Point_J.Azimuth=JDs(Position).pointHZ.Azimuth-JDs(Position).Flag*BJ'计算中桩切向角Curve=Point_JEndIfEndFunction'计算修正里程（加上长短链）'1、函数已考虑了各种边界条件；'2、加长短链无须进行合法性判断。PublicFunctionRevisedPEG(PEG_OAsDouble)AsDoubleDimPEG_RAsDoubleDimiAsIntegerDimPositionAsInteger'对原始里程进行修正，并记录最后一个改正的断链位置Position=0PEG_R=PEG_OFori=1ToN_BreakIfPEG_RPegBreaks(i).inPEGThenPEG_R=PEG_R+PegBreaks(i).D_PEGPosition=Position+1'用于记录最后一个改正的断链位置ElseExitForEndIfNext'如果原始里程小于第一个断链位置，则直接返回，此处是为了避免下方引用的断链数组下标越界IfPosition=0ThenRevisedPEG=PEG_RExitFunctionEndIf'判断桩号位置是否在长链上，如果桩号在长链上则冠以负号IfPEG_R=PegBreaks(Position).inPEGThenRevisedPEG=-PEG_RElseRevisedPEG=PEG_REndIfEndFunction'计算原始里程（去除长短链）'1、函数已考虑了各种边界条件；'2、函数考虑了两个合法性条件的判断：1).没有断链数据，2).为负值而不在长链上，3).在短链的空白带；'3、如果函数不合法则返回负值。PublicFunctionOriginalPEG(PEG_RAsDouble)AsDoubleDimTemAsDoubleDimiAsIntegerDimPositionAsInteger'如果没有断链数据时，输入里程不进行改正IfN_Break=0ThenOriginalPEG=PEG_R'如果PEG_R小于零，则同样返回负值出错ExitFunctionEndIf'搜寻输入里程范围内最前方断链位置Fori=N_BreakTo1Step-1IfAbs(PEG_R)=PegBreaks(i).outPEGThenExitForEndIfNextPosition=i'判断函数是否位于短链位置的空白带IfPosition+1=N_BreakThenIfAbs(PEG_R)PegBreaks(Position+1).inPEGThenOriginalPEG=-1ExitFunctionEndIfEndIf'如果输入里程在第一个断链之后，则无需改正，此处是为了避免下方引用的断链数组下标越界IfPosition=0ThenOriginalPEG=PEG_R'如果PEG_R小于零，则同样返回负值出错ExitFunctionEndIf'如果搜索到的位置在长链位置且输入里程在长链段IfPegBreaks(Position).D_PEG0AndAbs(