道路中桩计算.frm

采用VB编写

        iZY = dblQZ \ 20 - dblZY \ 20
        iYZ = dblYZ \ 20 - dblQZ \ 20
        ReDim xZY#(iZY), yZY#(iZY), fZY#(iZY), lZY#(iZY), xYZ#(iYZ), yYZ#(iYZ), fYZ#(iYZ), lYZ#(iYZ)
        
        lZY(0) = 0: fZY(0) = 0: xZY(0) = 0: yZY(0) = 0     '直圆点到曲中点
        For i = 0 To iZY - 1
            lZY(i + 1) = ((i + 1) * 20 - (dblZY - (dblZY \ 20) * 20))
            fZY(i + 1) = lZY(i + 1) / dblR
            xZY(i + 1) = dblR * Sin(fZY(i + 1))
            yZY(i + 1) = dblR * (1 - Cos(fZY(i + 1)))
        Next i
        lYZ(0) = 0: fYZ(0) = 0: xYZ(0) = 0: yYZ(0) = 0     '曲中点到圆直点
        For i = 0 To iYZ - 1
            lYZ(i + 1) = ((iYZ - i - 1) * 20 + (dblYZ - (dblYZ \ 20) * 20))
            fYZ(i + 1) = lYZ(i + 1) / dblR
            xYZ(i + 1) = dblR * Sin(fYZ(i + 1))
            yYZ(i + 1) = dblR * (1 - Cos(fYZ(i + 1)))
        Next i
        '显示结果
        With MSFlexGrid1
            .Cols = 5
            .Rows = iZY + iYZ + 4
            
            '显示第一行
            .Row = 0
            .Col = 0: .Text = "桩号"
            .Col = 1: .Text = "Li"
            .Col = 2: .Text = "圆心角"
            .Col = 3: .Text = "Xi"
            .Col = 4: .Text = "Yi"
            '显示内容：数值保留2位小数，角度到秒
            .Row = 1: .Col = 0: .Text = "ZY " & SToZ(dblZY)      'ZY点
            .Col = 1: .Text = lZY(0): .Col = 2: .Text = fZY(0)
            .Col = 3: .Text = xZY(0): .Col = 4: .Text = yZY(0)
            For i = 1 To iZY                               'ZY-->QZ
                .Row = i + 1: .Col = 0: .Text = "+" & ((dblZY - (dblZY \ 1000) * 1000) \ 20 + i) * 20
                .Col = 1: .Text = Format(lZY(i), "0.00"): .Col = 2: .Text = Format(HuToDo(fZY(i)), "0.0000")
                .Col = 3: .Text = Format(xZY(i), "0.00"): .Col = 4: .Text = Format(yZY(i), "0.00")
            Next i
            .Row = iZY + 2: .Col = 0: .Text = "QZ " & SToZ(dblQZ)    'QZ点
            For i = 0 To iYZ - 1                              'QZ-->YZ
                .Row = i + iZY + 3: .Col = 0: .Text = "+" & ((dblQZ - (dblQZ \ 1000) * 1000) \ 20 + i + 1) * 20
                .Col = 1: .Text = Format(lYZ(i + 1), "0.00"): .Col = 2: .Text = Format(HuToDo(fYZ(i + 1)), "0.0000")
                .Col = 3: .Text = Format(xYZ(i + 1), "0.00"): .Col = 4: .Text = Format(yYZ(i + 1), "0.00")
            Next i
            .Row = iZY + iYZ + 3: .Col = 0: .Text = "YZ " & SToZ(dblYZ)  'YZ点
            .Col = 1: .Text = lYZ(0): .Col = 2: .Text = fYZ(0)
            .Col = 3: .Text = xYZ(0): .Col = 4: .Text = yYZ(0)
        End With
    ElseIf Check1.Value = 1 Then    '有缓和曲线
        '缓和曲线参数
        V = Val(txtV.Text)
        ls = 0.035 * V * V * V / dblR
        bet0 = ls / (2 * dblR)
        p = ls * ls / (24 * dblR)
        q = ls / 2 - ls * ls * ls / (240 * dblR * dblR)
        '缓和曲线元素
        Th = (dblR + p) * Tan(dblA / 2) + q
        Ly = dblR * (dblA - 2 * bet0)
        Lh = Ly + 2 * ls
        Eh = (dblR + p) / Cos(dblA / 2) - dblR
        Dh = 2 * Th - Lh
        '主点里程
        dblZH = dblJD - Th
        dblHY = dblZH + ls
        dblYH = dblHY + Ly
        dblHZ = dblYH + ls
        dblQZ = dblHZ - Lh / 2
        If Abs(dblJD - (dblQZ + Dh / 2)) > 0.000001 Then MsgBox "主点里程检核不合格！"
        '详细测设
        iZH = dblHY \ 20 - dblZH \ 20: iHY = dblQZ \ 20 - dblHY \ 20
        iYH = dblYH \ 20 - dblQZ \ 20: iHZ = dblHZ \ 20 - dblYH \ 20
        ReDim xZH#(iZH), yZH#(iZH), fZH#(iZH), lZH#(iZH), xHY#(iHY), yHY#(iHY), fHY#(iHY), lHY#(iHY)
        ReDim xYH#(iYH), yYH#(iYH), fYH#(iYH), lYH#(iYH), xHZ#(iHZ), yHZ#(iHZ), fHZ#(iHZ), lHZ#(iHZ)
        
        Dim templ#
        lZH(0) = 0: fZH(0) = 0: xZH(0) = 0: yZH(0) = 0     '直缓点到缓圆点
        For i = 0 To iZH - 1
            lZH(i + 1) = ((i + 1) * 20 - (dblZH - (dblZH \ 20) * 20))
            fZH(i + 1) = lZH(i + 1) / dblR
            xZH(i + 1) = lZH(i + 1) - lZH(i + 1) ^ 5 / (40 * dblR * dblR * ls * ls)
            yZH(i + 1) = lZH(i + 1) ^ 3 / (6 * dblR * ls)
        Next i
        lHY(0) = 0: fHY(0) = 0: xHY(0) = 0: yHY(0) = 0     '缓圆点到曲中点
        For i = 0 To iHY - 1
            lHY(i + 1) = ((i + iZH + 1) * 20 + (dblZH - (dblZH \ 20) * 20))
            fHY(i + 1) = lHY(i + 1) / dblR
            xHY(i + 1) = dblR * Sin(fHY(i + 1))
            yHY(i + 1) = dblR * (1 - Cos(fHY(i + 1)))
        Next i
        lYH(0) = 0: fYH(0) = 0: xYH(0) = 0: yYH(0) = 0     '曲中点到圆缓点
        For i = 0 To iYH - 1
            lYH(i + 1) = ((iYH - i) * 20 + (dblQZ - (dblQZ \ 20) * 20))
            fYH(i + 1) = lYH(i + 1) / dblR
            xYH(i + 1) = dblR * Sin(fYH(i + 1))
            yYH(i + 1) = dblR * (1 - Cos(fYH(i + 1)))
        Next i
        lHZ(0) = 0: fHZ(0) = 0: xHZ(0) = 0: yHZ(0) = 0     '圆缓点到缓直点
        For i = 0 To iHZ - 1
            lHZ(i + 1) = ((iHZ - i) * 20 - (dblHZ Mod 20))
            fHZ(i + 1) = lHZ(i + 1) / dblR
            xHZ(i + 1) = lHZ(i + 1) - lHZ(i + 1) ^ 5 / (40 * dblR * dblR * ls * ls)
            yHZ(i + 1) = lHZ(i + 1) ^ 3 / (6 * dblR * ls)
        Next i
        '显示结果
        With MSFlexGrid1
            .Cols = 5
            .Rows = iZH + iHY + iYH + iHZ + 6
            
            '显示第一行
            .Row = 0
            .Col = 0: .Text = "桩号"
            .Col = 1: .Text = "Li"
            .Col = 2: .Text = "圆心角"
            .Col = 3: .Text = "Xi"
            .Col = 4: .Text = "Yi"
            '显示内容：数值保留2位小数，角度到秒
            .Row = 1: .Col = 0: .Text = "ZH " & SToZ(dblZH)      'ZH点
            .Col = 1: .Text = lZH(0): .Col = 2: .Text = fZH(0)
            .Col = 3: .Text = xZH(0): .Col = 4: .Text = yZH(0)
            For i = 1 To iZH                                     'ZH-->HY
                .Row = i + 1: .Col = 0: .Text = "+" & ((dblZH - (dblZH \ 1000) * 1000) \ 20 + i) * 20
                .Col = 1: .Text = Format(lZH(i), "0.00"): .Col = 2: .Text = Format(HuToDo(fZH(i)), "0.00")
                .Col = 3: .Text = Format(xZH(i), "0.00"): .Col = 4: .Text = Format(yZH(i), "0.00")
            Next i
            .Row = iZH + 2: .Col = 0: .Text = "HY " & SToZ(dblHY) 'HY点
            For i = 1 To iHY                                    'YH-->QZ
                .Row = i + iZH + 2: .Col = 0: .Text = "+" & ((dblHY - (dblHY \ 1000) * 1000) \ 20 + i) * 20
                .Col = 1: .Text = Format(lHY(i), "0.00"): .Col = 2: .Text = Format(HuToDo(fHY(i)), "0.00")
                .Col = 3: .Text = Format(xHY(i), "0.00"): .Col = 4: .Text = Format(yHY(i), "0.00")
            Next i
            .Row = iZH + iHY + 3: .Col = 0: .Text = "QZ " & SToZ(dblQZ) 'QZ点
            For i = 1 To iYH                                      'QZ-->YH
                .Row = i + iZH + iHY + 3: .Col = 0: .Text = "+" & ((dblQZ - (dblQZ \ 1000) * 1000) \ 20 + i) * 20
                .Col = 1: .Text = Format(lYH(i), "0.00"): .Col = 2: .Text = Format(HuToDo(fYH(i)), "0.00")
                .Col = 3: .Text = Format(xYH(i), "0.00"): .Col = 4: .Text = Format(yYH(i), "0.00")
            Next i
            .Row = iZH + iHY + iYH + 4: .Col = 0: .Text = "YH " & SToZ(dblYH) 'YH点
            For i = 1 To iHZ                                       'YH-->HZ
                .Row = i + iZH + iHY + iYH + 4: .Col = 0: .Text = "+" & ((dblYH - (dblYH \ 1000) * 1000) \ 20 + i) * 20
                .Col = 1: .Text = Format(lHZ(i), "0.00"): .Col = 2: .Text = Format(HuToDo(fHZ(i)), "0.00")
                .Col = 3: .Text = Format(xHZ(i), "0.00"): .Col = 4: .Text = Format(yHZ(i), "0.00")
            Next i
            .Row = iZH + iHY + iYH + iHZ + 5: .Col = 0: .Text = "HZ " & SToZ(dblHZ) 'HZ点
            .Col = 1: .Text = lHZ(0): .Col = 2: .Text = fHZ(0)
            .Col = 3: .Text = xHZ(0): .Col = 4: .Text = yHZ(0)
        End With
    End If
