?? 緩和曲線統(tǒng)一坐標(biāo).frm
字號(hào):
VERSION 5.00
Begin VB.Form frmtyzhb
BorderStyle = 1 'Fixed Single
Caption = "緩和曲線計(jì)算"
ClientHeight = 3780
ClientLeft = 45
ClientTop = 345
ClientWidth = 6090
Icon = "緩和曲線統(tǒng)一坐標(biāo).frx":0000
KeyPreview = -1 'True
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 3780
ScaleWidth = 6090
StartUpPosition = 2 '屏幕中心
Begin VB.CommandButton Command3
Caption = "關(guān)閉"
Height = 375
Left = 5040
TabIndex = 19
Top = 3360
Width = 975
End
Begin VB.CommandButton Command2
Caption = "曲線要素"
Height = 375
Left = 3960
TabIndex = 18
Top = 3360
Width = 975
End
Begin VB.CommandButton Command1
Caption = "加樁計(jì)算"
Height = 375
Left = 1320
TabIndex = 17
Top = 3360
Width = 975
End
Begin VB.Frame Frame4
Caption = "計(jì)算結(jié)果"
Height = 3255
Left = 2400
TabIndex = 15
Top = 0
Width = 3615
Begin VB.ListBox List1
Height = 2940
Left = 120
TabIndex = 16
Top = 240
Width = 3375
End
End
Begin VB.Frame Frame3
Caption = "加樁樁號(hào)"
Height = 615
Left = 0
TabIndex = 12
Top = 2640
Width = 2295
Begin VB.TextBox Text6
Height = 270
Left = 1200
TabIndex = 14
Text = "Text6"
Top = 240
Width = 975
End
Begin VB.Label Label6
Caption = "加樁樁號(hào)JZ＝"
Height = 255
Left = 120
TabIndex = 13
Top = 240
Width = 1215
End
End
Begin VB.Frame Frame2
Caption = "加樁間距"
Height = 615
Left = 0
TabIndex = 9
Top = 1920
Width = 2295
Begin VB.TextBox Text5
Height = 270
Left = 1200
TabIndex = 11
Text = "Text5"
Top = 240
Width = 975
End
Begin VB.Label Label5
Caption = "加樁間距Lj＝"
Height = 255
Left = 120
TabIndex = 10
Top = 240
Width = 1095
End
End
Begin VB.Frame Frame1
Caption = "原始數(shù)據(jù)"
Height = 1815
Left = 0
TabIndex = 0
Top = 0
Width = 2295
Begin VB.TextBox Text4
Height = 270
Left = 1200
TabIndex = 8
Text = "Text4"
Top = 1440
Width = 975
End
Begin VB.TextBox Text3
Height = 270
Left = 1200
TabIndex = 7
Text = "Text3"
Top = 1080
Width = 975
End
Begin VB.TextBox Text2
Height = 270
Left = 1200
TabIndex = 6
Text = "Text2"
Top = 720
Width = 975
End
Begin VB.TextBox Text1
Height = 270
Left = 1200
TabIndex = 5
Text = "Text1"
Top = 360
Width = 975
End
Begin VB.Label Label4
Caption = "緩和曲線LS＝"
Height = 255
Left = 120
TabIndex = 4
Top = 1440
Width = 1335
End
Begin VB.Label Label3
Caption = "偏角角度AL＝"
Height = 255
Left = 120
TabIndex = 3
Top = 1080
Width = 1215
End
Begin VB.Label Label2
Caption = "曲線半徑R ＝"
Height = 255
Left = 120
TabIndex = 2
Top = 720
Width = 1095
End
Begin VB.Label Label1
Caption = "交點(diǎn)樁號(hào)JD＝"
Height = 255
Left = 120
TabIndex = 1
Top = 360
Width = 1215
End
End
End
Attribute VB_Name = "frmtyzhb"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim zh As Single, hy As Single, qz As Single, yh As Single, hz As Single
Dim jd As Single, r As Single, al As Single, ls As Single
Dim hudu As Single, bt As Single
Dim th As Single, eh As Single, lh As Single
Dim p As Single, q As Single, jz As Single
Const pi = 3.1415927
Private Sub Command1_Click()
'加樁計(jì)算
On Error GoTo handlerror
jz = Val(Text6.Text)
If jz <= zh Then
x = jz - zh
y = 0
End If
If jz > zh And jz <= hy Then
l = jz - zh
x = l - l ^ 5 / 40 / r / r / ls / ls
y = l * l * l / 6 / r / ls - l ^ 7 / 336 / r / r / r / ls / ls / ls
End If
If jz > hy And jz <= yh Then
l = jz - hy
fi = l / r + bt
x = r * Sin(fi) + q
y = r * (1 - Cos(fi)) + p
End If
If jz > yh And jz <= hz Then
l = hz - jz
x1 = l - l ^ 5 / 40 / r / r / ls / ls
y1 = l * l * l / 6 / r / ls - l ^ 7 / 336 / r / r / r / ls / ls / ls
x = th * (1 + Cos(hudu)) - x1 * Cos(hudu) - y1 * Sin(hudu)
y = th * Sin(hudu) - x1 * Sin(hudu) + y1 * Cos(hudu)
End If
If jz > hz Then
x1 = jz - hz
y1 = 0
x = (1 + Cos(hudu)) * th + x1 * Cos(hudu)
y = (th + x1) * Sin(hudu)
End If
wb1 = "JZ＝" + Trim(Str(jz))
chdu = Len(wb1)
If chdu = 1 Then wb1 = wb1 + " "
If chdu = 2 Then wb1 = wb1 + " "
If chdu = 3 Then wb1 = wb1 + " "
If chdu = 4 Then wb1 = wb1 + " "
If chdu = 5 Then wb1 = wb1 + " "
If chdu = 6 Then wb1 = wb1 + " "
If chdu = 7 Then wb1 = wb1 + " "
If chdu = 8 Then wb1 = wb1 + " "
wb2 = wb1 + "X＝" + Trim(Str(Int(x * 1000 + 0.5) / 1000))
chdu = Len(wb2)
If chdu = 9 Then wb2 = wb2 + " "
If chdu = 10 Then wb2 = wb2 + " "
If chdu = 11 Then wb2 = wb2 + " "
If chdu = 12 Then wb2 = wb2 + " "
If chdu = 13 Then wb2 = wb2 + " "
If chdu = 14 Then wb2 = wb2 + " "
If chdu = 15 Then wb2 = wb2 + " "
If chdu = 16 Then wb2 = wb2 + " "
If chdu = 17 Then wb2 = wb2 + " "
If chdu = 18 Then wb2 = wb2 + " "
If chdu = 19 Then wb2 = wb2 + " "
If chdu = 20 Then wb2 = wb2 + ""
List1.AddItem wb2 + " Y＝" + Trim(Str(Int(y * 1000 + 0.5) / 1000))
Text6.Text = ""
Text6.SetFocus
Exit Sub
handlerror:
xiansh = MsgBox("在計(jì)算加樁時(shí)出錯(cuò)。", vbExclamation, "問題提示")
End Sub
Private Sub Command2_Click()
'曲線要素計(jì)算
On Error GoTo handlerror
jd = Val(Text1.Text)
r = Val(Text2.Text)
al = Abs(Val(Text3.Text))
du = Int(al)
fen = Int(al * 100) - du * 100
miao = al * 10000 - du * 10000 - fen * 100
hudu = (du + fen / 60 + miao / 60 / 60) * pi / 180
ls = Val(Text4.Text)
bt = ls / 2 / r
If hudu < 2 * bt Then
xiansh = MsgBox("請(qǐng)?jiān)龃笄€半徑或減少緩和曲線長。", vbExclamation, "問題提示")
Exit Sub
End If
p = ls * ls / 24 / r
q = ls / 2 - ls * ls * ls / 240 / r / r
th = (r + p) * Tan(hudu / 2) + q
lh = (hudu - 2 * bt) * r + 2 * ls
eh = (r + p) / Cos(hudu / 2) - r
zh = jd - th
hy = zh + ls
qz = zh + lh / 2
yh = zh + lh - ls
hz = zh + lh
List1.Clear
List1.AddItem "原始數(shù)據(jù)：－－－－－－－－－－"
List1.AddItem "交點(diǎn)樁號(hào)JD＝" + Str(jd)
List1.AddItem "曲線半徑R ＝" + Str(r)
List1.AddItem "偏角角度AL＝" + Str(al)
List1.AddItem "緩和曲線LS＝" + Str(ls)
List1.AddItem ""
List1.AddItem "曲線要素：－－－－－－－－－－"
List1.AddItem " P ＝" + Str(Int(p * 1000 + 0.5) / 1000)
List1.AddItem " Q ＝" + Str(Int(q * 1000 + 0.5) / 1000)
List1.AddItem " TH＝" + Str(Int(th * 1000 + 0.5) / 1000)
List1.AddItem " LH＝" + Str(Int(lh * 1000 + 0.5) / 1000)
List1.AddItem " EH＝" + Str(Int(eh * 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)
List1.AddItem ""
List1.AddItem "加樁坐標(biāo)：－－－－－－－－－－"
LJ = Val(Text5.Text)
If LJ = 0 Then
Exit Sub
End If
jz = Int(zh / LJ + 1) * LJ
Do While jz <= hz
If jz <= zh Then
x = jz - zh
y = 0
End If
If jz > zh And jz <= hy Then
l = jz - zh
x = l - l ^ 5 / 40 / r / r / ls / ls
y = l * l * l / 6 / r / ls - l ^ 7 / 336 / r / r / r / ls / ls / ls
End If
If jz > hy And jz <= yh Then
l = jz - hy
fi = l / r + bt
x = r * Sin(fi) + q
y = r * (1 - Cos(fi)) + p
End If
If jz > yh And jz <= hz Then
l = hz - jz
x1 = l - l ^ 5 / 40 / r / r / ls / ls
y1 = l * l * l / 6 / r / ls - l ^ 7 / 336 / r / r / r / ls / ls / ls
x = th * (1 + Cos(hudu)) - x1 * Cos(hudu) - y1 * Sin(hudu)
y = th * Sin(hudu) - x1 * Sin(hudu) + y1 * Cos(hudu)
End If
If jz > hz Then
x1 = jz - hz
y1 = 0
x = (1 + Cos(hudu)) * th + x1 * Cos(hudu)
y = (th + x1) * Sin(hudu)
End If
wb1 = "JZ＝" + Trim(Str(jz))
chdu = Len(wb1)
If chdu = 1 Then wb1 = wb1 + " "
If chdu = 2 Then wb1 = wb1 + " "
If chdu = 3 Then wb1 = wb1 + " "
If chdu = 4 Then wb1 = wb1 + " "
If chdu = 5 Then wb1 = wb1 + " "
If chdu = 6 Then wb1 = wb1 + " "
If chdu = 7 Then wb1 = wb1 + " "
If chdu = 8 Then wb1 = wb1 + " "
wb2 = wb1 + "X＝" + Trim(Str(Int(x * 1000 + 0.5) / 1000))
chdu = Len(wb2)
If chdu = 9 Then wb2 = wb2 + " "
If chdu = 10 Then wb2 = wb2 + " "
If chdu = 11 Then wb2 = wb2 + " "
If chdu = 12 Then wb2 = wb2 + " "
If chdu = 13 Then wb2 = wb2 + " "
If chdu = 14 Then wb2 = wb2 + " "
If chdu = 15 Then wb2 = wb2 + " "
If chdu = 16 Then wb2 = wb2 + " "
If chdu = 17 Then wb2 = wb2 + " "
If chdu = 18 Then wb2 = wb2 + " "
If chdu = 19 Then wb2 = wb2 + " "
If chdu = 20 Then wb2 = wb2 + ""
List1.AddItem wb2 + " Y＝" + Trim(Str(Int(y * 1000 + 0.5) / 1000))
jz = jz + LJ
Loop
Command1.Enabled = True
Text6.SetFocus
Exit Sub
handlerror:
xiansh = MsgBox("在計(jì)算曲線要素時(shí)出錯(cuò)，請(qǐng)檢查輸入的數(shù)據(jù)。", vbExclamation, "問題提示")
End Sub
Private Sub Command3_Click()
'關(guān)閉
On Error GoTo handlerror
If Text1.Text = "" And Text2.Text = "" And Text3.Text = "" And Text4.Text = "" Then
Unload Me
Exit Sub
End If
If List1.ListCount > 1 And rjsfzc = 88 Then
frmMain.Text1 = frmMain.Text1 & vbCrLf & ""
frmMain.Text1 = frmMain.Text1 & vbCrLf & " 緩和曲線統(tǒng)一坐標(biāo)計(jì)算結(jié)果："
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()
'啟動(dòng)
Text1.Text = ""
Text2.Text = ""
Text3.Text = ""
Text4.Text = ""
Text5.Text = ""
Text6.Text = ""
List1.Clear
List1.AddItem "偏角按度分秒輸入："
List1.AddItem "如32°23′19″按32.2319輸入"
List1.AddItem ""
List1.AddItem "本程序的X、Y是"
List1.AddItem "以ZH為原點(diǎn)的統(tǒng)一坐標(biāo)。"
Command1.Enabled = False
End Sub
?? 快捷鍵說明
復(fù)制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號(hào)
Ctrl + =
減小字號(hào)
Ctrl + -