cad代码.doc

界面及程序代码界面1界面1程序代码Option Explicit Dim sbyte As Integer Private Sub CommandButton1_Click() If sbyte = 1 Then Me.Hide UserForm1.Show ElseIf sbyte = 2 Then Me.Hide UserForm1.Show ElseIf sbyte = 3 Then Me.Hide UserForm1.Show ElseIf sbyte = 4 Then Me.Hide UserForm1.Show ElseIf sbyte = 5 Then Me.Hide UserForm1.Show ElseIf sbyte = 0 Then Me.Hide UserForm1.Show End IfEnd SubPrivate Sub CommandButton2_Click() EndEnd SubPrivate Sub OptionButton1_Click() sbyte = 1End SubPrivate Sub OptionButton2_Click() sbyte = 2End SubPrivate Sub OptionButton3_Click() sbyte = 3End SubPrivate Sub OptionButton4_Click() sbyte = 4End SubPrivate Sub OptionButton5_Click() sbyte = 5End SubPrivate Sub UserForm_Initialize() sbyte = 0End Sub界面2 界面2程序代码Option Explicit Dim arKa(3, 5) As Single 工况系数Private Sub ComboBox1_Change() Select Case (ComboBox1.ListIndex) Case 0 ComboBox2.ListIndex = 0 Case 1 ComboBox2.ListIndex = 4 Case 2 ComboBox2.ListIndex = 9 Case Else ComboBox2.ListIndex = 19 End SelectEnd SubPrivate Sub ComboBox2_Change() Select Case (ComboBox2.ListIndex) Case 0 To 3 ComboBox1.ListIndex = 0 Case 4 To 8 ComboBox1.ListIndex = 1 Case 9 To 18 ComboBox1.ListIndex = 2 Case Else ComboBox1.ListIndex = 3 End SelectEnd SubPrivate Sub CommandButton1_Click() Unload Me 带传动设计.ShowEnd SubPrivate Sub CommandButton2_Click() Dim xka As Single Dim i As Single p = TextBox1.Text n1 = TextBox3.Text n2 = TextBox4.Text r = TextBox2.Text If ComboBox5.ListIndex = 0 Then 减速传动 xka = 1# ElseIf ComboBox5.ListIndex = 1 Then 增速传动 i = n2 / n1 If (i = 1.25 And i 1.74) Then xka = 1.05 ElseIf (i 2.49) Then xka = 1.11 ElseIf (i = 3.5 Then xka = 1.28 Else xka = 1# End If Else xka = 1.2 End If Dim m As Integer, n As Integer, j As Integer m = ComboBox1.ListIndex 工况 n = ComboBox3.ListIndex 启动方式 j = ComboBox4.ListIndex 日工作时间 Ka = arKa(m, n * 3 + j) * xka Pd = Ka * p Me.hide 带型选择.ShowEnd SubPrivate Sub TextBox1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger) If (KeyAscii 57) And KeyAscii 46 Then KeyAscii = 0 End IfEnd SubPrivate Sub TextBox2_Exit(ByVal Cancel As MSForms.ReturnBoolean) TextBox4.Text = TextBox3.Text / TextBox2.TextEnd SubPrivate Sub TextBox2_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger) If (KeyAscii 57) And KeyAscii 46 Then KeyAscii = 0 End IfEnd SubPrivate Sub TextBox3_Exit(ByVal Cancel As MSForms.ReturnBoolean) TextBox4.Text = TextBox3.Text / TextBox2.TextEnd SubPrivate Sub TextBox3_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger) If (KeyAscii 57) And KeyAscii 46 Then KeyAscii = 0 End IfEnd SubPrivate Sub TextBox4_Exit(ByVal Cancel As MSForms.ReturnBoolean) TextBox2.Text = TextBox3.Text / TextBox4.TextEnd SubPrivate Sub TextBox4_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger) If (KeyAscii 57) And KeyAscii 46 Then KeyAscii = 0 End IfEnd SubPrivate Sub UserForm_Initialize() ComboBox1.AddItem (载荷变动很小) ComboBox1.AddItem (载荷变动较小) ComboBox1.AddItem (载荷变动较大) ComboBox1.AddItem (载荷变动很大) ComboBox2.AddItem (液压搅拌机) ComboBox2.AddItem (离心式水泵和压缩机) ComboBox2.AddItem (通风机和鼓风机) ComboBox2.AddItem (轻负荷输送机) ComboBox2.AddItem (带式输送机) ComboBox2.AddItem (通风机) ComboBox2.AddItem (螺旋式水泵和压缩机) ComboBox2.AddItem (发电机) ComboBox2.AddItem (旋转筛和木工机械) ComboBox2.AddItem (制砖机) ComboBox2.AddItem (斗式提升机) ComboBox2.AddItem (往复式水泵和压缩机) ComboBox2.AddItem (起重机) ComboBox2.AddItem (磨粉机) ComboBox2.AddItem (冲剪机床) ComboBox2.AddItem (橡胶机械) ComboBox2.AddItem (振动筛) ComboBox2.AddItem (纺织机械) ComboBox2.AddItem (重在输送机) ComboBox2.AddItem (磨碎机（鄂式）) ComboBox2.AddItem (磨碎机（旋转式）) ComboBox2.AddItem (磨碎机（球磨）) ComboBox2.AddItem (磨碎机（棒磨）) ComboBox2.AddItem (磨碎机（管磨）) ComboBox3.AddItem (软启动) ComboBox3.AddItem (硬启动) ComboBox4.AddItem (16) ComboBox5.AddItem (减速传动) ComboBox5.AddItem (增速传动) ComboBox1.ListIndex = 0 ComboBox2.ListIndex = 0 ComboBox3.ListIndex = 0 ComboBox4.ListIndex = 0 ComboBox5.ListIndex = 0 TextBox1.Text = 10 TextBox2.Text = 5 TextBox3.Text = 1440 TextBox4.Text = 288 arKa(0, 0) = 1#: arKa(0, 1) = 1.1: arKa(0, 2) = 1.2: arKa(0, 3) = 1.1: arKa(0, 4) = 1.2: arKa(0, 5) = 1.3 arKa(1, 0) = 1.1: arKa(1, 1) = 1.2: arKa(1, 2) = 1.3: arKa(1, 3) = 1.2: arKa(1, 4) = 1.3: arKa(1, 5) = 1.4 arKa(2, 0) = 1.2: arKa(2, 1) = 1.3: arKa(2, 2) = 1.4: arKa(2, 3) = 1.4: arKa(2, 4) = 1.4: arKa(2, 5) = 1.6 arKa(3, 0) = 1.3: arKa(3, 1) = 1.4: arKa(3, 2) = 1.5: arKa(3, 3) = 1.5: arKa(3, 4) = 1.6: arKa(3, 5) = 1.8End Sub界面3界面5程序代码Option Explicit Dim v As Single 带速 Dim i As Single 实际传动比Private Sub ComboBox1_Change() Dim adoConn As ADODB.Connection 连接对象 Dim adoRs As Recordset Dim strPath As String strPath = ThisDrawing.Application.VBE.ActiveVBProject.FileName Set adoConn = New ADODB.Connection adoConn.CursorLocation = adUseClient adoConn.Provider = Microsoft.ACE.OLEDB.12.0; strPath = Left(strPath, Len(strPath) - 9) & v带数据库.accdb adoConn.Open strPath Dim strSQl As String strSQl = select * from v带基准直径 Set adoRs = New ADODB.Recordset With adoRs Set .ActiveConnection = adoConn .Source = strSQl .LockType = adLockOptimistic .CursorType = adOpenKeyset .Open End With No = ComboBox1.ListIndex ComboBox2.Clear Select Case (No) Case 0 Y Do While (Not adoRs.EOF) If adoRs.Fields(1) = 20 And adoRs.Fields(2) 0 Then ComboBox2.AddItem (adoRs.Fields(1) End If adoRs.MoveNext Loop Case 1 Z Do While (Not adoRs.EOF) If adoRs.Fields(1) = 50 And adoRs.Fields(3) 0 Then ComboBox2.AddItem (adoRs.Fields(1) End If adoRs.MoveNext Loop Case 2 A Do While (Not adoRs.EOF) If adoRs.Fields(1) = 75 And adoRs.Fields(4) 0 Then ComboBox2.AddItem (adoRs.Fields(1) End If adoRs.MoveNext Loop Case 3 B Do While (Not adoRs.EOF) If adoRs.Fields(1) = 125 And adoRs.Fields(5) 0 Then ComboBox2.AddItem (adoRs.Fields(1) End If adoRs.MoveNext Loop Case 4 C Do While (Not adoRs.EOF) If adoRs.Fields(1) = 200 And adoRs.Fields(6) 0 Then ComboBox2.AddItem (adoRs.Fields(1) End If adoRs.MoveNext Loop Case 5 D Do While (Not adoRs.EOF) If adoRs.Fields(1) = 355 And adoRs.Fields(7) 0 Then ComboBox2.AddItem (adoRs.Fields(1) End If adoRs.MoveNext Loop Case Else E Do While (Not adoRs.EOF) If adoRs.Fields(1) = 500 And adoRs.Fields(8) 0 Then ComboBox2.AddItem (adoRs.Fields(1) End If adoRs.MoveNext Loop End Select adoRs.Close If ComboBox2.ListCount 0 Then ComboBox2.ListIndex = 0 End IfEnd SubPrivate Sub ComboBox2_Change() If ComboBox2.Text Then dd1 = ComboBox2.Text Else dd1 = 0 End If If (dd1 0) Then dd2 = r * dd1 * (1 - TextBox1.Text) v = 3.14159 * dd1 * n1 / 60000 i = dd2 / (1 - TextBox1.Text) * dd1) If v = dd2 Then TextBox4.Text = record.Fields(1) Exit Do End If record.MoveNext Loop While (Not record.EOF) record.Close cr = i TextBox5.Text = Round(i, 2) Else MsgBox 带速超出允许值，请重新选择带轮直径！, vbOKOnly, 警告 End If End IfEnd SubPrivate Sub CommandButton1_Click() Unload Me UserForm1.ShowEnd SubPrivate Sub CommandButton3_Click()EndEnd SubPrivate Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean) If TextBox1.Text 0.02 Then Call MsgBox(数据超出允许范围，请重新输入（0.010.02）, vbOKOnly, 数据越界) TextBox1.Text = 0.01 End If countEnd SubPrivate Sub TextBox1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger) If (KeyAscii 57) And KeyAscii 46 Then KeyAscii = 0 End IfEnd SubPrivate Sub UserForm_Initialize() Label1.Caption = Label1.Caption & Pd Label2.Caption = Label2.Caption & n1 ComboBox1.AddItem (Y) ComboBox1.AddItem (Z) ComboBox1.AddItem (A) ComboBox1.AddItem (B) ComboBox1.AddItem (C) ComboBox1.AddItem (D) ComboBox1.AddItem (E) ComboBox1.ListIndex = 0End SubPublic Function count() If ComboBox2.Text Then dd1 = ComboBox1.Text Else dd1 = 0 End If If (dd1 0) Then dd2 = r * dd1 * (1 - TextBox1.Text) VS = 3.14159 * dd1 * n1 / 60000 i = dd2 / (1 - TextBox1.Text) * dd1) If v = dd2 Then TextBox4.Text = record.Fields(1) Exit Do End If record.MoveNext Loop While (Not record.EOF) record.Close cr = i TextBox5.Text = Round(i, 2) MsgBox 带速超出允许值，请重新选择带轮直径！, vbOKOnly, 警告 End If End IfEnd Function界面4界面4代码Option Explicit V带数据Dim belt(6) As StringDim beltA As Single 实际中心距长度Dim L0 As SingleDim L1 As Integer, L2 As IntegerDim a1 As Single, a2 As SingleDim angle1 As Single, angle2 As SingleDim j As IntegerDim kl1 As Single, kl2 As SingleDim dis As Integer额定功率Dim p11 As Single, p12 As Single, p21 As Single, p22 As SingleDim td1 As Integer, td2 As Integer, tn1 As Integer, tn2 As IntegerDim p0 As SingleDim strPath As StringDim adoConn As ADODB.Connection 连接对象Dim record As ADODB.RecordsetPrivate Sub CommandButton1_Click() If TextBox1.Text = Then MsgBox 中心距不能为空 Exit Sub End If 初算V带长度 dis = TextBox1.Text L0 = 2# * dis + 3.14 * (dd1 + dd2) / 2# + (dd2 - dd1) * (dd2 - dd1) / (4# * dis) TextBox10.Text = L0 strSQl = select * from v带基准长度 If adoConn Is Nothing Then strPath = ThisDrawing.Application.VBE.ActiveVBProject.FileName 连接数据库 Set adoConn = New ADODB.Connection adoConn.CursorLocation = adUseClient adoConn.Provider = Microsoft.ACE.OLEDB.12.0; strPath = Left(strPath, Len(strPath) - 9) & v带数据库.accdb adoConn.Open strPath End If 打开数据表 Dim strSQl As String strSQl = select * from v带基准长度 Set record = New ADODB.Recordset With record Set .ActiveConnection = adoConn .Source = strSQl .LockType = adLockOptimistic .CursorType = adOpenKeyset .Open End With Call readRecordset(record, strSQl) record.MoveFirst Do If record.Fields(1) = L0 Then L2 = record.Fields(1) 取大值 kl2 = record.Fields(No + 3) Exit Do End If record.MoveNext Loop While (Not record.EOF) record.MovePrevious L1 = record.Fields(1) 取小值 kl1 = record.Fields(No + 3) record.Close 额定功率 strSQl = select * from 额定功率 Set record = New ADODB.Recordset With record Set .ActiveConnection = adoConn .Source = strSQl .LockType = adLockOptimistic .CursorType = adOpenKeyset .Open End With Call readRecordset(record, strSQl) record.MoveFirst Do If record.Fields(1) = belt(No) Then If record.Fields(2) dd1 Then td2 = record.Fields(2) 取大值 Select Case n1 Case Is = 400 j = 3 Case Is 730 j = 4 tn1 = 400: tn2 = 730 Case Is 800 j = 5 tn1 = 730: tn2 = 800 Case Is 980 j = 6 tn1 = 800: tn2 = 980 Case Is 1200 j = 7 tn1 = 980: tn2 = 1200 Case Is 1460 j = 8 tn1 = 1200: tn2 = 1460 Case Is 1600 j = 9 tn1 = 1460: tn2 = 1600 Case Is 2000 j = 10 tn1 = 1600: tn2 = 2000 Case Is 2400 j = 11 tn1 = 2000: tn2 = 2400 Case Is 2800 j = 12 tn1 = 2400: tn2 = 2800 Case Else j = 13 End Select If j 3 And j 13 Then p22 = record.Fields(j) p21 = record.Fields(j - 1) ElseIf j = 3 Then p21 = record.Fields(j) Else p21 = record.Fields(12) End If Exit Do End If End If record.MoveNext Loop While (Not record.EOF) record.MovePrevious td1 = record.Fields(2) 取小值 If j 3 And j 13 Then p12 = record.Fields(j) p11 = record.Fields(j - 1) ElseIf j = 3 Then p11 = record.Fields(j) Else p11 = record.Fields(12) End If record.Close Dim ka1 As Single, ka2 As Single 以大值计算 a2 = TextBox1.Text + (L2 - L0) / 2# angle2 = 180 - (dd2 - dd1) * 57.5 / a2 Select Case angle2 Case Is 175 ka2 = (angle2 - 175) * (1 - 0.99) / 5 + 0.99 Case Is 170 ka2 = (angle2 - 170) * (0.99 - 0.98) / 5 + 0.98 Case Is 165 ka2 = (angle2 - 165) * (0.98 - 0.96) / 5 + 0.96 Case Is 160 ka2 = (angle2 - 160) * (0.96 - 0.95) / 5 + 0.95 Case Is 155 ka2 = (angle2 - 155) * (0.95 - 0.93) / 5 + 0.93 Case Is 150 ka2 = (angle2 - 150) * (0.93 - 0.92) / 5 + 0.92 Case Is 145 ka2 = (angle2 - 145) * (0.92 - 0.91) / 5 + 0.91 Case Is 140 ka2 = (angle2 - 140) * (0.91 - 0.89) / 5 + 0.89 Case Is 135 ka2 = (angle2 - 135) * (0.89 - 0.88) / 5 + 0.88 Case Is 130 ka2 = (angle2 - 130) * (0.88 - 0.86) / 5 + 0.86 Case Is 125 ka2 = (angle2 - 125) * (0.86 - 0.84) / 5 + 0.84 Case Is 120 ka2 = (angle2 - 120) * (0.84 - 0.82) / 5 + 0.82 Case Is 110 ka2 = (angle2 - 110) * (0.82 - 0.78) / 5 + 0.78 Case Is 100 ka2 = (angle2 - 100) * (0.78 - 0.74) / 5 + 0.74 Case Is 90 ka2 = (angle2 - 90) * (0.74 - 0.69) / 5 + 0.69 Case Else ka2 = 0.69 End Select 以小值计算 a1 = TextBox1.Text + (L1 - L0) / 2# angle1 = 180 - (dd2 - dd1) * 57.5 / a1 Select Case angle1 Case Is 175 ka1 = (angle2 - 175) * (1 - 0.99) / 5 + 0.99 Case Is 170 ka1 = (angle2 - 170) * (0.99 - 0.98) / 5 + 0.98 Case Is 165 ka1 = (angle2 - 165) * (0.98 - 0.96) / 5 + 0.96 Case Is 160 ka1 = (angle2 - 160) * (0.96 - 0.95) / 5 + 0.95 Case Is 155 ka1 = (angle2 - 155) * (0.95 - 0.93)