📄 竖曲线计算.frm
字号:
VERSION 5.00
Begin VB.Form frmsqxjs
BorderStyle = 3 'Fixed Dialog
Caption = "竖曲线计算"
ClientHeight = 3915
ClientLeft = 45
ClientTop = 330
ClientWidth = 7275
Icon = "竖曲线计算.frx":0000
KeyPreview = -1 'True
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 3915
ScaleWidth = 7275
ShowInTaskbar = 0 'False
StartUpPosition = 2 '屏幕中心
Begin VB.CommandButton Command3
Caption = "加桩"
Height = 375
Left = 840
TabIndex = 8
Top = 3480
Width = 855
End
Begin VB.Frame Frame3
Caption = "加桩桩号"
Height = 735
Left = 0
TabIndex = 18
Top = 2640
Width = 2655
Begin VB.TextBox Text6
Height = 270
Left = 1200
TabIndex = 7
Text = "Text6"
Top = 360
Width = 1335
End
Begin VB.Label Label6
Caption = "加桩桩号JZ＝"
Height = 255
Left = 120
TabIndex = 19
Top = 360
Width = 1335
End
End
Begin VB.Frame Frame2
Caption = "计算结果"
Height = 3810
Left = 2760
TabIndex = 16
Top = 40
Width = 4455
Begin VB.ListBox List1
Height = 3480
Left = 120
TabIndex = 17
Top = 240
Width = 4215
End
End
Begin VB.Frame Frame1
Caption = "原始数据"
Height = 2535
Left = 0
TabIndex = 9
Top = 40
Width = 2655
Begin VB.TextBox Text7
Height = 270
Left = 1200
TabIndex = 5
Text = "Text7"
Top = 2160
Width = 1335
End
Begin VB.TextBox Text5
Height = 270
Left = 1200
TabIndex = 4
Text = "Text5"
Top = 1800
Width = 1335
End
Begin VB.TextBox Text4
Height = 270
Left = 1200
TabIndex = 3
Text = "Text4"
Top = 1440
Width = 1335
End
Begin VB.TextBox Text3
Height = 270
Left = 1200
TabIndex = 2
Text = "Text3"
Top = 1080
Width = 1335
End
Begin VB.TextBox Text1
Height = 270
Left = 1200
TabIndex = 0
Text = "Text1"
ToolTipText = "单位：m"
Top = 360
Width = 1335
End
Begin VB.TextBox Text2
Height = 270
Left = 1200
TabIndex = 1
Text = "Text2"
ToolTipText = "单位：m"
Top = 720
Width = 1335
End
Begin VB.Label Label7
Caption = "加桩间距 ＝"
Height = 255
Left = 120
TabIndex = 20
Top = 2160
Width = 1095
End
Begin VB.Label Label5
Caption = "竖曲线半径＝"
Height = 255
Left = 120
TabIndex = 15
Top = 1800
Width = 1335
End
Begin VB.Label Label4
Caption = "后段纵坡% ＝"
Height = 255
Left = 120
TabIndex = 14
Top = 1440
Width = 1215
End
Begin VB.Label Label3
Caption = "前段纵坡% ＝"
Height = 255
Left = 120
TabIndex = 13
Top = 1080
Width = 1095
End
Begin VB.Label Label1
Caption = "变坡点桩号＝"
Height = 255
Left = 120
TabIndex = 12
Top = 360
Width = 1335
End
Begin VB.Label Label2
Caption = "变坡点高程＝"
Height = 255
Left = 120
TabIndex = 11
Top = 720
Width = 1335
End
End
Begin VB.CommandButton Command2
Caption = "关闭"
Height = 375
Left = 1800
TabIndex = 10
Top = 3480
Width = 855
End
Begin VB.CommandButton Command1
Caption = "计算"
Height = 375
Left = 0
TabIndex = 6
Top = 3480
Width = 855
End
End
Attribute VB_Name = "frmsqxjs"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim Jd, hd, i1, i2, r, t, e, b, c, l As Double
Private Sub Command1_Click()
'计算
On Error GoTo handlerror
Text6.Visible = True
Jd = Val(Text1.Text) '变坡点桩号
hd = Val(Text2.Text) '变坡点高程
i1 = Val(Text3.Text) '前段纵坡%
i2 = Val(Text4.Text) '后段纵坡%
r = Val(Text5.Text) '竖曲线半径
If i2 - i1 > 0 Then r = -r '当I2-I1>0时，即竖曲线为凹形竖曲线时，半径取负值，改正值为负值。
t = (i1 - i2) * r / 200 '计算竖曲线切线长T
e = t * t / 2 / Abs(r) '计算竖曲线外距E
b = Jd - t '计算竖曲线起点桩号B
c = Jd + t '计算竖曲线终点桩号C
l = 2 * t '计算竖曲线长度L
Rem 以下是在列表框中输出计算结果
List1.Clear
List1.AddItem ""
List1.AddItem " ～～～～～～～曲线要素～～～～～～～"
List1.AddItem " 变坡点桩号 （m）JD＝ " + Str(Jd)
List1.AddItem " 变坡点高程 （m）HD＝ " + Str(hd)
List1.AddItem " 前段纵坡 （%）I1＝ " + Str(i1)
List1.AddItem " 后段纵坡 （%）I2＝ " + Str(i2)
List1.AddItem " 竖曲线半径 （m）R ＝ " + Str(Abs(r))
List1.AddItem " 曲线起点桩号 （m）ZY＝ " + Str(Int(b * 1000 + 0.5) / 1000)
List1.AddItem " 曲线终点桩号 （m）YZ＝ " + Str(Int(c * 1000 + 0.5) / 1000)
List1.AddItem " 切线长度 （m）T ＝ " + Str(Int(t * 1000 + 0.5) / 1000)
List1.AddItem " 外距长度 （m）E ＝ " + Str(Int(e * 1000 + 0.5) / 1000)
List1.AddItem " 曲线全长 （m）L ＝ " + Str(Int(l * 1000 + 0.5) / 1000)
List1.AddItem ""
List1.AddItem " －－－－－－－加桩坐标－－－－－－－"
LJ = Val(Text7.Text) '加桩间距
If LJ = 0 Then Exit Sub '加桩间距为0，则退出计算
mu = Int((c - b) / LJ + 0.5) + 1 '加桩距离已知的情况下，计算竖曲线内可以以加桩距离LJ的桩号的棵数
jz = Int(b / LJ + 0.5) * LJ '如果起点桩号不为整桩号，则取整桩号
For i = 1 To mu
If jz <= b Then '如果所求桩号小于起点桩号B，
x = hd - (Jd - jz) * i1 / 100 '所求桩号高程等于变坡点高程-（变坡点桩号-加桩桩号）*前纵坡度/ 100，即加桩桩号不在竖曲线内，在竖曲线起点桩号前，直接计算
End If
If b < jz And jz <= Jd Then '如果所求桩号在竖曲线起点和变坡点之间
x = hd - (Jd - jz) * i1 / 100 - (jz - b) * (jz - b) / 2 / r '计算所求桩号高程（含改正值），其中，(jz - b) * (jz - b) / 2 / r为计算改正值，(Jd - jz) * i1 / 100为计算加桩点不含改正值高程
End If
If Jd < jz And jz <= c Then '如果所求桩号在竖曲线变坡点和终点之间
x = hd - (Jd - jz) * i2 / 100 - (jz - c) * (jz - c) / 2 / r '计算所求桩号高程（含改正值），其中，(jz - c) * (jz - c) / 2 / r为计算改正值，hd - (Jd - jz) * i2 / 100 为计算加桩点不含改正值高程
End If
If jz > c Then '如果所求桩号大于起点桩号c，
x = hd - (Jd - jz) * i2 / 100 '直接计算加桩高程，即加桩桩号不在竖曲线内，在竖曲线终点外
End If
kge1 = ""
kong = " "
chdu1 = Len(jz)
For j = 6 To chdu1 Step -1
kge1 = kge1 + kong
Next j
List1.AddItem " 桩号 （m）JZ＝" + Str(jz) + kge1 + "高程 X=" + Str(Int(x * 1000 + 0.5) / 1000)
jz = jz + LJ
If jz > c Then Exit For '加桩桩号大于竖曲线终点桩号，退出循环
Next i
Text6.SetFocus
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 Command3_Click()
'加桩
On Error GoTo handlerror
jz = Val(Text6.Text)
If jz <= b Then
x = hd - (Jd - jz) * i1 / 100
End If
If b < jz And jz <= Jd Then
x = hd - (Jd - jz) * i1 / 100 - (jz - b) * (jz - b) / 2 / r
End If
If Jd < jz And jz <= c Then
x = hd - (Jd - jz) * i2 / 100 - (jz - c) * (jz - c) / 2 / r
End If
If jz > c Then
x = hd - (Jd - jz) * i2 / 100
End If
kge1 = ""
kong = " "
chdu1 = Len(jz)
For j = 6 To chdu1 Step -1
kge1 = kge1 + kong
Next j
List1.AddItem " 桩号 （m）JZ＝" + Str(jz) + kge1 + "高程 X=" + Str(Int(x * 1000 + 0.5) / 1000)
Text6.Text = ""
Text6.SetFocus
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 = Trim$(Str(20))
Text6.Visible = False
List1.Clear
List1.AddItem "长度、高程：米；上坡纵坡为正，下坡纵坡为负"
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -