《EXCEL交点法线路正反算VB源码2(平曲线正反算).docx》由会员分享，可在线阅读，更多相关《EXCEL交点法线路正反算VB源码2(平曲线正反算).docx（7页珍藏版）》请在金锄头文库上搜索。
1、EXCEL交点法线路正反算VB源码2(平曲线正反算)Option Explicit坐标正算1、交点数组是全局变量，函数自由调用，因此函数无须输入曲线数据；2、如果输入了 Offset 参数，则不考虑隧道的中心偏移量；3、Offset 的输入与输出在本函数及本程序中均遵循左负右正原则。Public Function ToCoord(PEG_J As Double, Offset As Double, ModelOfReturn As String)Dim Point_J As PointDim Arc As DoubleDim Length_X As DoubleDim Position As
2、Integer判断曲线参数的有效性If N_JD JDs(N_JD + 1).pegZH Then 加桩点里程超出范围ToCoord = Out Of Range!Exit FunctionEnd If判断加桩点的位置Position = 0Do While PEG_J JDs(Position + 1).pegZH 最后一个JDs为线路的终点，以其pegZH属性存储终点里程Position = Position + 1 加桩点位于Position交点的ZH点（不包括）至Position+1交点的ZH点（包括）之间Loop加桩点位于起始直线段If Position = 0 ThenLength
3、_X = PEG_J - JDs(0).pegHZPoint_J = Vector(JDs(0).pointHZ, Length_X, JDs(0).pointHZ.Azimuth)Point_J.Azimuth = JDs(0).pointHZ.Azimuth加桩点位于其它交点段位置ElseIf PEG_J Application.Pi() 归化转角取值范围在-PI+PI之间Angle_P = Angle_P - Sgn(Angle_P) * 2 * Application.Pi()LoopGetAngle = Angle_PEnd Function计算缓和曲线段的加桩点弧长1、本函数采用对
4、缓和曲线的拟合圆曲线来计算初始弧长，在初始弧长的基础上迭代计算出加桩点的弧长；2、拟合圆曲线通过缓和曲线的两个端点（直缓点和缓圆点或圆缓点和缓直点），其半径取两倍的圆曲线半径；3、通过初始弧长的计算可以较大的提高函数的计算效率，一般45次迭代可算得比较精确的数据；4、函数直接读取全局变量中的曲线参数但需要给定交点的位置以及是入口段缓和曲线还是出口段缓和曲线；5、本函数仅在ToPEG函数中调用。Private Sub GetArc(J_X As Double, J_Y As Double, i As Integer, Model As String, ByRef PointVertical As
5、 Point, ByRef Arc As Double)Dim PointMid As PointDim PointO As PointDim PointA As PointDim PointB As PointDim PointTem As PointDim Arc_H As DoubleDim Length_C As DoubleDim Length_R As DoubleDim PL As DoubleDim Azimuth_Tem1 As DoubleDim Angle_Tem As DoubleDim Angle_G As DoubleDim G As DoubleDim Arc_T
6、em As DoubleDim Tem As DoubleDim F As IntegerDim C As IntegerIf LCase(Trim(Model) = front Then 如果是入口段缓和曲线PointA = JDs(i).pointZHPointB = JDs(i).pointHYArc_H = JDs(i).Lh1F = 1 符号标志，入口或出口曲线在计算中的修正，为了程序的统一和简洁ElseIf LCase(Trim(Model) = back Then 如果是出口段缓和曲线PointA = JDs(i).pointHZPointB = JDs(i).pointYHAr
7、c_H = JDs(i).Lh2F = -1End If求取拟合圆的圆心，其切向角指向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) 计算
8、弦线长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 - Poi
9、ntO.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 *
10、 (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 =
11、 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 + 1Loop While Abs(Tem) LIMIT And C Application.Pi() / 2) Then直线单元段的垂足点计算Tem = Cos(GetAngle
12、(JDs(i - 1).pointHZ, J_X, J_Y) * Sqr(J_X - JDs(i - 1).pointHZ.X) 2 + (J_Y - JDs(i - 1).pointHZ.Y) 2)PointVertical = Vector(JDs(i - 1).pointHZ, Tem, JDs(i - 1).pointHZ.Azimuth)PointVertical.Azimuth = JDs(i - 1).pointHZ.Azimuth 直线单元段的加桩点切向角沿直线方向不变垂足点有效性判断，以偏距小者为最优解Tem = Sgn(GetAngle(PointVertical, J_X
13、, J_Y) * Sqr(PointVertical.X - J_X) 2 + (PointVertical.Y - J_Y) 2) 加桩点偏距计算If Abs(Tem) Application.Pi() / 2) Then求取垂点和弧长Call GetArc(J_X, J_Y, i, Front, PointVertical, Arc)垂足点有效性判断，以偏距小者为最优解Tem = Sgn(GetAngle(PointVertical, J_X, J_Y) * Sqr(PointVertical.X - J_X) 2 + (PointVertical.Y - J_Y) 2) 加桩点偏距计算I
14、f Abs(Tem) Application.Pi() / 2) And JDs(i).Radius MIN * 100 Then (考虑了没有圆弧的情况)求取圆心坐标，其方向角指向HY点Azimuth_Tem1 = JDs(i).pointHY.Azimuth + JDs(i).Flag * Application.Pi() / 2PointO = Vector(JDs(i).pointHY, JDs(i).Radius, Azimuth_Tem1)PointO.Azimuth = Azimuth_Tem1 + Application.Pi()求取垂足点坐标Azimuth_Tem2 = To
15、Azimuth(J_X - PointO.X, J_Y - PointO.Y) 圆心指向加桩点的方位角PointVertical = Vector(PointO, JDs(i).Radius, Azimuth_Tem2) 计算垂足点坐标PointVertical.Azimuth = Azimuth_Tem2 + JDs(i).Flag * Application.Pi() / 2 计算垂足点切向角垂足点有效性判断，以偏距小者为最优解Tem = Sgn(GetAngle(PointVertical, J_X, J_Y) * Sqr(PointVertical.X - J_X) 2 + (Poin
16、tVertical.Y - J_Y) 2)If Abs(Tem) Application.Pi() / 2) Then求取垂点和弧长Call GetArc(J_X, J_Y, i, Back, PointVertical, Arc)垂足点有效性判断，以偏距小者为最优解Tem = Sgn(GetAngle(PointVertical, J_X, J_Y) * Sqr(PointVertical.X - J_X) 2 + (PointVertical.Y - J_Y) 2)If Abs(Tem) Application.Pi() / 2) Then直线单元段的垂足点计算Tem = Cos(GetAngle(JDs(N_JD).pointHZ, J_X, J_Y) * Sqr(J_X - JDs(N_J
