1、界面及程序代码界面 1界面 1 程序代码Option ExplicitDim sbyte As IntegerPrivate Sub CommandButton1_Click()If sbyte = 1 ThenMe.HideUserForm1.ShowElseIf sbyte = 2 ThenMe.HideUserForm1.ShowElseIf sbyte = 3 ThenMe.HideUserForm1.ShowElseIf sbyte = 4 ThenMe.HideUserForm1.ShowElseIf sbyte = 5 ThenMe.HideUserForm1.ShowElseI
2、f sbyte = 0 ThenMe.HideUserForm1.ShowEnd 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 Su
3、b OptionButton5_Click()sbyte = 5End SubPrivate Sub UserForm_Initialize()sbyte = 0End Sub界面 2 界面 2 程序代码Option ExplicitDim arKa(3, 5) As Single 工况系数Private Sub ComboBox1_Change()Select Case (ComboBox1.ListIndex)Case 0ComboBox2.ListIndex = 0Case 1ComboBox2.ListIndex = 4Case 2ComboBox2.ListIndex = 9Case
4、 ElseComboBox2.ListIndex = 19End SelectEnd SubPrivate Sub ComboBox2_Change()Select Case (ComboBox2.ListIndex)Case 0 To 3ComboBox1.ListIndex = 0Case 4 To 8ComboBox1.ListIndex = 1Case 9 To 18ComboBox1.ListIndex = 2Case ElseComboBox1.ListIndex = 3End SelectEnd SubPrivate Sub CommandButton1_Click()Unloa
5、d Me带传动设计.ShowEnd SubPrivate Sub CommandButton2_Click()Dim xka As SingleDim i As Singlep = TextBox1.Textn1 = TextBox3.Textn2 = TextBox4.Textr = TextBox2.TextIf ComboBox5.ListIndex = 0 Then 减速传动xka = 1#ElseIf ComboBox5.ListIndex = 1 Then 增速传动i = n2 / n1If (i = 1.25 And i = 3.5 Thenxka = 1.28Elsexka =
6、 1#End IfElsexka = 1.2End IfDim m As Integer, n As Integer, j As Integerm = ComboBox1.ListIndex 工况n = ComboBox3.ListIndex 启动方式j = ComboBox4.ListIndex 日工作时间Ka = arKa(m, n * 3 + j) * xkaPd = Ka * pMe.hide带型选择.ShowEnd SubPrivate Sub TextBox1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)If (KeyAscii
7、 57) And KeyAscii 46 ThenKeyAscii = 0End 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 ThenKeyAscii = 0End IfEnd SubPr
8、ivate Sub UserForm_Initialize()ComboBox1.AddItem (“载荷变动很小“)ComboBox1.AddItem (“载荷变动较小“)ComboBox1.AddItem (“载荷变动较大“)ComboBox1.AddItem (“载荷变动很大“)ComboBox2.AddItem (“液压搅拌机“)ComboBox2.AddItem (“离心式水泵和压缩机“)ComboBox2.AddItem (“通风机和鼓风机“)ComboBox2.AddItem (“轻负荷输送机“)ComboBox2.AddItem (“带式输送机“)ComboBox2.AddIt
9、em (“通风机“)ComboBox2.AddItem (“螺旋式水泵和压缩机“)ComboBox2.AddItem (“发电机“)ComboBox2.AddItem (“旋转筛和木工机械“)ComboBox2.AddItem (“制砖机“)ComboBox2.AddItem (“斗式提升机“)ComboBox2.AddItem (“往复式水泵和压缩机“)ComboBox2.AddItem (“起重机“)ComboBox2.AddItem (“磨粉机“)ComboBox2.AddItem (“冲剪机床“)ComboBox2.AddItem (“橡胶机械“)ComboBox2.AddItem (
10、“振动筛“)ComboBox2.AddItem (“纺织机械“)ComboBox2.AddItem (“重在输送机“)ComboBox2.AddItem (“磨碎机（鄂式）“)ComboBox2.AddItem (“磨碎机（旋转式）“)ComboBox2.AddItem (“磨碎机（球磨）“)ComboBox2.AddItem (“磨碎机（棒磨）“)ComboBox2.AddItem (“磨碎机（管磨）“)ComboBox3.AddItem (“软启动“)ComboBox3.AddItem (“硬启动“)ComboBox4.AddItem (“16“)ComboBox5.AddItem (“减
11、速传动“)ComboBox5.AddItem (“增速传动“)ComboBox1.ListIndex = 0ComboBox2.ListIndex = 0ComboBox3.ListIndex = 0ComboBox4.ListIndex = 0ComboBox5.ListIndex = 0TextBox1.Text = 10TextBox2.Text = 5TextBox3.Text = 1440TextBox4.Text = 288arKa(0, 0) = 1#: arKa(0, 1) = 1.1: arKa(0, 2) = 1.2: arKa(0, 3) = 1.1: arKa(0, 4
12、) = 1.2: arKa(0, 5) = 1.3arKa(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.4arKa(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.6arKa(3, 0) = 1.3: arKa(3, 1) = 1.4: arKa(3, 2) = 1.5: arKa(3, 3
13、) = 1.5: arKa(3, 4) = 1.6: arKa(3, 5) = 1.8End Sub界面 3界面 5 程序代码Option ExplicitDim v As Single 带速Dim i As Single 实际传动比Private Sub ComboBox1_Change()Dim adoConn As ADODB.Connection 连接对象Dim adoRs As RecordsetDim strPath As StringstrPath = ThisDrawing.Application.VBE.ActiveVBProject.FileNameSet adoConn
14、= New ADODB.ConnectionadoConn.CursorLocation = adUseClientadoConn.Provider = “Microsoft.ACE.OLEDB.12.0;“strPath = Left(strPath, Len(strPath) - 9) “strPath = Left(strPath, Len(strPath) - 9) “strPath = Left(strPath, Len(strPath) - 9) & “v 带数据库.accdb“adoConn.Open strPathEnd IfConnDB = TrueExit Function
15、ERRORHANDLER:Set adoConn = NothingMsgBox “Error occured in procedure EnsureBackendIsConnected“ & vbCrLf & vbCrLf & _“Error Number: “ & Err.Number & vbCrLf & _“Description: “ & Err.DescriptionEnd FunctionPublic Sub readRecordset(record As ADODB.Recordset, strSQl As String, _Optional LockType As LockT
16、ypeEnum = adLockOptimistic, _Optional CursorType As CursorTypeEnum = adOpenKeyset)On Error GoTo ERRORHANDLERDim FormRecordset As ADODB.RecordsetIf ConnDB() = True ThenSet FormRecordset = New ADODB.RecordsetWith FormRecordsetSet .ActiveConnection = adoConn.Source = strSQl.LockType = LockType.CursorTy
17、pe = CursorType.Open If this fails, error handler will kick inEnd WithSet record = FormRecordsetElseMsgBox “readRecordset error: ADO backend connection failed“End IfExit SubERRORHANDLER:Set FormRecordset = Nothing not strictly neededMsgBox “Error occured in procedure readRecordset“ & vbCrLf & vbCrLf
18、 & _“Error Number: “ & Err.Number & vbCrLf & _“Description: “ & Err.DescriptionEnd Sub图层创建函数Public Function NewLayer(ByVal name As String, ByVal layer As AcadLayer) As BooleanIf HasLayer(name) ThenNewLayer = FalseSet layer = NothingElseSet layer = ThisDrawing.Layers.Add(name)NewLayer = TrueEnd IfEnd
19、 Function图层查找函数Public Function HasLayer(ByVal name As String)Dim layer As AcadLayerFor Each layer In ThisDrawing.LayersIf StrComp(layer.name, name, vbTextCompare) = 0 ThenHasLayer = TrueExit FunctionEnd IfNext layerHasLayer = FalseEnd Function图层删除函数Public Function DeleteLayer(ByVal name As String)De
20、bug.Assert (HasLayer(name)Dim layer As AcadLayerSet layer = ThisDrawing.Layouts.Item(name)On Error Resume Nextlayer.DeleteIf Err ThenDeleteLayer = FalseElseDeleteLayer = TrueEnd IfEnd Function图层打开、关闭函数Public Sub TurnOnlayer(ByVal name As String, Optional bOpen As Boolean = True)Debug.Assert (HasLaye
21、r(name)Dim layer As AcadLayerSet layer = ThisDrawing.Layers.Item(name)If bOpen Thenlayer.LayerOn = TrueElselayer.LayerOn = FalseEnd IfEnd Sub设置当前图层Public Sub SetCurrentLayer(LayerName)Dim entry As AcadLayerFor Each entry In ThisDrawing.LayersIf entry.name = LayerName ThenThisDrawing.ActiveLayer = en
22、tryExit SubEnd IfNextEnd SubPublic Function GetVWheelData()bd,ha,hf,e,e+,f,f+,deltaVbd = Vsize(No)(0)Vha = Vsize(No)(1)Vhf = Vsize(No)(2)Ve = Vsize(No)(3)Ve0 = Vsize(No)(4)Vf = Vsize(No)(5)Vf0 = Vsize(No)(6)Vdelta = Vsize(No)(7)VB = (beltz - 1) * Ve + 2 * VfVda1 = dd1 + 2 * VhaVda2 = dd2 + 2 * VhaSe
23、lect Case (No)Case 0 YIf dd1 = 60 ThenVphi1 = 32ElseVphi1 = 36End IfIf dd2 = 60 ThenVphi2 = 32ElseVphi2 = 36End IfCase 1 ZIf dd1 = 80 ThenVphi1 = 34ElseVphi1 = 38End IfIf dd2 = 80 ThenVphi2 = 34ElseVphi2 = 38End IfCase 2 AIf dd1 = 118 ThenVphi1 = 34ElseVphi1 = 38End IfIf dd2 = 118 ThenVphi2 = 34ElseVphi2 = 38End IfCase 3 BIf dd1 = 190 ThenVphi1 = 34ElseVphi1 = 38End IfIf dd2 = 190 ThenVphi2 = 34
