📄 曲线反算.frm

📁 饮羽公路测设（glcs）由20多个公路测量、设计、试验和施工组织设计等小软件组成。如《中桩大地坐标》可以计算不等长缓和曲线的中桩和边桩的大地坐标；《缓和曲线反算》可以根据切线长、外距长或缓和曲线长求
💻 FRM
📖 第 1 页 / 共 2 页
字号:
上一页 12
        List1.AddItem "    交点桩号JD ＝" + Str(jd)
        List1.AddItem "    曲线偏角PJ ＝" + Str(alp)
        List1.AddItem "    曲线半径 R ＝" + Str(r)
        List1.AddItem "    缓和曲线Ls1＝" + Str(Int(ls1 * 1000 + 0.5) / 1000)
        List1.AddItem "    缓和曲线Ls2＝" + Str(Int(ls2 * 1000 + 0.5) / 1000)
        List1.AddItem "    切线长度Th1＝" + Str(Int(th1 * 1000 + 0.5) / 1000)
        List1.AddItem "    切线长度Th2＝" + Str(Int(th2 * 1000 + 0.5) / 1000)
        List1.AddItem "    曲线长度Lh ＝" + Str(Int(lh * 1000 + 0.5) / 1000)
        List1.AddItem "            ZH ＝" + Str(Int(zh * 1000 + 0.5) / 1000)
        List1.AddItem "            HY ＝" + Str(Int(hy * 1000 + 0.5) / 1000)
        List1.AddItem "            QZ ＝" + Str(Int(qz * 1000 + 0.5) / 1000)
        List1.AddItem "            YH ＝" + Str(Int(yh * 1000 + 0.5) / 1000)
        List1.AddItem "            HZ ＝" + Str(Int(hz * 1000 + 0.5) / 1000)
        
    End If
    
    If Option3.Value = True Then '已知R、Th求Ls
        r = Val(Text3.Text)
        th = Val(Text6.Text)
        p = 0
        v = 0
        ls1 = 0
        ls = 2 * (th - r * Tan(hud / 2))
        Do Until Abs(ls - ls1) <= 0.0001
            ls1 = ls
            p = ls * ls / 24 / r - ls * ls * ls * ls / 2688 / r / r / r
            v = ls * ls * ls / 240 / r / r
            q = ls / 2 - v
            ls = 2 * (th + v - (r + p) * Tan(hud / 2))
        Loop
        bt = ls / 2 / r
        p = ls * ls / 24 / r - ls * ls * ls * ls / 2688 / r / r / r
        q = ls / 2 - ls * ls * ls / 240 / r / r
        th = (r + p) * Tan(hud / 2) + q
        eh = (r + p) / Cos(hud / 2) - r
        If hud - 2 * bt < 0 Then
            xianshi = MsgBox("请加大曲线半径或减短缓和曲线", vbInformation, "问题提示")
            Exit Sub
        End If
        lh = (hud - 2 * bt) * r + 2 * ls
        
        zh = jd - th
        hy = zh + ls
        qz = zh + lh / 2
        yh = zh + lh - ls
        hz = zh + lh
        
        List1.Clear
        List1.AddItem "    交点桩号JD＝" + Str(jd)
        List1.AddItem "    曲线偏角PJ＝" + Str(alp)
        List1.AddItem "    曲线半径 R＝" + Str(r)
        List1.AddItem "    缓和曲线Ls＝" + Str(Int(ls * 1000 + 0.5) / 1000)
        List1.AddItem "    切线长度Th＝" + Str(Int(th * 1000 + 0.5) / 1000)
        List1.AddItem "    外距长度Eh＝" + Str(Int(eh * 1000 + 0.5) / 1000)
        List1.AddItem "    曲线长度Lh＝" + Str(Int(lh * 1000 + 0.5) / 1000)
        List1.AddItem "            ZH＝" + Str(Int(zh * 1000 + 0.5) / 1000)
        List1.AddItem "            HY＝" + Str(Int(hy * 1000 + 0.5) / 1000)
        List1.AddItem "            QZ＝" + Str(Int(qz * 1000 + 0.5) / 1000)
        List1.AddItem "            YH＝" + Str(Int(yh * 1000 + 0.5) / 1000)
        List1.AddItem "            HZ＝" + Str(Int(hz * 1000 + 0.5) / 1000)
        
    End If
    
    If Option4.Value = True Then '已知Ls、Th求R
        ls = Val(Text4.Text)
        th = Val(Text6.Text)
        r1 = 0
        r = (th - ls / 2) / Tan(hud / 2)
        Do Until Abs(r - r1) <= 0.0001
            r1 = r
            p = ls * ls / 24 / r - ls * ls * ls * ls / 2688 / r / r / r
            v = ls * ls * ls / 240 / r / r
            q = ls / 2 - v
            r = (th - q) / Tan(hud / 2) - p
        Loop
        bt = ls / 2 / r
        p = ls * ls / 24 / r - ls * ls * ls * ls / 2688 / r / r / r
        q = ls / 2 - ls * ls * ls / 240 / r / r
        th = (r + p) * Tan(hud / 2) + q
        eh = (r + p) / Cos(hud / 2) - r
        If hud - 2 * bt < 0 Then
            xianshi = MsgBox("请加大曲线半径或减短缓和曲线", vbInformation, "问题提示")
            Exit Sub
        End If
        lh = (hud - 2 * bt) * r + 2 * ls
        
        zh = jd - th
        hy = zh + ls
        qz = zh + lh / 2
        yh = zh + lh - ls
        hz = zh + lh
        
        List1.Clear
        List1.AddItem "    交点桩号JD＝" + Str(jd)
        List1.AddItem "    曲线偏角PJ＝" + Str(alp)
        List1.AddItem "    曲线半径 R＝" + Str(Int(r * 1000 + 0.5) / 1000)
        List1.AddItem "    缓和曲线Ls＝" + Str(Int(ls * 1000 + 0.5) / 1000)
        List1.AddItem "    切线长度Th＝" + Str(Int(th * 1000 + 0.5) / 1000)
        List1.AddItem "    外距长度Eh＝" + Str(Int(eh * 1000 + 0.5) / 1000)
        List1.AddItem "    曲线长度Lh＝" + Str(Int(lh * 1000 + 0.5) / 1000)
        List1.AddItem "            ZH＝" + Str(Int(zh * 1000 + 0.5) / 1000)
        List1.AddItem "            HY＝" + Str(Int(hy * 1000 + 0.5) / 1000)
        List1.AddItem "            QZ＝" + Str(Int(qz * 1000 + 0.5) / 1000)
        List1.AddItem "            YH＝" + Str(Int(yh * 1000 + 0.5) / 1000)
        List1.AddItem "            HZ＝" + Str(Int(hz * 1000 + 0.5) / 1000)
        
    End If
    
    If Option5.Value = True Then '已知Ls、Eh求R
        ls = Val(Text4.Text)
        eh = Val(Text8.Text)
        r1 = 0
        r = eh / (1 / Cos(hud / 2) - 1)
        Do Until Abs(r - r1) <= 0.0001
            r1 = r
            p = ls * ls / 24 / r - ls * ls * ls * ls / 2688 / r / r / r
            v = ls * ls * ls / 240 / r / r
            q = ls / 2 - v
            r = (eh - p / Cos(hud / 2)) / (1 / Cos(hud / 2) - 1)
        Loop
        bt = ls / 2 / r
        p = ls * ls / 24 / r - ls * ls * ls * ls / 2688 / r / r / r
        q = ls / 2 - ls * ls * ls / 240 / r / r
        th = (r + p) * Tan(hud / 2) + q
        eh = (r + p) / Cos(hud / 2) - r
        If hud - 2 * bt < 0 Then
            xianshi = MsgBox("请加大曲线半径或减短缓和曲线", vbInformation, "问题提示")
            Exit Sub
        End If
        lh = (hud - 2 * bt) * r + 2 * ls
        
        zh = jd - th
        hy = zh + ls
        qz = zh + lh / 2
        yh = zh + lh - ls
        hz = zh + lh
        
        List1.Clear
        List1.AddItem "    交点桩号JD＝" + Str(jd)
        List1.AddItem "    曲线偏角PJ＝" + Str(alp)
        List1.AddItem "    曲线半径 R＝" + Str(Int(r * 1000 + 0.5) / 1000)
        List1.AddItem "    缓和曲线Ls＝" + Str(Int(ls * 1000 + 0.5) / 1000)
        List1.AddItem "    切线长度Th＝" + Str(Int(th * 1000 + 0.5) / 1000)
        List1.AddItem "    外距长度Eh＝" + Str(Int(eh * 1000 + 0.5) / 1000)
        List1.AddItem "    曲线长度Lh＝" + Str(Int(lh * 1000 + 0.5) / 1000)
        List1.AddItem "            ZH＝" + Str(Int(zh * 1000 + 0.5) / 1000)
        List1.AddItem "            HY＝" + Str(Int(hy * 1000 + 0.5) / 1000)
        List1.AddItem "            QZ＝" + Str(Int(qz * 1000 + 0.5) / 1000)
        List1.AddItem "            YH＝" + Str(Int(yh * 1000 + 0.5) / 1000)
        List1.AddItem "            HZ＝" + Str(Int(hz * 1000 + 0.5) / 1000)
        
    End If
        
        num = Int((hz - zh) / LJ + 0.5)
        qd = Int(zh / LJ) * LJ + LJ
        List1.AddItem "    --------加桩计算--------"
        
        For i = 1 To num
            jz = qd
            If Len(Trim(Str(jz))) = 1 Then kg1 = "     "
            If Len(Trim(Str(jz))) = 2 Then kg1 = "    "
            If Len(Trim(Str(jz))) = 3 Then kg1 = "  "
            If Len(Trim(Str(jz))) = 4 Then kg1 = " "
            Call zhjjs
            
            x = Int(x * 1000 + 0.5) / 1000
            y = Int(y * 1000 + 0.5) / 1000
            If Len(Trim(Str(x))) = 1 Then kg2 = "        "
            If Len(Trim(Str(x))) = 2 Then kg2 = "       "
            If Len(Trim(Str(x))) = 3 Then kg2 = "      "
            If Len(Trim(Str(x))) = 4 Then kg2 = "     "
            If Len(Trim(Str(x))) = 5 Then kg2 = "    "
            If Len(Trim(Str(x))) = 6 Then kg2 = "   "
            If Len(Trim(Str(x))) = 7 Then kg2 = "  "
            If Len(Trim(Str(x))) = 8 Then kg2 = " "
            
            List1.AddItem "    JZ＝" + Trim(Str(jz)) + kg1 + "X＝" + Trim(Str(x)) + kg2 + "Y＝" + Trim(Str(y))
            qd = qd + LJ
        Next i
    
    
    Exit Sub
