📄 frmoptionxhdla.frm
字号:
VERSION 5.00
Begin VB.Form FrmOptionxhdla
Caption = "选择带型、小带轮直径、中心距"
ClientHeight = 4800
ClientLeft = 60
ClientTop = 450
ClientWidth = 7275
LinkTopic = "Form1"
ScaleHeight = 4800
ScaleWidth = 7275
StartUpPosition = 3 '窗口缺省
Begin VB.PictureBox Picture1
Height = 4935
Left = 120
ScaleHeight = 4875
ScaleWidth = 6915
TabIndex = 0
Top = 120
Width = 6975
Begin VB.CommandButton cmdEnd
Caption = "结 束"
Height = 495
Left = 4560
TabIndex = 14
Top = 3720
Width = 1215
End
Begin VB.CommandButton cmdReturn
Caption = "后 退"
Height = 495
Left = 2760
TabIndex = 13
Top = 3720
Width = 1215
End
Begin VB.CommandButton cmdContinue
Caption = "确 认"
Height = 495
Left = 960
TabIndex = 12
Top = 3720
Width = 1215
End
Begin VB.PictureBox Picdla
Height = 3015
Left = 2880
ScaleHeight = 2955
ScaleWidth = 3915
TabIndex = 2
Top = 240
Width = 3975
Begin VB.HScrollBar Hsba
Height = 255
Left = 1800
TabIndex = 11
Top = 1920
Width = 2055
End
Begin VB.TextBox Txta
Height = 270
Left = 2040
TabIndex = 10
Top = 1680
Width = 1575
End
Begin VB.HScrollBar Hsbdl
Height = 255
Left = 1800
Max = 0
TabIndex = 8
Top = 720
Width = 2055
End
Begin VB.TextBox Txtdl
Height = 270
Left = 2040
TabIndex = 7
Top = 480
Width = 1575
End
Begin VB.Label lbla
Caption = "请选择中心距："
Height = 495
Left = 120
TabIndex = 9
Top = 1680
Width = 1575
End
Begin VB.Label Lbldl
Caption = "请选择小带轮直径："
Height = 375
Left = 120
TabIndex = 6
Top = 480
Width = 1695
End
End
Begin VB.PictureBox Picxh
Height = 975
Left = 120
ScaleHeight = 915
ScaleWidth = 2115
TabIndex = 1
Top = 960
Width = 2175
Begin VB.Label Lblxh2
BorderStyle = 1 'Fixed Single
Height = 255
Left = 1200
TabIndex = 5
Top = 480
Width = 855
End
Begin VB.Label Lblxh1
BorderStyle = 1 'Fixed Single
Height = 255
Left = 1200
TabIndex = 4
Top = 120
Width = 855
End
Begin VB.Label Lblxh
Caption = "请选择型号："
Height = 375
Left = 120
TabIndex = 3
Top = 240
Width = 1095
End
End
End
End
Attribute VB_Name = "FrmOptionxhdla"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Option Base 1
Public optionxh As Integer
Private Sub cmdContinue_Click()
Dim a0 As Single '定义几个临时变量
Dim df0 As Single
If optionxh <> 1 And optionxh <> 2 Then MsgBox "请选择型号！": Exit Sub
dd1 = Val(Txtdl.Text) '接收用户输入的小带轮直径（初值）
a0 = Val(Txta.Text) '接收用户输入的中心距（初值）
If dd1 < Hsbdl.Min Or dd1 > (Hsbdl.Max) * 1.5 Or xh1 = "" Then MsgBox ("小带轮直径选择不正确，请重新选择"): Exit Sub
If a0 < Hsbdl.Min Then MsgBox "中心距选择不合适，请重新选择": Exit Sub
Call beltd(dd1)
dd2 = si * dd1
Call beltd(dd2)
sis = dd2 / dd1
sis = Int(sis * 100) / 100
dlti = Str$(Int((sis - si) / si * 100)) & "%"
Call power1
Call beltKL(a0) '调用beltKL 过程，查普通V带长度系数kL
Call kalf1
v1 = n1 * dd1 * 3.1415 / 60 / 1000
v1 = Int(v1 * 100) / 100
Call beltdp1 '调用beltdp1过程，查单根V带的额定功率值的增量dp1
Call beltsize(df0) '调用beltsize过程，查带的截面尺寸和带的初拉力增量df0
z = Pd / (p1 + dp1) / kalf / kL
f0 = 500 * (2.5 - kalf) * Pd / kalf / z / v1 + q * v1 ^ 2
f0 = Int(f0 * 100) / 100
fz = 2 * z * f0 * Sin(x1 / 2 * 3.14159 / 180)
fz = Int(fz * 100) / 100
g = (f0 + df0) / 16
g = Int(g * 100) / 100
FrmbeltDisply.Visible = True
FrmbeltDisply.Lbldisply(0).Caption = xh1
FrmbeltDisply.Lbldisply(1).Caption = z
FrmbeltDisply.Lbldisply(2).Caption = Ld
FrmbeltDisply.Lbldisply(3).Caption = dd1
FrmbeltDisply.Lbldisply(4).Caption = dd2
FrmbeltDisply.Lbldisply(5).Caption = a
FrmbeltDisply.Lbl2(0).Caption = sis
FrmbeltDisply.Lbl2(1).Caption = v1
FrmbeltDisply.Lbl2(2).Caption = x1
FrmbeltDisply.Lbl2(3).Caption = kL
FrmbeltDisply.Lbl2(4).Caption = kalf
FrmbeltDisply.Lbl2(5).Caption = ka
FrmbeltDisply.Lbl4(0).Caption = f0
FrmbeltDisply.Lbl4(1).Caption = fz
FrmbeltDisply.Lbl4(2).Caption = p1
FrmbeltDisply.Lbl4(3).Caption = dp1
FrmbeltDisply.Lbl4(4).Caption = g
FrmbeltDisply.Lbl4(5).Caption = dlti
FrmbeltDisply.Label1(0).Caption = spower
FrmbeltDisply.Label1(1).Caption = Pd
FrmbeltDisply.Label1(2).Caption = n1
Call FrmbeltDisply.Cmddisplysize_Click '调用下一个窗体“frmbeltDisply”的
'“cmddisplysize_Click”过程
FrmOptionxhdla.Visible = False
End Sub
Private Sub CmdEnd_Click()
End
End Sub
Private Sub CmdReturn_Click()
Frmbelt.Visible = True
FrmOptionxhdla.Visible = False
Lblxh1.BackColor = &H8000000B
Lblxh2.BackColor = &H8000000B
End Sub
Private Sub Form_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then Call cmdContinue_Click
End Sub
Private Sub Hsba_Change()
Txta.Text = Hsba.Value
End Sub
Private Sub Hsbdl_Change()
Txtdl.Text = Hsbdl.Value
End Sub
Private Sub Lblxh1_Click()
Picdla.Visible = True
optionxh = 1
xh1 = Lblxh1.Caption
Lblxh1.BackColor = vbWhite
Lblxh2.BackColor = &H8000000B
Hsbdl.Min = Val(Left(dl(1), 3))
Hsbdl.Max = Val(Right(dl(1), 3))
Hsbdl.LargeChange = 10
Hsbdl.SmallChange = 1
Hsbdl.Value = Int((Hsbdl.Min + Hsbdl.Max) / 2)
Lbldl.Caption = "小带轮直径范围：" & Str$(Hsbdl.Min) & "--" & Str$(Hsbdl.Max)
lbla.Caption = "推荐中心距范围：" & Str$(Int((Hsbdl.Min + Hsbdl.Max) / 2 * (1 + si) * 0.7)) & "--" & Str$(Int((Hsbdl.Min + Hsbdl.Max) / 2 * (1 + si) * 2))
Hsba.Min = Int((Hsbdl.Min + Hsbdl.Max) / 2 * (1 + si) * 0.7)
Hsba.Max = Int((Hsbdl.Min + Hsbdl.Max) / 2 * (1 + si) * 2)
Hsba.LargeChange = 10
Hsba.SmallChange = 1
Hsba.Value = Int((Hsba.Min + Hsba.Max) / 2)
Txtdl.Text = Hsbdl.Value
Txta.Text = Hsba.Value
End Sub
Private Sub Lblxh2_Click()
Lblxh1.BackColor = &H8000000B
Lblxh2.BackColor = vbWhite
optionxh = 2
Picdla.Visible = True
xh1 = Lblxh2.Caption
Hsbdl.Min = Val(Left(dl(2), 3))
Hsbdl.Max = Val(Right(dl(2), 3))
Hsbdl.LargeChange = 10
Hsbdl.SmallChange = 1
Hsbdl.Value = Int((Hsbdl.Min + Hsbdl.Max) / 2)
Lbldl.Caption = "小带轮直径范围：" & Str$(Hsbdl.Min) & "--" & Str$(Hsbdl.Max)
lbla.Caption = "推荐中心距范围：" & Str$(Int((Hsbdl.Min + Hsbdl.Max) / 2 * (1 + si) * 0.7)) & "--" & Str$(Int((Hsbdl.Min + Hsbdl.Max) / 2 * (1 + si) * 2))
Hsba.Min = Int((Hsbdl.Min + Hsbdl.Max) / 2 * (1 + si) * 0.7)
Hsba.Max = Int((Hsbdl.Min + Hsbdl.Max) / 2 * (1 + si) * 2)
Hsba.LargeChange = 10
Hsba.SmallChange = 1
Hsba.Value = Int((Hsba.Min + Hsba.Max) / 2)
Txtdl.Text = Hsbdl.Value
Txta.Text = Hsba.Value
End Sub
Sub beltd(ddd As Single) '功能：确定带轮标准直径，并计算传动比和传动比误差
'数据文件b10-11z.dat,b10-11a.dat,b10-11b.dat,b10-11c.dat,b10-11d.dat,b10-11e.dat
'存储Z,A,B,C,D,E带轮直径系列
Dim m As Integer '循环变量的上界m
Dim dd(29) '存储标准带轮直径的数组dd
Dim i As Integer '循环变量i
Dim dc As Single 'dc存储ddd与标准直径dd()的差值
xh1 = UCase(xh1) 'xh1转化成大写字母
Close
If xh1 = "Z" Then
m = 24
Open App.Path + "\b10-11z.dat" For Input As #1
For i = 1 To m
Input #1, dd(i)
Next i
Close #1
ElseIf xh1 = "A" Then
m = 28
Open App.Path + "\b10-11a.dat" For Input As #1
For i = 1 To m
Input #1, dd(i)
Next i
Close #1
ElseIf xh1 = "B" Then
m = 25
Open App.Path + "\b10-11b.dat" For Input As #1
For i = 1 To m
Input #1, dd(i)
Next i
Close #1
ElseIf xh1 = "C" Then
m = 27
Open App.Path + "\b10-11c.dat" For Input As #1
For i = 1 To m
Input #1, dd(i)
Next i
Close #1
ElseIf xh1 = "D" Then
m = 23
Open App.Path + "\b10-11d.dat" For Input As #1
For i = 1 To m
Input #1, dd(i)
Next i
Close #1
ElseIf xh1 = "E" Then
m = 17
Open App.Path + "\b10-11e.dat" For Input As #1
For i = 1 To m
Input #1, dd(i)
Next i
Close #1
End If
For i = 1 To m - 1
If ddd <= dd(i) Then Exit For
Next i
If i = 1 Then i = i + 1
If Abs(ddd - dd(i - 1)) <= Abs(ddd - dd(i)) Then
ddd = dd(i - 1)
Else
ddd = dd(i)
End If
End Sub
Private Sub power1()
Rem 输入参数：型号xh1
Rem 输入参数：小带轮直径dd1
Rem 输入参数：单根带基本额定功率p1
'数据文件b10-6z.dat,b10-6a.dat,b10-6b.dat,b10-6c.dat,b10-6d.dat,b10-6e.dat
'存储Z,A,B,C,D,E型号的小带轮直径、传递功率。
Dim belttype '存储带型号系列
Dim nn1, nn2, nn3, nn4, nn5, nn6
Dim d(7, 8) '第一维是带型号，第二维是小带轮直径
Dim n(7, 18)
Dim p(7, 8, 18) '第一维是带型号，第二维是小带轮直径，第三维是功率
Dim x As Integer
Dim y As Integer
Dim j As Integer
Dim p11 '临时功率变量p11，p12，p13，用来差值计算
Dim p12
Dim p13
belttype = Array("Z", "A", "B", "C", "D", "E")
nn1 = Array(200, 400, 700, 800, 950, 1200, 1450, 1600, 2000, 2400, 2800, 3200, 3600, 4000, 4500, 5000)
nn2 = Array(200, 400, 700, 800, 950, 1200, 1450, 1600, 2000, 2400, 2800, 3200, 3600, 4000, 4500, 5000)
nn3 = Array(200, 400, 700, 800, 950, 1200, 1450, 1600, 1800, 2000, 2200, 2400, 2800, 3200, 3600, 4000, 4500, 5000)
nn4 = Array(200, 300, 400, 500, 600, 700, 800, 950, 1200, 1450, 1600, 1800, 2000, 2200, 2400, 2600, 2800)
nn5 = Array(100, 150, 200, 250, 300, 400, 500, 600, 700, 800, 950, 1100, 1200, 1300, 1450, 1600, 1800)
nn6 = Array(100, 150, 200, 250, 300, 350, 400, 500, 600, 700, 800, 950, 1100, 1200, 1300, 1450)
For x = 1 To 16
n(1, x) = nn1(x)
Next x
For x = 1 To 16
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -