EXCEL交点法线路正反算VB源码2(平曲线正反算)

OptionExplicit'坐标正算'1、交点数组是全局变量，函数自由调用，因此函数无须输入曲线数据；'2、如果输入了Offset参数，则不考虑隧道的中心偏移量；'3、Offset的输入与输出在本函数及本程序中均遵循左负右正原则。PublicFunctionToCoord(PEG_JAsDouble,OffsetAsDouble,ModelOfReturnAsString)DimPoint_JAsPointDimArcAsDoubleDimLength_XAsDoubleDimPositionAsInteger'判断曲线参数的有效性IfN_JD0ThenToCoord=DataError!ExitFunctionEndIf'将修正里程改为原始里程并判断加桩点桩号的有效性PEG_J=OriginalPEG(PEG_J)IfPEG_J0ThenToCoord=PEGError!'输入里程有效性判断ExitFunctionElseIfPEG_JJDs(0).pegHZOrPEG_JJDs(N_JD+1).pegZHThen'加桩点里程超出范围ToCoord=OutOfRange!ExitFunctionEndIf'判断加桩点的位置Position=0DoWhilePEG_JJDs(Position+1).pegZH'最后一个JDs为线路的终点，以其pegZH属性存储终点里程Position=Position+1'加桩点位于Position交点的ZH点（不包括）至Position+1交点的ZH点（包括）之间Loop'加桩点位于起始直线段IfPosition=0ThenLength_X=PEG_J-JDs(0).pegHZPoint_J=Vector(JDs(0).pointHZ,Length_X,JDs(0).pointHZ.Azimuth)Point_J.Azimuth=JDs(0).pointHZ.Azimuth'加桩点位于其它交点段位置ElseIfPEG_JJDs(Position).pegHYThen'加桩点位于入口缓和曲线段Arc=PEG_J-JDs(Position).pegZHPoint_J=Curve(Position,Arc,Front)IfAbs(Offset)MINThen'如果用户未输入偏移量则按照隧道的中心偏移处理Offset=JDs(Position).Flag*(Arc/JDs(Position).Lh1)*JDs(Position).OffsetEndIfElseIfPEG_JJDs(Position).pegYHThen'加桩点位于圆曲线段Arc=PEG_J-JDs(Position).pegHYPoint_J=Curve(Position,Arc,Circle)IfAbs(Offset)MINThen'如果用户未输入偏移量则按照隧道的中心偏移处理Offset=JDs(Position).Flag*JDs(Position).OffsetEndIfElseIfPEG_JJDs(Position).pegHZThen'加桩点位于出口缓和曲线段Arc=JDs(Position).pegHZ-PEG_JPoint_J=Curve(Position,Arc,Back)IfAbs(Offset)MINThen'如果用户未输入偏移量则按照隧道的中心偏移处理Offset=JDs(Position).Flag*(Arc/JDs(Position).Lh2)*JDs(Position).OffsetEndIfElse'加桩点位于末端直线段Length_X=PEG_J-JDs(Position).pegHZPoint_J=Vector(JDs(Position).pointHZ,Length_X,JDs(Position).pointHZ.Azimuth)Point_J.Azimuth=JDs(Position).pointHZ.AzimuthEndIfEndIf'计算偏移后加桩点坐标(不能使用Vector函数，否则Point_J点的切向角将为零)Point_J.X=Point_J.X+Abs(Offset)*Cos(Point_J.Azimuth+Sgn(Offset)*Application.Pi()/2)Point_J.Y=Point_J.Y+Abs(Offset)*Sin(Point_J.Azimuth+Sgn(Offset)*Application.Pi()/2)'判断返回何值SelectCaseLCase(Trim(ModelOfReturn))CasegetxToCoord=Point_J.XCasegetyToCoord=Point_J.YCaseazimuthToCoord=DMS(Point_J.Azimuth)'将切向角转换为方位角字符串CaseElseToCoord=ModelError!EndSelectEndFunction'计算基点和点的切向夹角（相当于计算切向向量和基点至参数点向量的夹角）'1、函数用于GetArc函数和ToPEG函数和隧道断面中的Tunnel函数中，即只用于坐标反算；'2、返回的夹角值的范围在-PI~+PI之间，主要是为了判断点在基点的左边还是右边(左负右正)。PublicFunctionGetAngle(BasePointAsPoint,PxAsDouble,PyAsDouble)AsDoubleDimAzimuth_PAsDoubleDimAngle_PAsDoubleAzimuth_P=ToAzimuth(Px-BasePoint.X,Py-BasePoint.Y)'计算基点至点的方位角Angle_P=Azimuth_P-BasePoint.AzimuthDoWhileAbs(Angle_P)Application.Pi()'归化转角取值范围在-PI~+PI之间Angle_P=Angle_P-Sgn(Angle_P)*2*Application.Pi()LoopGetAngle=Angle_PEndFunction'计算缓和曲线段的加桩点弧长'1、本函数采用对缓和曲线的拟合圆曲线来计算初始弧长，在初始弧长的基础上迭代计算出加桩点的弧长；'2、拟合圆曲线通过缓和曲线的两个端点（直缓点和缓圆点或圆缓点和缓直点），其半径取两倍的圆曲线半径；'3、通过初始弧长的计算可以较大的提高函数的计算效率，一般4~5次迭代可算得比较精确的数据；'4、函数直接读取全局变量中的曲线参数但需要给定交点的位置以及是入口段缓和曲线还是出口段缓和曲线；'5、本函数仅在ToPEG函数中调用。PrivateSubGetArc(J_XAsDouble,J_YAsDouble,iAsInteger,ModelAsString,ByRefPointVerticalAsPoint,ByRefArcAsDouble)DimPointMidAsPointDimPointOAsPointDimPointAAsPointDimPointBAsPointDimPointTemAsPointDimArc_HAsDoubleDimLength_CAsDoubleDimLength_RAsDoubleDimPLAsDoubleDimAzimuth_Tem1AsDoubleDimAngle_TemAsDoubleDimAngle_GAsDoubleDimGAsDoubleDimArc_TemAsDoubleDimTemAsDoubleDimFAsIntegerDimCAsIntegerIfLCase(Trim(Model))=frontThen'如果是入口段缓和曲线PointA=JDs(i).pointZHPointB=JDs(i).pointHYArc_H=JDs(i).Lh1F=1'符号标志，入口或出口曲线在计算中的修正，为了程序的统一和简洁ElseIfLCase(Trim(Model))=backThen'如果是出口段缓和曲线PointA=JDs(i).pointHZPointB=JDs(i).pointYHArc_H=JDs(i).Lh2F=-1EndIf'求取拟合圆的圆心，其切向角指向ZH点或HZ点（直线一端）PointMid.X=(PointA.X+PointB.X)/2'缓和曲线的弦线中点坐标PointMid.Y=(PointA.Y+PointB.Y)/2PointMid.Azimuth=ToAzimuth(PointB.X-PointA.X,PointB.Y-PointA.Y)'弦线中点的切向角由直线段指向圆曲线端Length_C=Sqr((PointB.X-PointA.X)^2+(PointB.Y-PointA.Y)^2)'计算弦线长Length_R=Sqr((2*JDs(i).Radius)^2-(Length_C/2)^2)'计算弦线中点至拟合圆心的距离Azimuth_Tem1=PointMid.Azimuth+F*JDs(i).Flag*Application.Pi()/2'计算弦线中点至拟合圆心的方位角，入口段和出口段采用F符号标志修正PointO=Vector(PointMid,Length_R,Azimuth_Tem1)'计算拟合圆的圆心坐标PointO.Azimuth=ToAzimuth(PointA.X-PointO.X,PointA.Y-PointO.Y)'计算拟合圆的切向角（指向直线一端）'通过拟合圆的弧长求取缓圆差改正数（经长度改正的初始弧长更加准确）Angle_Tem=2*Atn(Length_C/Length_R/2)'计算拟合圆弧的转角Arc_Tem=2*JDs(i).Radius*Angle_Tem'计算拟合圆弧的弧长PL=(Arc_H-Arc_Tem)/Arc_Tem'计算弧长改正数'求取初始缓和曲线弧长Angle_Tem=Abs(GetAngle(PointO,J_X,J_Y))'计算加桩点转角Arc_Tem=2*JDs(i).Radius*Angle_Tem*(1+PL)'计算初始弧长'迭代计算加桩点在缓和曲线上的垂足点坐标C=0'迭代次数的计数器（避免进入死循环）PointTem=Curve(i,Arc_Tem,Model)'计算初始弧长下的初始坐标DoLength_R=Sqr((PointTem.X-J_X)^2+(PointTem.Y-J_Y)^2)'计算初始点至加桩点的长度Angle_Tem=GetAngle(PointTem,J_X,J_Y)'计算初始点至加桩点的切向夹角Angle_G=Application.Pi()/2-Abs(Angle_Tem)'计算初始点的改正角Arc_Tem=Arc_Tem+F*Length_R*Sin(Angle_G)'计算弧长改正数，并进行改正（入口段和出口段采用F符号标志修正）PointTem=Curve(i,Arc_Tem,Model)'计算改正弧长对应的改正坐标Tem=Tan(PointTem.Azimuth)*(PointTem.Y-J_Y)+(PointTem.X-J_X)'计算改正坐标位置的垂线方程残差C=C+1LoopWhileAbs(Tem)LIMITAndC=20'以限差LIMIT和至多20次的迭代次数为循环的判断条件PointVertical=PointTemArc=Arc_TemEndSub'坐标反算'1、本函数通过遍历所有的线路单元段，搜寻到偏移量最小的反算点即为最优解；'2、交点数组是全局变量，函数自由调用，因此函数无须输入曲线数据；'3、函数考虑了隧道的中心偏移量，并在最后修正(在搜寻最优反算点的过程中不进行修正)。PublicFunctionToPEG(J_XAsDouble,J_YAsDouble,ModelOfReturnAsString)DimPointVerticalAsPointDimPointOAsPointDimPEG_JAsDoubleD