卵型曲线设计.frm

饮羽公路测设（glcs） 由20多个公路测量、设计、试验和施工组织设计等小软件组成。如《中桩大地坐标》可以计算不等长缓和曲线的中桩和边桩的大地坐标；《缓和曲线反算》可以根据切线长、外距长或缓和曲线长求

VERSION 5.00
Begin VB.Form frmlxqxsj 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "卵型曲线设计"
   ClientHeight    =   3555
   ClientLeft      =   45
   ClientTop       =   345
   ClientWidth     =   7155
   Icon            =   "卵型曲线设计.frx":0000
   KeyPreview      =   -1  'True
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   3555
   ScaleWidth      =   7155
   ShowInTaskbar   =   0   'False
   StartUpPosition =   2  '屏幕中心
   Begin VB.Frame Frame2 
      Caption         =   "计算结果"
      Height          =   3450
      Left            =   2760
      TabIndex        =   16
      Top             =   40
      Width           =   4335
      Begin VB.ListBox List1 
         Height          =   3120
         Left            =   120
         TabIndex        =   17
         Top             =   240
         Width           =   4095
      End
   End
   Begin VB.Frame Frame1 
      Caption         =   "原始数据"
      Height          =   2895
      Left            =   0
      TabIndex        =   9
      Top             =   40
      Width           =   2655
      Begin VB.TextBox Text7 
         Height          =   270
         Left            =   1440
         TabIndex        =   0
         Text            =   "Text7"
         Top             =   360
         Width           =   1095
      End
      Begin VB.TextBox Text6 
         Height          =   270
         Left            =   1440
         TabIndex        =   6
         Text            =   "Text6"
         Top             =   2520
         Width           =   1095
      End
      Begin VB.TextBox Text5 
         Height          =   270
         Left            =   1440
         TabIndex        =   5
         Text            =   "Text5"
         Top             =   2160
         Width           =   1095
      End
      Begin VB.TextBox Text1 
         Height          =   270
         Left            =   1440
         TabIndex        =   1
         Text            =   "Text1"
         ToolTipText     =   "如36°15′45″按36.1545输入"
         Top             =   720
         Width           =   1095
      End
      Begin VB.TextBox Text2 
         Height          =   270
         Left            =   1440
         TabIndex        =   2
         Text            =   "Text2"
         ToolTipText     =   "如36°15′45″按36.1545输入"
         Top             =   1080
         Width           =   1095
      End
      Begin VB.TextBox Text3 
         Height          =   270
         Left            =   1440
         TabIndex        =   3
         Text            =   "Text3"
         ToolTipText     =   "单位：m"
         Top             =   1440
         Width           =   1095
      End
      Begin VB.TextBox Text4 
         Height          =   270
         Left            =   1440
         TabIndex        =   4
         Text            =   "Text4"
         ToolTipText     =   "单位：m"
         Top             =   1800
         Width           =   1095
      End
      Begin VB.Label Label7 
         Caption         =   "交点桩号JDa  ＝"
         Height          =   255
         Left            =   120
         TabIndex        =   18
         Top             =   360
         Width           =   1455
      End
      Begin VB.Label Label6 
         Caption         =   "后缓和曲线LS2＝"
         Height          =   255
         Left            =   120
         TabIndex        =   15
         Top             =   2520
         Width           =   1575
      End
      Begin VB.Label Label4 
         Caption         =   "前曲线半径RA ＝"
         Height          =   255
         Left            =   120
         TabIndex        =   14
         Top             =   1800
         Width           =   1455
      End
      Begin VB.Label Label1 
         Caption         =   "偏角PJa      ＝"
         Height          =   255
         Left            =   120
         TabIndex        =   13
         Top             =   720
         Width           =   1455
      End
      Begin VB.Label Label2 
         Caption         =   "偏角PJb      ＝"
         Height          =   255
         Left            =   120
         TabIndex        =   12
         Top             =   1080
         Width           =   1455
      End
      Begin VB.Label Label3 
         Caption         =   "前缓和曲线LS1＝"
         Height          =   255
         Left            =   120
         TabIndex        =   11
         Top             =   2160
         Width           =   1455
      End
      Begin VB.Label Label5 
         Caption         =   "基线长度AB   ＝"
         Height          =   255
         Left            =   120
         TabIndex        =   10
         Top             =   1440
         Width           =   1455
      End
   End
   Begin VB.CommandButton Command2 
      Caption         =   "关闭"
      Height          =   375
      Left            =   1800
      TabIndex        =   8
      Top             =   3100
      Width           =   855
   End
   Begin VB.CommandButton Command1 
      Caption         =   "计算"
      Height          =   375
      Left            =   840
      TabIndex        =   7
      Top             =   3100
      Width           =   855
   End