End Sub

Private Sub cmdExit_Click()
    End
End Sub

'将里程桩号化为里程数值形式
Public Function ZToS(s As String) As Double
     Dim iPos%
     iPos = InStr(s, "+")
     ZToS = Val(Right(Left(s, iPos), iPos - 1) * 1000 + Mid(s, iPos + 1))
End Function

'里程数值化为里程桩号
Public Function SToZ(dbl#) As String
    Dim k%, m#
    k = dbl \ 1000
    m = dbl - k * 1000
    SToZ = "k" & Trim(Str(k)) & "+" & Trim(Str(m))
End Function

'弧度化为度.分秒的形式：输入弧度值，输出度.分秒（各占两位）
Public Function HuToDo(ByVal Hu As Double) As Single
    Dim du%, fen%, miao%
    
    Hu = Hu * 180 / PI
    
    du = Fix(Hu)
    Hu = (Hu - du) * 60
    fen = Fix(Hu)
    Hu = (Hu - fen) * 60
    miao = Fix(Hu + 0.5)
    If miao = 60 Then
        fen = fen + 1
        miao = 0
    End If
    
    HuToDo = du + fen / 100 + miao / 10000
End Function


'将度.分秒形式化为弧度：输入为度.分秒形式，输出为弧度
Public Function DoToHu(ByVal DoFenMiao As Double) As Single
    Dim du%, fen%, miao%, angle#
    
    du = Fix(DoFenMiao)
    DoFenMiao = (DoFenMiao - du) * 100
    fen = Fix(DoFenMiao)
    miao = (DoFenMiao - fen) * 100
    
    angle = du + fen / 60 + miao / 3600
    DoToHu = angle * PI / 180
End Function