?? 卵型曲線精解.frm
字號:
VERSION 5.00
Begin VB.Form frmlxqxjj
BorderStyle = 3 'Fixed Dialog
Caption = "卵型曲線精解"
ClientHeight = 3795
ClientLeft = 45
ClientTop = 330
ClientWidth = 5310
Icon = "卵型曲線精解.frx":0000
KeyPreview = -1 'True
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 3795
ScaleWidth = 5310
ShowInTaskbar = 0 'False
StartUpPosition = 2 '屏幕中心
Begin VB.Frame Frame2
Caption = "計算結果"
Height = 2055
Left = 0
TabIndex = 12
Top = 1200
Width = 5295
Begin VB.ListBox List1
Height = 1680
Left = 120
TabIndex = 8
Top = 240
Width = 5055
End
End
Begin VB.Frame Frame1
Caption = "原始數據"
Height = 1095
Left = 0
TabIndex = 6
Top = 40
Width = 5295
Begin VB.OptionButton Option2
Caption = "S型曲線"
Height = 180
Left = 3960
TabIndex = 4
Top = 760
Width = 1095
End
Begin VB.OptionButton Option1
Caption = "卵型曲線"
Height = 255
Left = 2520
TabIndex = 3
Top = 760
Width = 1215
End
Begin VB.TextBox Text3
Height = 270
Left = 3960
TabIndex = 2
Text = "Text3"
ToolTipText = "單位：m"
Top = 360
Width = 1215
End
Begin VB.TextBox Text2
Height = 270
Left = 1080
TabIndex = 1
Text = "Text2"
ToolTipText = "單位：m"
Top = 720
Width = 1215
End
Begin VB.TextBox Text1
Height = 270
Left = 1080
TabIndex = 0
Text = "Text1"
ToolTipText = "單位：m"
Top = 360
Width = 1215
End
Begin VB.Label Label5
Caption = "兩圓最小間距D＝"
Height = 255
Left = 2520
TabIndex = 11
Top = 360
Width = 1455
End
Begin VB.Label Label2
Caption = "半徑RB ＝"
Height = 255
Left = 120
TabIndex = 10
Top = 720
Width = 1335
End
Begin VB.Label Label1
Caption = "半徑RA ＝"
Height = 255
Left = 120
TabIndex = 9
Top = 360
Width = 1335
End
End
Begin VB.CommandButton Command2
Caption = "關閉"
Height = 375
Left = 4320
TabIndex = 7
Top = 3360
Width = 975
End
Begin VB.CommandButton Command1
Caption = "計算"
Height = 375
Left = 3120
TabIndex = 5
Top = 3360
Width = 975
End
End
Attribute VB_Name = "frmlxqxjj"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub Command1_Click()
'計算
On Error GoTo handlerror
RA = Val(Text1.Text)
RB = Val(Text2.Text)
d = Val(Text3.Text)
If RA > RB Then 'r1大圓、r2小圓
r1 = RA
r2 = RB
End If
If RA < RB Then
r1 = RB
r2 = RA
End If
If Option1.Value = True Then
r1 = r1
End If
If Option2.Value = True Then
r1 = -r1
End If
m = 0
ap = 0
For i = 1 To 20
ap = a
a = ((4 * d * (2 * r1 - 2 * r2 - d) + 4 * m) / (1 / r2 - 1 / r1) / (1 / r1 - 1 / r2 + r1 / 3 / r2 / r2 - r2 / 3 / r1 / r1)) ^ (1 / 4)
k1 = a / r1
k2 = a / r2
dp = a * ((k1 ^ 3 - k2 ^ 3) / 24 - (k1 ^ 7 - k2 ^ 7) / 2688 + (k1611 - k2 ^ 11) / 506880 - (k1615 - k2 ^ 15) / 154828800 + (k1 ^ 19 - k2 ^ 19) / 70601932800#)
dq = a * ((k1 - k2) / 2 - (k1 ^ 5 - k2 ^ 5) / 240 + (k1 ^ 9 - k2 ^ 9) / 34560 - (k1 ^ 13 - k2 ^ 13) / 8386560 + (k1 ^ 17 - k2 ^ 17) / 3158507520#)
dp1 = dp - a * (k1 ^ 3 - k2 ^ 3) / 24
dq1 = dq - a * (k1 - k2) / 2
m = a * a * (1 / r1 - 1 / r2) * dq1 + dq1 * dq1 + 2 * (r1 - r2) * dp1 + dp * dp
If Abs(ap - a) < 0.001 Then Exit For
Next i
tao = Atn(-dq / (r1 - r2 + dp)) * 180 / pi
gm1 = tao - 90 * k1 * k1 / pi
gm2 = 90 * k2 * k2 / pi - tao
u = -dq / (r2 + d - r1)
ct = Atn(u / (1 - u * u)) * 180 / pi
List1.Clear
List1.AddItem ""
List1.AddItem " 半徑 （m） RA ＝ " + Str(RA)
List1.AddItem " 半徑 （m） RB ＝ " + Str(RB)
List1.AddItem " 兩圓最小距離 （m） D ＝ " + Str(d)
List1.AddItem " 緩和曲線參數 （m） A ＝ " + Str(Int(a * 1000 + 0.5) / 1000)
If Option1.Value = True Then
List1.AddItem " 中間緩和段角度（°）τ ＝ " + Str(Int(tao * 100000 + 0.5) / 100000)
List1.AddItem " 大圓夾角 （°）γ1＝ " + Str(Int(gm1 * 100000 + 0.5) / 100000)
List1.AddItem " 小圓夾角 （°）γ2＝ " + Str(Int(gm2 * 100000 + 0.5) / 100000)
End If
If Option2.Value = True Then
List1.AddItem " 緩和段夾角 （°）ε ＝ " + Str(Int(ct * 100000 + 0.5) / 100000)
End If
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 = ""
Option1.Value = True
List1.Clear
List1.AddItem "長度：米，角度：如36°15′45″按36.1545輸入"
End Sub
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -