📄 卵型曲线精解.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 + -