End
Attribute VB_Name = "frmlxqxsj"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub Command1_Click()
'计算
    
    On Error GoTo handlerror
    
    jda = Val(Text7.Text)
    
    ja = Val(Text1.Text)
    sjwjs = ja
    Call dfmhhd
    pja = hudu
    
    jb = Val(Text2.Text)
    sjwjs = jb
    Call dfmhhd
    pjb = hudu
    
    pj = pja + pjb
    
    ab = Val(Text3.Text)
    RA = Val(Text4.Text)
    ls1 = Val(Text5.Text)
    ls2 = Val(Text6.Text)
    
    dp = 0
    l1 = RA * pja - ls1 / 2
    If l1 < 0 Then
        xianshi = MsgBox("前缓和曲线过长，重新输入LS1值", vbInformation, "问题提示")
        Text5.SelStart = 0
        Text5.SelLength = Len(Text5.Text)
        Text5.SetFocus
        Exit Sub
    End If
    
    pa = ls1 * ls1 / 24 / RA
    qa = ls1 / 2 - ls1 * ls1 * ls1 / 240 / RA / RA
    t1 = (RA + pa) * Tan(pja / 2)
    ta = t1 + qa
m4:
    t2 = ab - t1 - dp / Tan(pjb)
    A1 = 1
    b1 = -t2 / Tan(pjb / 2)
    c1 = ls2 * ls2 / 24
    Call yuecfc
    RB = x1
    If RB = 0 Then
        xianshi = MsgBox("后缓和曲线过长，重新输入LS2值", vbInformation, "问题提示")
        Text6.SelStart = 0
        Text6.SelLength = Len(Text6.Text)
        Text6.SetFocus
        Exit Sub
    End If
    
    l2 = RB * pjb - ls2 / 2
    If l2 < 0 Then
        xianshi = MsgBox("后缓和曲线过长，重新输入LS2值", vbInformation, "问题提示")
        Text6.SelStart = 0
        Text6.SelLength = Len(Text6.Text)
        Text6.SetFocus
        Exit Sub
    End If
    
    pb = ls2 * ls2 / 24 / RB
    qb = ls2 / 2 - ls2 * ls2 * ls2 / 240 / RB / RB
    t2 = (RB + pb) * Tan(pjb / 2)
    tb = t2 + qb - dp / Sin(pjb)
    pf = pb - pa - dp
    rf = RA * RB / Abs(RA - RB)
    lf = Sqr(24 * rf * Abs(pf))
    l1 = RA * pja - ls1 / 2 - lf / 2
    l2 = RB * pjb - ls2 / 2 - lf / 2
    If l1 > 0 And l2 > 0 Then GoTo m5
    f1 = lf + 2 * l1 - 0.01
    If l2 < l1 Then f1 = lf + 2 * l2 - 0.01
    pf = f1 * f1 / 24 / rf
    dp = pb - pa - pf * Sgn(pb - pa)
    GoTo m4
    
m5:
    lh = ls1 + l1 + lf + l2 + ls2
    
    zh = jda - ta
    hy = zh + ls1
    ha = hy + l1
    gq = ha + lf / 2
    hb = ha + lf
    yh = hb + l2
    hz = yh + ls2
    
    List1.Clear
    List1.AddItem ""
    List1.AddItem "    偏角    （°′″）PJa＝  " + Str(ja)
    List1.AddItem "    偏角    （°′″）PJb＝  " + Str(jb)
    List1.AddItem "    基线长度      （m）AB＝  " + Str(ab)
    List1.AddItem "    JDb位置调整值 （m）DP＝  " + Str(Int(dp * 1000 + 0.5) / 1000)
    List1.AddItem "    前圆曲线半径  （m）RA＝  " + Str(Int(RA * 1000 + 0.5) / 1000)
    List1.AddItem "    后圆曲线半径  （m）RB＝  " + Str(Int(RB * 1000 + 0.5) / 1000)
    List1.AddItem "    前缓和曲线长 （m）Ls1＝  " + Str(Int(ls1 * 1000 + 0.5) / 1000)
    List1.AddItem "    后缓和曲线长 （m）Ls2＝  " + Str(Int(ls2 * 1000 + 0.5) / 1000)
    List1.AddItem "    中间缓和曲线长（m）LF＝  " + Str(Int(lf * 1000 + 0.5) / 1000)
    List1.AddItem "    前切线长度    （m）TA＝  " + Str(Int(ta * 1000 + 0.5) / 1000)
    List1.AddItem "    后切线长度    （m）TB＝  " + Str(Int(tb * 1000 + 0.5) / 1000)
    List1.AddItem "    GQ点JDa距离   （m）T1＝  " + Str(Int(t1 * 1000 + 0.5) / 1000)
    List1.AddItem "    前圆曲线长   （m）Lya＝  " + Str(Int(l1 * 1000 + 0.5) / 1000)
    List1.AddItem "    后圆曲线长   （m）Lyb＝  " + Str(Int(l2 * 1000 + 0.5) / 1000)
    List1.AddItem "    平曲线全长    （m）Lh＝  " + Str(Int(lh * 1000 + 0.5) / 1000)
    
    List1.AddItem "    直缓点        （m）ZH＝  " + Str(Int(zh * 1000 + 0.5) / 1000)
    List1.AddItem "    缓圆点        （m）HY＝  " + Str(Int(hy * 1000 + 0.5) / 1000)
    List1.AddItem "    中间圆缓点   （m）YHa＝  " + Str(Int(ha * 1000 + 0.5) / 1000)
    List1.AddItem "    公切点        （m）GQ＝  " + Str(Int(gq * 1000 + 0.5) / 1000)
    List1.AddItem "    中间缓圆点   （m）YHb＝  " + Str(Int(hb * 1000 + 0.5) / 1000)
    List1.AddItem "    圆缓点        （m）YH＝  " + Str(Int(yh * 1000 + 0.5) / 1000)
    List1.AddItem "    缓直点        （m）HZ＝  " + Str(Int(hz * 1000 + 0.5) / 1000)
    
    
    Exit Sub
handlerror:
    xianshi = MsgBox("请检查输入的数据后再计算。", vbInformation, "问题提示")

End Sub

Private Sub Command2_Click()
'关闭
    
    On Error GoTo handlerror
    
    If List1.ListCount > 1 And rjsfzc = 88 Then
        frmMain.Text1 = frmMain.Text1 & vbCrLf & ""
        frmMain.Text1 = frmMain.Text1 & vbCrLf & "    十一、卵型平曲线设计计算结果："
        
        For i = 0 To List1.ListCount - 1
            frmMain.Text1 = frmMain.Text1 & vbCrLf & List1.List(i)
        Next i
        frmMain.Text1 = frmMain.Text1 & vbCrLf & "    --------------------------------------"
    End If
    
    Unload Me
    
    Exit Sub
handlerror:

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 = ""
    List1.Clear
    List1.AddItem "长度：米，角度：如36°15′45″按36.1545输入"
    

End Sub