handlerror:
    xianshi = MsgBox("请检查输入的数据后再试试。", vbInformation, "问题提示")

End Sub

Private Sub Form_KeyPress(KeyAscii As Integer)
'Esc键退出，VbEscape可以用27代替
    On Error GoTo handlerror

    If KeyAscii = 27 Then
        Unload Me
    End If
    
    Exit Sub
handlerror:

End Sub

Private Sub Form_Load()
'启动

    Text1.Text = ""
    Text2.Text = ""
    Text3.Text = ""
    Text4.Text = ""
    Text5.Text = ""
    Text6.Text = ""
    Text7.Text = ""
    Text8.Text = ""
    Text9.Text = ""
    List1.Clear
    
    List1.AddItem "单位长度为：m"
    List1.AddItem "    角度为：°′″"
    List1.AddItem "如32°12′45″按32.1245输入"

End Sub

Private Sub Option1_Click()
'凸型对称

    Label3.Visible = True
    Label4.Visible = False
    Label5.Visible = False
    Label6.Visible = False
    Label7.Visible = False
    Label8.Visible = False
    
    Text3.Visible = True
    Text4.Visible = False
    Text5.Visible = False
    Text6.Visible = False
    Text7.Visible = False
    Text8.Visible = False

End Sub



Public Sub zhjjs()
'曲线支距计算子程序

    If jz <= zh Then
        x = zh - jz
        y = 0
    End If
    If zh <= jz And jz <= hy Then
        If Option2.Value = True Then ls = ls1
        l = jz - zh
        x = l - l ^ 5 / 40 / r / r / ls / ls + l ^ 9 / 3456 / r ^ 4 / ls ^ 4
        y = l ^ 3 / 6 / r / ls - l ^ 7 / 336 / r ^ 3 / ls ^ 3
    End If
    If hy < jz And jz <= qz Then
        If Option2.Value = True Then bt = bt1: p = p1: q = q1
        l = jz - hy
        gam = l / r + bt
        x = r * Sin(gam) + q
        y = r * (1 - Cos(gam)) + p
    End If
    If qz < jz And jz <= yh Then
        If Option2.Value = True Then bt = bt2: p = p2: q = q2
        l = yh - jz
        gam = l / r + bt
        x = r * Sin(gam) + q
        y = r * (1 - Cos(gam)) + p
    End If
    If yh < jz And jz <= hz Then
        If Option2.Value = True Then ls = ls2
        l = hz - jz
        x = l - l ^ 5 / 40 / r / r / ls / ls + l ^ 9 / 3456 / r ^ 4 / ls ^ 4
        y = l ^ 3 / 6 / r / ls - l ^ 7 / 336 / r ^ 3 / ls ^ 3
    End If
    If hz < jz Then
        x = jz - hz
        y = 0
    End If

End Sub

Private Sub Option2_Click()
'凸型非对称

    Label3.Visible = True
    Label4.Visible = True
    Label5.Visible = False
    Label6.Visible = False
    Label7.Visible = False
    Label8.Visible = False
    
    Text3.Visible = True
    Text4.Visible = True
    Text5.Visible = False
    Text6.Visible = False
    Text7.Visible = False
    Text8.Visible = False

End Sub

Private Sub Option3_Click()
'已知R、Th求Ls
    
    Label3.Visible = True
    Label4.Visible = False
    Label5.Visible = False
    Label6.Visible = True
    Label7.Visible = False
    Label8.Visible = False
    
    Text3.Visible = True
    Text4.Visible = False
    Text5.Visible = False
    Text6.Visible = True
    Text7.Visible = False
    Text8.Visible = False

End Sub

Private Sub Option4_Click()
'已知Ls、Th求R
    
    Label3.Visible = False
    Label4.Visible = True
    Label5.Visible = False
    Label6.Visible = True
    Label7.Visible = False
    Label8.Visible = False
    
    Text3.Visible = False
    Text4.Visible = True
    Text5.Visible = False
    Text6.Visible = True
    Text7.Visible = False
    Text8.Visible = False

End Sub

Private Sub Option5_Click()
'已知Ls、Eh求R
    
    Label3.Visible = False
    Label4.Visible = True
    Label5.Visible = False
    Label6.Visible = False
    Label7.Visible = False
    Label8.Visible = True
    
    Text3.Visible = False
    Text4.Visible = True
    Text5.Visible = False
    Text6.Visible = False
    Text7.Visible = False
    Text8.Visible = True

End Sub
上一页 12
💿 文件大小 439 K
👤 上传用户 kelvinitc
📂 所属分类数学计算
🏷️ 相关标签

#glcs #缓和曲线 #路测 #公路测量
⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -