?? 曲線反算.frm
字號:
List1.AddItem " 交點(diǎn)樁號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 " 交點(diǎn)樁號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 " 交點(diǎn)樁號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 " 交點(diǎn)樁號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("請檢查輸入的數(shù)據(jù)后再試試。", 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
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
?? 快捷鍵說明
復(fù)制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -