Nghiên cứu thiết kế, chế tạo bộ gây rung sử dụng trong thiết bị mỏ

dầu Diesel, để khô sau đó đổ dầu bôi trơn VIT 100, l−ợng dầu bôi trơn cần thiết 15...18 lít. D−ới đây là hình ảnh hiện tr−ờng nghiệm thu bộ gây rung tại x−ởng chế tạo sau đó đ−a lên xe vận chuyển đến cơ sở thử nghiệm công nghiệp. Hình 4.1. Hiện tr−ờng tổ chứ nghiệm thu xuất x−ởng Hình 4.2. Chuẩn bị đ−a bộ gây rung đi thử nghiêm công nghiệp 60 Tổ chức thử nghiệm công nghiệp bộ gây rung và theo dõi kết quả đ−ợc tiến hành tại một dây chuyền sản xuất của Công ty tuyển than Cửa Ông - TKV. Ngày 19 tháng 9 năm 2007, sau khi bàn giao cho NMTT Cửa Ông Bộ gây rung đã đ−ợc lắp đặt lên sàng 415 (t−ơng đ−ơng về cỡ kích th−ớc với các thông số đầu vào khi tính toán thiết kế bộ gây rung BR 4e) để chạy thử nghiệm. Hình ảnh bộ gây rung lắp đặt trên sàng đ−ợc thể hiện trên hình 4.3 Hình 4.3. Bộ gây rung lắp trên sàng tự cân bằng Sau khi lắp đặt và hiệu chỉnh độ thăng bằng của thân sàng, sàng đã đ−ợc chạy thử theo trình tự đúng nh− đề c−ơng thử nghiệm từ ngày 22 tháng 9 năm 2007. Việc xác định biên độ dao động đ−ợc thực hiện bằng cách đo thông th−ờng với dụng cụ đo là th−ớc nhựa hoặc th−ớc sắt. Ph−ơng pháp thô sơ nh−ng cũng đủ độ chính xác cần thiết đối với loại thiết bị nh− sàng: đó là đo vết dịch chuyển của một điểm hoặc một đ−ờng thẳng sáng màu (sơn trắng, phấn viết) đ−ợc đánh dấu trên hai bên thân sàng. Kết quả đo cho thấy, trong hoạt động cùng với sàng, bộ gây rung đảm bảo biên độ dao động của thân sàng trong phạm vi 5 ± 1,5 mm. Nh− vậy có thể kết luận là sai lệch không đáng kể so với tính toán lý thuyết. Về chất l−ợng sản phẩm, bộ gây rung đ−ợc chế tạo trong ch−ơng trình đề tài nghiên cứu chạy êm, sàng hoạt động ổn định, tính năng đạt yêu cầu của sản xuất. Đến thời điểm lấy số liệu tạm thời đ−a vào báo cáo (ngày 06 tháng 12 năm 2007) bộ gây rung đã hoạt động ổn định, không sự cố kỹ thuật. Các văn bản liên quan đến công tác tổ chức và kết quả thử nghiệm đ−ợc đ−a vào phụ lục 3. 61 Ch−ơng 5. kết luận và kiến nghị Đề tài "Nghiên cứu thiết kế, chế tạo bộ gây rung sử dụng trong thiết bị mỏ" với sản phẩm cụ thể là bộ gây rung BR 4e dùng để tạo xung kích thích dao động cho sàng tự cân bằng đã đ−ợc nhóm đề tài triển khai đạt kết quả trong năm 2007. Đề tài đã thực hiện các nội dung nghiên cứu cơ bản theo các b−ớc từ lựa chọn đối t−ợng nghiên cứu đến tính toán thiết kế, chế tạo và thử nghiệm sản phẩm. Với những kết quả đã đạt đ−ợc nh− nêu trong báo cáo, đề tài đ−a ra một số kết luận sau: 1- Bộ gây rung BR 4e đ−ợc tính toán thiết kế cho một loại sàng với những tính năng kỹ thuật nhất định, th−ờng nằm trong phạm vi dãy số tiêu chuẩn và t−ơng đ−ơng với đa số các sàng tự cân bằng hiện đang đ−ợc sử dụng trong thực tế sản xuất ngành mỏ. Cách chọn giải pháp này có mặt tích cực là tạo điều kiện thuận lợi cho b−ớc thử nghiệm công nghiệp trong điều kiện Việt Nam, khi ta ch−a có những băng thử chuyên dụng. 2- Các thớt lệch tâm trong bộ gây rung đ−ợc bố trí theo cách chỉ cho phép khi làm việc cùng với sàng có hợp lực li tâm trên mặt phẳng vuông góc với mặt chân đế, vì vậy quỹ đạo dao động của thân sàng chỉ nằm trên mặt phẳng này và là quỹ đạo chuyển động thẳng (straight line motion), th−ờng nghiêng 450 so với mặt l−ới sàng. 3- Cơ sở hình thành các bản vẽ thiết kế là sự kết hợp giữa tính toán trị số động lực rung sao cho đảm bảo sàng hoạt động đạt các thông số kỹ thuật đã định với tham khảo mẫu thiết kế một số bộ gây rung chuyên dụng của các hãng n−ớc ngoài nh− Polmag, Boliden Allis... Công việc tính toán các thông số chính của bộ gây rung BR 4e đ−ợc thực hiện trên ch−ơng trình viết bằng ngôn ngữ Microsoft Visual Basic 6.0. 4- Bộ gây rung đ−ợc chế tạo theo quy trình công nghệ đảm bảo độ chính xác của các chi tiết, đảm bảo tính lắp lẫn, có thể áp dụng cho sản xuất loạt nhỏ và vừa. 5- Bộ gây rung sau khi chế tạo và lắp ráp đạt yêu cầu đã đ−ợc đ−a vào chạy thử công nghiệp, thông số kỹ thuật đ−ợc quan tâm hàng đầu của bộ gây rung là biên độ rung đạt t−ơng đ−ơng bộ gây rung của n−ớc ngoài cho cùng một loại cỡ kích th−ớc sàng. Cho tới thời điểm hiện tại, theo đánh giá chung của ng−ời sử dụng, bộ gây rung BR 4e do Viện cơ khí Năng l−ợng và Mỏ - TKV nghiên cứu thiết kế, chế tạo vẫn hoạt động ổn định, đảm bảo năng suất và hiệu suất sàng theo yêu cầu. 6- Bộ gây rung BR 4e là sản phẩm cơ khí chế tạo đ−ợc tính toán thiết kế, chế tạo với đầy đủ tài liệu kỹ thuật có tính chính xác, đủ độ tin cậy, có thể sử dụng để lắp thay cho sàng cũ kích cỡ phù hợp bị hỏng hoặc lắp cho sàng chế tạo mới. 7- Thời gian chạy thử có tải ch−a nhiều nên ch−a thể có kết luận về độ bền và độ tin cậy của bộ gây rung BR 4e. Do những khó khăn nhất định trong khâu tổ chức thử nghiệm công nghiệp đối với đa số sản phẩm nghiên cứu cơ khí nói chung, cùng với những ràng buộc nhất định về mặt tiến độ, kiến nghị với các cấp quản lý xem xét, đánh giá kết quả nghiên cứu của đề tài ở mức hiện tại. 62 lời cám ơn Thực hiện hợp đồng nghiên cứu khoa học công nghệ số 41.07.RD/ HĐ- KHCN với tiêu đề "Nghiên cứu thiết kế, chế tạo bộ gây rung sử dụng trong thiết bị mỏ" ký giữa Bộ Công nghiệp (nay là Bộ Công Th−ơng) và Viện cơ khí Năng l−ợng và Mỏ - TKV (ngày 25 tháng 01 năm 2007), nhóm đề tài đã chọn bộ gây rung cho sàng tự cân bằng làm đối t−ợng nghiên cứu thiết kế, chế tạo. Đề tài đã hoàn thành về cơ bản các nội dung nghiên cứu theo đề c−ơng. Trong quá trình triển khai đề tài, nhóm đề tài đã nhận đ−ợc sự giúp đỡ cần thiết về mọi mặt của Vụ KHCN Bộ Công nghiệp (nay là Bộ Công Th−ơng), Ban cơ khí Tập đoàn Than - Khoáng sản Việt Nam. Lãnh đạo Viện Cơ khí Năng l−ợng và Mỏ cũng tạo mọi điều kiện thuận lợi cho các thành viên nhóm đề tài và các cơ quan phối hợp chính trong công tác triển khai các b−ớc nghiên cứu và đ−a ra những định h−ớng xác đáng góp phần đẩy nhanh tiến độ đề tài, nâng cao chất l−ợng, hiệu quả công việc. Đề tài cũng nhận đ−ợc sự hợp tác chặt chẽ và sự giúp đỡ tận tình của các cơ quan phối hợp trong việc khảo sát nhu cầu thị tr−ờng, chế tạo và thử nghiệm sản phẩm nh− Công ty tuyển than Cửa Ông - TKV, Công ty tuyển than Hòn Gai - TKV, Công ty tuyển than Vàng Danh - TKV. Các đồng nghiệp trong Viện, các chuyên gia, các nhà sản xuất trong và ngoài ngành mỏ cũng có những đóng góp tích cực trong quá trình thực hiện đề tài và hoàn thiện báo cáo tổng kết. Thay mặt nhóm đề tài, tôi xin chân thành cám ơn các Vụ, Ban, Ngành, Đơn vị chủ quản và các nhà chuyên gia, các nhà sản xuất và các đồng nghiệp vì những sự hợp tác, giúp đỡ nêu trên và mong muốn tiếp tục nhận đ−ợc những ý kiến xây dựng nhằm phát triển và ứng dụng các kết quả nghiên cứu đã đạt đ−ợc vào thực tế sản xuất. 63 Tài liệu tham khảo Tiếng Việt 1- Cẩm nang "Công nghệ và thiết bị mỏ". Quyển I "Khai thác lộ thiên". Hà Nội, "Khoa học kỹ thuật", 2006. 2- Microsoft Visual Basic & lập trình cơ sở dữ liệu/ Chủ biên Nguyễn Thị Ngọc Mai. Hà Nội, "Giáo dục", 2000. 3- Nguyễn Đắc Lộc và nnk. Sổ tay công nghệ chế tạo máy, tập I. Hà Nội, NXB Khoa học kỹ thuật, 1999. 3- Nguyễn Đắc Lộc và nnk. Sổ tay công nghệ chế tạo máy, tập II. Hà Nội, NXB Khoa học kỹ thuật, 2001. 4- Tuyển tập báo cáo khoa học. Hội nghị khoa học kỹ thuật mỏ toàn quốc lần thứ XVII. Đà Nẵng, 8-2006 (pag. 514-516). Tiếng Anh 5- FAG Rolling Bearings. Standard Progamme. Edition 1992. Tiếng Nga 6- Андреев С.Е. и др. Дробление измельчение и грохочение полезных ископаемых. М.: Недра, 1975. 7- Бауман А. Вибрационные машины в строительстве и производстве строительных материалов. М.: Машиздат, 1970. 8- Дьяченко С.К., Столбовой С.З. Расчёт и проектирование деталей машин. М.: Машиностроение, 1964. 9- Пономарев И.В. Дробление и грохочение углей. М.: Машиздат, 1970. 10- Чернавский С.А. и др. Проектирование механических передач. М.: Государственное Научно-Техническое издательство. 1963. Tiếng Ba Lan 11- Andrzej Battaglia, Tadeusz Banaszewski. Maszyny do przerobki wegla, rud i surowcow mineralnych. Warszawa - Krakow, 1972. 12- J. Dietrych. Teoria i budowa przesiewaczy. Katowice, 1962. Một số trang web http:/www.denverconcreetevibrator.com/ http:/www.decavibrator,com/ http:/www.northernvibrator.com/ 1 Phụ lục. Ch−ơng trình tính Bộ gây rung Sàng.exe 1. Giao diện của ch−ơng trình tính bộ gây rung (Sàng.exe): Hình 1. Cửa sổ chính của ch−ơng trình. 2 Hình 2. Tính toán mặt sàng trên (b−ớc 1) 3 Hình 3. Tính toán mặt sàng d−ới (b−ớc 2) 4 Hình 4. Tính toán lực tác dụng xuống trục bộ gây rung (b−ớc 3) 5 Hình 5. Tính kiểm tra ổ con lăn (b−ớc 4) 6 Hình 6. Hiện thị các kết quả tính toán sàng (b−ớc 5) 7 2. File kết quả của ch−ơng trình (*.txt) Bảng kết quả tính toán sàng Sunday, Nov 25 2007, 05:19:32 PM ---------------------------------------------------------------------------------------- 1. Khối l−ợng vật liệu của mặt sàng trên, Q1 = 150. [t/h] 2. Diện tích của mặt sàng trên, F1 = 5.176 [m^2] 3. Biên độ dao động của mặt sàng trên, a1 = 7.004 [mm] 4. Khối l−ợng vật liệu của mặt sàng d−ới, Q2 = 129.6 [t/h] 5. Diện tích của mặt sàng d−ới, F2 = 12.951 [m^2] 6. Biên độ dao động của mặt sàng d−ới, a2 = 1.824 [mm] 7. Diện tích max của mặt l−ới sàng, Fmax = 12.951 [m^2] 8. Chiều dài của mặt l−ới sàng, L = 5.4 [m] 9. Biên độ dao động của thuyền sàng, a = 4.5 [mm] 10. Tần số dao động của thuyền sàng, n = 751.111 [1/min] 11. Góc hất tung vật liệu trên mặt l−ới sàng, beta = 44.759 [deg] 12. Tốc độ của dòng vạt liệu trên mặt l−ới sàng, v = 0.21 [m/s] 13. Chiều cao của lớp vật liệu trên mặt l−ới sàng trên, h1 =0.083 [m] 14. Chiều cao của lớp vật liệu trên mặt l−ới sàng d−ới, h2 =0.071 [m] 15. Khối l−ợng của dòng vật liệu nằm trên mặt l−ới sàng trên, M21 = 745.169 [kg] 16. Khối l−ợng của dòng vật liệu nằm trên mặt l−ới sàng d−ới, M22 = 643.826 [kg] 17. Khối l−ợng tổng cộng tham gia rung, Mt = 5288.994 [kg] 18. Bề dày của quả văng, bqv = 0.09 [m] 19. Lực ly tâm của quả văng, P = 37258.4 [N] 20. Công suất của động cơ dẫn động, P = 11. [kW] 21. Mô men xoắn của động cơ, Mx = 71.947 [Nm] 22. Tỷ số truyền động, idai = 1.947 [/] 23. Mô men xoắn trên trục vào của bộ gây rung, Mxr = 131.723 [Nm] 8 24. Lực tiếp tuyến trên đ−ờng kính chia của bánh răng, Pt = 810.603 [N] 25. Lực h−ớng tâm trên đ−ờng kính chia của bánh răng, Pr = 277.242 [N] 26. Hiệu suất tính toán của l−ới sàng trên, eta_tt1 = 98.906 [%] 27. Hiệu suất tính toán của l−ới sàng d−ới, eta_tt2 = 96.364 [%] 28. Phản lực của các ổ trong mặt phẳng đứng, RA = 37647.57 [N] RB = 38089.23 [N] 29. Phản lực của các ổ trong mặt phẳng nghiêng, RA = 36864.07 [N] RB = 39530.73 [N] 30. Vị trí ổ chịu tải lớn nhất: B 31. Kiểu ổ, Type = 0_ổ con lăn tang trống 2 dãy tự lựa 32. Mã hiệu của ổ, Code = 22324EASK.M.C3 33. Đ−ờng kính trong của ổ, d = 120 [mm] 34. Đ−ờng kính ngoài của ổ, D = 260 [mm] 35. Chiều rộng của ổ, B = 86 [mm] 36. Khả năng chịu tải tĩnh của ổ, Co = 1140 [kN] 37. Khả năng chịu tải động của ổ, C = 900 [kN] 38. Số vòng quay giới hạn của ổ khi bôi trơn bằng mỡ, n1 = 1400 [rot/min] khi bôi trơn bằng dầu, n2 = 1800 [rot/min] 39. Hệ số e của ổ, e = 0.33 [/] 40. Hệ số Y khi Fa/Fr <= e của ổ, Y1 = 2.1 [/] 41. Hệ số Y khi Fa/Fr > e của ổ, Y2 = 3.1 [/] 42. Hệ số Yo của ổ, Yo = 2 [/] 43. Tải trọng t−ơng đ−ơng động của ổ, P = 39.531 [kN] 44. Số vòng quay của ổ, n = 750 [rot/min] 45. Tuổi thọ tính theo giờ của ổ, Lh = 743269.4 [h] Hết. 9 Hình 7. Xuất và in file kết quả tính toán trong ứng dụng Notepad XP. 10 3. Phần mã chính của ch−ơng trình viết bằng ngôn ngữ lập trình Microsoftđ Visual Basic 6.0 Option Explicit Dim LayerIndex As Integer Dim Q1 As Single, F1 As Single, a1 As Single, d1 As Single, _ lambda As Single, gamma As Single Dim Q2 As Single, F2 As Single, a2 As Single, d2 As Single Dim Pu As Single, Pr As Single, Pt As Single, nol As Single Dim Results(0 To 51) As String Private Sub Form_Load() 'Xac lap cho form: Dim i As Integer picLayer(0).Visible = True For i = 1 To 5 picLayer(i).Left = i * 960 picLayer(i).Top = 8040 picLayer(i).Visible = False Next i LayerIndex = 0 cmdStart.Enabled = True cmdBack.Enabled = False cmdNext.Enabled = False cmdFinish.Enabled = False cmdCancel.Enabled = True imgSang.Visible = False Layer1_initialize lambda = 1 End Sub Private Sub mnuFileExport_Click() 'Create the result text format file (*.txt): Dim i As Integer, n As Integer Dim FileName As String, FileNumber As Long, Title As String On Error GoTo ErrHandler FileName = App.Path & "\Results.txt" If Dir(FileName) "" Then Kill FileName 'Check the existing of a new filename. End If 11 FileNumber = FreeFile Open FileName For Output As #FileNumber Title = "Bảng kết quả tính toán sàng" Print #FileNumber, vbCrLf & _ " " & Title & vbCrLf & vbCrLf & _ String(4, Chr(9)) & Format(Now, "dddd, mmm d yyyy, hh:mm:ss AMPM") & vbCrLf & _ " " & String(7 * 14, "-") & vbCrLf n = UBound(Results, 1) For i = 0 To n Print #FileNumber, Results(i) Next i Print #FileNumber, vbCrLf & " Hết." Close #FileNumber Exit Sub ErrHandler: MsgBox Err.Description, vbExclamation, "File Export" End Sub Private Sub mnuFileOpen_Click() Dim FileName As String FileName = App.Path & "\Results.txt" Shell "C:\Windows\Notepad.exe" & " " & FileName, vbNormalFocus End Sub Private Sub mnuFilePrint_Click() Dim FileName As String FileName = App.Path & "\Results.txt" Shell "C:\Windows\Notepad.exe" & " /p " & FileName, vbNormalFocus End Sub Private Sub mnuFileExit_Click() End End Sub Private Sub tbrMain_ButtonClick(ByVal Button As MSComctlLib.Button) Dim FileName As String Select Case Button.Index Case 2: mnuFileOpen_Click Case 4: mnuFilePrint_Click End Select End Sub 12 Private Sub HighLight(ByRef lblX As Label) 'This subroutine is used to click the label-menu. Dim i As Integer Dim ctrlX As Label imgArrow.Top = lblX.Top For i = 1 To 5 Set ctrlX = Choose(i, lblStep1, lblStep2, lblStep3, lblStep4, lblStep5) ctrlX.ForeColor = &H80000007 ctrlX.FontBold = False ctrlX.FontUnderline = False Next i lblX.ForeColor = vbRed lblX.FontBold = True lblX.FontUnderline = True End Sub Private Sub cmdStart_Click() 'Xu ly lop thu 1: frmMain.Height = 8500 cmdStart.Top = 7200 cmdBack.Top = 7200 cmdNext.Top = 7200 cmdFinish.Top = 7200 cmdCancel.Top = 7200 picLayer(0).Visible = False With picLayer(1) .Left = 2100 .Top = 600 .Visible = True End With LayerIndex = 1 HighLight lblStep1 lblTitle.Visible = True lblTitle.Caption = "B−ớc 1. Tính mặt sàng thứ nhất" imgSang.Visible = True cmdStart.Enabled = False cmdBack.Enabled = True cmdNext.Enabled = True End Sub Private Sub cmdBack_Click() '1. Xu ly cac lop truoc: LayerIndex = LayerIndex - 1 Select Case LayerIndex Case 4 13 cmdFinish.Enabled = False cmdNext.Enabled = True picLayer(5).Visible = False lblTitle.Caption = "B−ớc 4. Tính chọn ổ con lăn" picLayer(4).Visible = True HighLight lblStep4 Case 3 picLayer(4).Visible = False lblTitle.Caption = "B−ớc 3. Tính lực trên trục bộ gây rung" picLayer(3).Visible = True cmdNext.Enabled = True HighLight lblStep3 Case 2 picLayer(3).Visible = False lblTitle.Caption = "B−ớc 2. Tính mặt sàng thứ hai" picLayer(1).Visible = True HighLight lblStep2 Case 1 lblTitle.Caption = "B−ớc 1. Tính mặt sàng thứ nhất" picLayer(1).Visible = True HighLight lblStep1 cboQ.Enabled = True Layer1_initialize Case 0 frmMain.Height = 7150 cmdStart.Top = 5880 cmdBack.Top = 5880 cmdNext.Top = 5880 cmdFinish.Top = 5880 cmdCancel.Top = 5880 picLayer(1).Visible = False lblTitle.Visible = False picLayer(0).Visible = True imgSang.Visible = False cmdStart.Enabled = True cmdBack.Enabled = False cmdNext.Enabled = False End Select End Sub Private Sub cmdNext_Click() '0. Xu ly lop hien hanh: Select Case LayerIndex Case 1: Layer1_Calc Case 2: Layer2_Calc Case 3: Layer3_Calc Case 4: Layer4_Calc End Select 14 '1. Xu ly cac lop tiep theo: LayerIndex = LayerIndex + 1 Select Case LayerIndex Case 2 lblTitle.Caption = "B−ớc 2. Tính mặt sàng thứ hai" HighLight lblStep2 Layer2_initialize Case 3 picLayer(1).Visible = False lblTitle.Caption = "B−ớc 3. Tính lực trên trục bộ gây rung" With picLayer(3) .Left = 2100 .Top = 600 .Visible = True End With HighLight lblStep3 Layer3_initialize Case 4 picLayer(3).Visible = False lblTitle.Caption = "B−ớc 4. Tính chọn ổ con lăn" With picLayer(4) .Left = 2100 .Top = 600 .Visible = True End With HighLight lblStep4 Layer4_initialize Case 5 picLayer(4).Visible = False lblTitle.Caption = "B−ớc 5. Kết quả tính toán" With picLayer(5) .Left = 2100 .Top = 600 .Visible = True End With cmdNext.Enabled = False cmdFinish.Enabled = True HighLight lblStep5 Layer5_initialize End Select End Sub Private Sub cmdFinish_Click() mnuFileExport_Click mnuFileOpen_Click End End Sub 15 Private Sub cmdCancel_Click() Unload Me End Sub '------------------------------------------ ' 1/ Tinh luoi sang tren '------------------------------------------ Private Sub Layer1_initialize() 'Khoi tao lop thu 1: With cboQ .AddItem "100" .AddItem "125" .AddItem "150" .AddItem "175" .AddItem "200" .AddItem "225" .AddItem "250" .Text = "150" .Enabled = True End With With cbod .AddItem "100" .AddItem "75" .AddItem "50" .AddItem "25" .AddItem "13" .AddItem "8" .Text = "50" End With With cboCD .AddItem "Sàng sơ bộ" .AddItem "Sàng chuẩn bị" .AddItem "Sàng kết thúc" .Text = "Sàng kết thúc" End With With cbogamma .AddItem "1.0" .AddItem "0.99" .AddItem "0.98" .AddItem "0.97" .AddItem "0.96" .AddItem "0.95" .Text = "1.0" End With 16 With cboVL .AddItem "Than đá" .AddItem "Hạt vật liệu có dạng tròn" .AddItem "Các vật liệu khác" .Text = "Than đá" End With With cboDA .AddItem "Khô" .AddItem "ẩm" .Text = "Khô" End With With cboPPS .AddItem "Khô" .AddItem "T−ới n−ớc" .AddItem "Không phân biệt" .Text = "Khô" End With cboCD_Click cbod_Click cboVL_Click cboDA_Click cboo.Text = "0.8" End Sub Private Sub cboCD_Click() Dim i As Integer, qn1 As Integer, qn2 As Integer Select Case cboCD.Text Case "Sàng sơ bộ" With cboeta .Clear .AddItem "85" .AddItem "86" .AddItem "87" .AddItem "88" .AddItem "89" .AddItem "90" .Text = "87" End With With cbod .Clear .AddItem "100" .AddItem "75" .Text = "100" End With qn1 = 60: qn2 = 65 17 Case "Sàng chuẩn bị" With cboeta .Clear .AddItem "80" .AddItem "81" .AddItem "82" .AddItem "83" .AddItem "84" .AddItem "85" .Text = "82" End With With cbod .Clear .AddItem "50" .AddItem "25" .AddItem "13" .AddItem "8" .AddItem "7" .AddItem "6" .Text = "50" End With qn1 = 35: qn2 = 40 Case "Sàng kết thúc" With cboeta .Clear .AddItem "94" .AddItem "95" .AddItem "96" .AddItem "97" .AddItem "98" .Text = "96" End With With cbod .Clear .AddItem "50" .AddItem "25" .AddItem "13" .AddItem "8" .AddItem "7" .AddItem "6" .Text = "50" End With qn1 = 24: qn2 = 28 End Select cboqn.Clear For i = qn1 To qn2 cboqn.AddItem CStr(i) 18 Next i cboqn.ListIndex = 0 End Sub Private Sub cboeta_Change() cboeta_Click End Sub Private Sub cboeta_Click() ' Xac dinh thong so m = f(eta) [/] 'bang phuong phap noi suy tuyen tinh (NSTT): Dim i As Integer, m_i As Single, eta_i As Single Dim eta(0 To 9) As Single, m(0 To 9) As Single ' Xay dung do thi m = f(eta): For i = 0 To 9 eta(i) = Choose(i + 1, 40, 50, 60, 70, 80, 90, 92, 94, 96, 98) '[%] m(i) = Choose(i + 1, 2.3, 2.1, 1.9, 1.6, 1.3, 1#, 0.9, 0.8, 0.6, 0.4) '[/] Next i ' Tra he so m [/] theo eta [%]: eta_i = Val(cboeta.Text) For i = 0 To 8 If (eta_i > eta(i) And eta_i <= eta(i + 1)) Then Exit For Next i m_i = m(i + 1) + (eta(i + 1) - eta_i) / (eta(i + 1) - eta(i)) * (m(i) - m(i + 1)) '[/] ' Hien he so m [/]: cbom.Text = Format(m_i, "0.###") End Sub Private Sub cbod_Click() '0. Cap nhat q [t/h]: Dim i As Integer, d As Integer, CD As String, qn1 As Integer, qn2 As Integer d = Val(cbod.Text) CD = cboCD.Text Select Case d Case 6 To 8 If CD = "Sàng chuẩn bị" Then qn1 = 8: qn2 = 9 ElseIf CD = "Sàng kết thúc" Then qn1 = 6: qn2 = 7 End If Case 13 If CD = "Sàng chuẩn bị" Then qn1 = 18: qn2 = 20 ElseIf CD = "Sàng kết thúc" Then qn1 = 14: qn2 = 16 End If 19 Case 25 If CD = "Sàng chuẩn bị" Then qn1 = 28: qn2 = 30 ElseIf CD = "Sàng kết thúc" Then qn1 = 20: qn2 = 22 End If Case 50 If CD = "Sàng chuẩn bị" Then qn1 = 35: qn2 = 40 ElseIf CD = "Sàng kết thúc" Then qn1 = 24: qn2 = 28 End If Case 75: qn1 = 40: qn2 = 50 Case 100: qn1 = 60: qn2 = 65 End Select cboqn.Clear For i = qn1 To qn2 cboqn.AddItem CStr(i) Next i cboqn.ListIndex = 0 '1. Xac dinh thong so beta [%] tu do thi beta = f(a) 'bang phuong phap noi suy tuyen tinh (NSTT): Dim betaN_i As Single, betaL_i As Single Dim a(0 To 11) As Single, betaN(0 To 11) As Single, betaL(0 To 11) As Single 'a) Xay dung do thi betaN = f(a): For i = 0 To 11 a(i) = Choose(i + 1, 0, 8, 10.5, 13, 19, 25, 37.5, 50, 62.5, 75, 87.5, 100) '[mm] betaN(i) = Choose(i + 1, 100, 45.26, 38.99, 33.87, 25.99, 20.8, 13.5, 10, 7.96, 6.31, 5.1, 4.2) '[%] Next i ' Tra betaN [%] theo d [mm]: d = Val(cbod.Text) For i = 0 To 10 If (d / 2 > a(i) And d / 2 <= a(i + 1)) Then Exit For Next i betaN_i = betaN(i + 1) + (a(i + 1) - d / 2) / (a(i + 1) - a(i)) * (betaN(i) - betaN(i + 1)) '[%] If LayerIndex = 2 Then betaN_i = betaN_i / lambda ' Hien betaN [%]: cbobetaN.Text = CStr(betaN_i) 'b) Xay dung do thi betaL = f(a): For i = 0 To 11 a(i) = Choose(i + 1, 0, 8, 10.5, 13, 19, 25, 37.5, 50, 62.5, 75, 87.5, 100) '[mm] betaL(i) = Choose(i + 1, 100, 45.26, 38.99, 33.87, 25.99, 20.8, 13.5, 10, 7.96, 6.31, 5.1, 4.2) '[%] 20 Next i ' Tra betaL [%] theo d [mm]: d = Val(cbod.Text) For i = 0 To 10 If (d > a(i) And d <= a(i + 1)) Then Exit For Next i betaL_i = betaL(i + 1) + (a(i + 1) - d) / (a(i + 1) - a(i)) * (betaL(i) - betaL(i + 1)) '[%] If LayerIndex = 2 Then betaL_i = betaL_i / lambda ' Hien betaL [%]: cbobetaL.Text = CStr(betaL_i) '2. Xac dinh thong so k = f(beta) [/]: Dim k_i As Single Dim beta1(0 To 9) As Single, k(0 To 9) As Single ' Xay dung do thi k = f(beta): For i = 0 To 9 beta1(i) = Choose(i + 1, 0, 10, 20, 30, 40, 50, 60, 70, 80, 90) '[%] k(i) = Choose(i + 1, 0.2, 0.4, 0.6, 0.8, 1#, 1.2, 1.4, 1.6, 1.8, 2#) '[/] Next i ' Tra he so k [/] theo beta [%]: For i = 0 To 8 If (100 - betaN_i > beta1(i) And 100 - betaN_i <= beta1(i + 1)) Then Exit For Next i k_i = k(i) + (100 - betaN_i - beta1(i)) / (beta1(i + 1) - beta1(i)) * (k(i + 1) - k(i)) '[/] ' Hien he so k [/]: cbok.Text = Format(k_i, "0.###") '3. Xac dinh thong so l = f(beta) [/]: Dim l_i As Single Dim beta2(0 To 10) As Single, L(0 To 10) As Single ' Xay dung do thi l = f(beta): For i = 0 To 10 beta2(i) = Choose(i + 1, 0, 10, 20, 25, 30, 40, 50, 60, 70, 80, 90) '[%] L(i) = Choose(i + 1, 0.91, 0.94, 0.97, 1#, 1.03, 1.09, 1.18, 1.32, 1.55, 2#, 3.36) '[/] Next i ' Tra he so l [/] theo beta [%]: For i = 0 To 9 If (betaL_i > beta2(i) And betaL_i <= beta2(i + 1)) Then Exit For Next i l_i = L(i) + (betaL_i - beta2(i)) / (beta2(i + 1) - beta2(i)) * (L(i + 1) - L(i)) '[/] ' Hien he so l [/]: cbol.Text = Format(l_i, "0.###") '4. Xac dinh thong so m = f(eta) [/]: Dim m_i As Single, eta_i As Single Dim eta(0 To 9) As Single, m(0 To 9) As Single ' Xay dung do thi m = f(eta): 21 For i = 0 To 9 eta(i) = Choose(i + 1, 40, 50, 60, 70, 80, 90, 92, 94, 96, 98) '[%] m(i) = Choose(i + 1, 2.3, 2.1, 1.9, 1.6, 1.3, 1#, 0.9, 0.8, 0.6, 0.4) '[/] Next i ' Tra he so m [/] theo eta [%]: eta_i = Val(cboeta.Text) For i = 0 To 8 If (eta_i > eta(i) And eta_i <= eta(i + 1)) Then Exit For Next i m_i = m(i + 1) + (eta(i + 1) - eta_i) / (eta(i + 1) - eta(i)) * (m(i) - m(i + 1)) '[/] ' Hien he so m [/]: cbom.Text = Format(m_i, "0.###") '5. Cap nhat he so o [/]: cboDA_Click '6. Cap nhat he so p [/]: cboPPS_Click End Sub Private Sub cbod_Change() ' Xac dinh thong so beta [%] tu do thi beta = f(a) ' bang phuong phap noi suy tuyen tinh (NSTT): Dim i As Integer, d As Single, betaN_i As Single, betaL_i As Single Dim a(0 To 11) As Single, betaN(0 To 11) As Single, betaL(0 To 11) As Single 'a) Xay dung do thi betaN = f(a): For i = 0 To 11 a(i) = Choose(i + 1, 0, 8, 10.5, 13, 19, 25, 37.5, 50, 62.5, 75, 87.5, 100) '[mm] betaN(i) = Choose(i + 1, 100, 42.65, 38.99, 33.87, 25.99, 20.8, 13.5, 10, 7.96, 6.31, 5.1, 4.2) '[%] Next i ' Tra betaN [%] theo d [mm]: d = Val(cbod.Text) For i = 0 To 10 If (d / 2 > a(i) And d / 2 <= a(i + 1)) Then Exit For Next i betaN_i = betaN(i + 1) + (a(i + 1) - d / 2) / (a(i + 1) - a(i)) * (betaN(i) - betaN(i + 1)) '[%] If LayerIndex = 2 Then betaN_i = betaN_i / lambda ' Hien betaN [%]: cbobetaN.Text = CStr(betaN_i) 'b) Xay dung do thi betaL = f(a): For i = 0 To 11 a(i) = Choose(i + 1, 0, 8, 10.5, 13, 19, 25, 37.5, 50, 62.5, 75, 87.5, 100) '[mm] betaL(i) = Choose(i + 1, 100, 42.65, 38.99, 33.87, 25.99, 20.8, 13.5, 10, 7.96, 6.31, 5.1, 4.2) '[%] 22 Next i ' Tra betaL [%] theo d [mm]: d = Val(cbod.Text) For i = 0 To 10 If (d > a(i) And d <= a(i + 1)) Then Exit For Next i betaL_i = betaL(i + 1) + (a(i + 1) - d) / (a(i + 1) - a(i)) * (betaL(i) - betaL(i + 1)) '[%] If LayerIndex = 2 Then betaL_i = betaL_i / lambda ' Hien betaL [%]: cbobetaL.Text = CStr(betaL_i) End Sub Private Sub cboQ_KeyPress(KeyAscii As Integer) Select Case KeyAscii Case 46, 48 To 57 'Do nothing! Case Else KeyAscii = 0 End Select End Sub Private Sub cboVL_Click() Dim VL As String, n As Single VL = cboVL.Text Select Case VL Case "Than đá": n = 1.5 Case "Hạt vật liệu có dạng tròn": n = 1.25 Case "Các vật liệu khác": n = 1# End Select cbon.Text = CStr(n) End Sub Private Sub cboDA_Click() Dim d As Single, DA As String, o As Single d = Val(cbod.Text) DA = cboDA.Text cboo.Clear If d < 25 Then 'd < 25 [mm] Select Case DA Case "Khô" cboo.AddItem "1.0" cboo.ListIndex = 0 Case "ẩm" For o = 0.75 To 0.85 Step 0.01 cboo.AddItem CStr(Round(o, 2)) Next o cboo.ListIndex = 0 Case "Không phân biệt" 23 cboo.Text = "1.0" End Select Else 'd >= 25 [mm] For o = 0.1 To 1.05 Step 0.1 cboo.AddItem CStr(Round(o, 1)) Next o cboo.ListIndex = 0 End If End Sub Private Sub cboPPS_Click() Dim d As Single, PPS As String, P As Single d = Val(cbod.Text) PPS = cboPPS.Text cboP.Clear If d < 25 Then 'd < 25 [mm] Select Case PPS Case "Khô" cboP.AddItem "1.0" cboP.ListIndex = 0 Case "T−ới n−ớc" For P = 1.25 To 1.4 Step 0.05 cboP.AddItem CStr(Round(P, 2)) Next P cboP.ListIndex = 0 Case "Không phân biệt" cboP.Text = "1.0" End Select Else 'd >= 25 [mm] cboP.AddItem "1.0" cboP.ListIndex = 0 End If End Sub Private Sub Layer1_Calc() Dim betaL As Single, CD As String, eta As Single Dim Q As Single, k As Single, L As Single, _ m As Single, n As Single, o As Single, P As Single Dim msg As String '0. Nhap du lieu: Q1 = Val(cboQ.Text) '[t/h] betaL = Val(cbobetaL.Text) '[%] eta = Val(cboeta.Text) '[/] d1 = Val(cbod.Text) '[mm] Q = Val(cboqn.Text) '[t/hm^2] gamma = Val(cbogamma.Text) '[t/m^3] k = Val(cbok.Text) '[/] L = Val(cbol.Text) '[/] 24 m = Val(cbom.Text) '[/] n = Val(cbon.Text) '[/] o = Val(cboo.Text) '[/] P = Val(cboP.Text) '[/] '--------------------------------------- 'Kiem tra du lieu nhap vao: ' msg = "Q1 = " & CStr(Q1) & " [t/h]" & vbCrLf & _ "betaL = " & CStr(betaL) & " [%]" & vbCrLf & _ "eta = " & CStr(eta) & " [/]" & vbCrLf & _ "d1 = " & CStr(d) & " [mm]" & vbCrLf & _ "q = " & CStr(q) & " [t/hm^2]" & vbCrLf & _ "gamma = " & CStr(gamma) & " [t/m^3]" & vbCrLf & _ "k = " & CStr(k) & " [/]" & vbCrLf & _ "l = " & CStr(l) & " [/]" & vbCrLf & _ "m = " & CStr(m) & " [/]" & vbCrLf & _ "n = " & CStr(n) & " [/]" & vbCrLf & _ "o = " & CStr(o) & " [/]" & vbCrLf & _ "p = " & CStr(p) & " [/]." ' MsgBox msg, vbInformation, "Nhap du lieu" '--------------------------------------- '1. Tinh dien tich cua luoi sang tren, F1 [m^2]: F1 = Q1 / (Q * gamma * k * L * m * n * o * P) '[m^2] '2. Tinh bien do dao dong cua luoi sang tren, a1 [mm]: a1 = (4 + 140 * d1) / 1000 '[mm] ' Luu va thong bao ket qua: Results(0) = "1. Khối l−ợng vật liệu của mặt sàng trên, Q1 = " & Format(Q1, "####.###") & " [t/h]" Results(1) = "2. Diện tích của mặt sàng trên, F1 = " & Format(F1, "####.###") & " [m^2]" Results(2) = "3. Biên độ dao động của mặt sàng trên, a1 = " & CStr(a1) & " [mm]" Results(3) = "" ' msg = Results(0) & vbCrLf & _ Results(1) & vbCrLf & _ Results(2) & vbCrLf ' MsgBox msg, vbInformation, "1. Tính mặt sàng trên" '3. Tinh va truyen du lieu (lambda, Q2) cho buoc 2: lambda = (100 - betaL) * eta / 10000 '[/] Q2 = Q1 * lambda '[t/h] End Sub '------------------------------------------ ' 2/ Tinh luoi sang duoi '------------------------------------------ Private Sub Layer2_initialize() 25 'Khoi tao lop thu hai. cboQ.Text = CStr(Q2) cboQ.Enabled = False cboCD_Click cbod_Click cbod.ListIndex = 2 cboVL_Click cboDA_Click cboDA.ListIndex = 1 cboo.Text = "0.8" End Sub 'Cac dieu khien tren lop thu 2: Dung lai cua lop thu nhat! Private Sub Layer2_Calc() Dim betaL As Single, CD As String, eta As Single Dim Q As Single, k As Single, L As Single, _ m As Single, n As Single, o As Single, P As Single Dim msg As String '0. Nhap du lieu: Q2 = Val(cboQ.Text) '[t/h] betaL = Val(cbobetaL.Text) '[%] eta = Val(cboeta.Text) '[/] Q = Val(cboqn.Text) '[t/hm^2] d2 = Val(cbod.Text) '[mm] ''' gamma = Val(cbogamma.Text) '[t/m^3] k = Val(cbok.Text) '[/] L = Val(cbol.Text) '[/] m = Val(cbom.Text) '[/] n = Val(cbon.Text) '[/] o = Val(cboo.Text) '[/] P = Val(cboP.Text) '[/] '--------------------------------------- 'Kiem tra du lieu nhap vao: ' msg = "Q2 = " & CStr(Q2) & " [t/h]" & vbCrLf & _ "betaL = " & CStr(betaL) & " [%]" & vbCrLf & _ "eta = " & CStr(eta) & " [/]" & vbCrLf & _ "q = " & CStr(q) & " [t/hm^2]" & vbCrLf & _ "d2 = " & CStr(d2) & " [t/hm^2]" & vbCrLf & _ "gamma = " & CStr(gamma) & " [t/m^3]" & vbCrLf & _ "k = " & CStr(k) & " [/]" & vbCrLf & _ "l = " & CStr(l) & " [/]" & vbCrLf & _ "m = " & CStr(m) & " [/]" & vbCrLf & _ "n = " & CStr(n) & " [/]" & vbCrLf & _ "o = " & CStr(o) & " [/]" & vbCrLf & _ "p = " & CStr(P) & " [/]." ' MsgBox msg, vbInformation, "Nhap du lieu" '--------------------------------------- 26 '1. Tinh dien tich cua luoi sang duoi, F2 [m^2]: F2 = Q2 / (Q * gamma * k * L * m * n * o * P) '[m^2] '2. Tinh bien do dao dong cua luoi sang duoi, a2 [mm]: a2 = (4 + 140 * d2) / 1000 '[mm] ' Luu va thong bao ket qua: Results(4) = "4. Khối l−ợng vật liệu của mặt sàng d−ới, Q2 = " & Format(Q2, "####.###") & " [t/h]" Results(5) = "5. Diện tích của mặt sàng d−ới, F2 = " & Format(F2, "####.###") & " [m^2]" Results(6) = "6. Biên độ dao động của mặt sàng d−ới, a2 = " & CStr(a2) & " [mm]" Results(7) = "" ' msg = Results(4) & vbCrLf & _ Results(5) & vbCrLf & _ Results(6) ' MsgBox msg, vbInformation, "2. Tính mặt sàng d-ới" End Sub '------------------------------------------ ' 3/ Tinh luc tac dung xuong truc bo gay rung '------------------------------------------ Private Sub Layer3_initialize() 'Khoi tao lop thu 3. With cboM1 .AddItem "3800" .AddItem "3900" .AddItem "4000" .Text = "3900" End With With cboB .AddItem "0.9" .AddItem "1.2" .AddItem "1.5" .AddItem "1.8" .AddItem "2.0" .AddItem "2.2" .AddItem "2.4" .Text = "2.4" End With With cboalfa .AddItem "0.0" .AddItem "0.0872" .AddItem "0.1745" .Text = "0.0872" End With With cbofi 27 .AddItem "2.3562" .AddItem "2.6180" .AddItem "3.1416" .Text = "3.1416" End With With cbou .AddItem "1.3" .AddItem "1.5" .AddItem "1.7" .AddItem "2.0" .AddItem "2.3" .AddItem "2.5" .AddItem "2.8" .Text = "2.0" End With With cboPdc .AddItem "5.5" .AddItem "7.5" .AddItem "11" .AddItem "15" .Text = "5.5" End With With cbondc .AddItem "1460" .AddItem "1460" .AddItem "1460" .AddItem "1460" .Text = "1460" End With cboRL.Text = "0.24" cborn.Text = "0.1" cboro.Text = "7850" End Sub Private Sub Layer3_Calc() Dim i As Integer Dim M1 As Single, B As Single, alfa As Single, fi As String, _ ka As Single, kc As Single, u As Single, Fmax As Single, _ L As Single, Ltc(0 To 8) As Single, a As Single, _ atc(0 To 4) As Single, achon As Single, _ j As Integer, n As Single, Ntc(0 To 6) As Single, nchon As Single, _ delta1 As Single, delta2 As Single, v As Single, _ beta As Single, omega As Single, h1 As Single, h2 As Single, _ gamma As Single, M21 As Single, M22 As Single, Mt As Single, _ bqv As Single, RL As Single, r As Single, ro As Single, bchon As Single, _ ndc As Single, dlan As Single, eta1 As Single, eta2 As Single, _ eta3 As Single, fms As Single, betad As Single, betad1 As Single Dim Mx As Single, NL As Single, idai As Single, Ntt As Single, _ Mxr As Single, DC As Single, alfa1 As Single 28 Dim Motor(0 To 3, 0 To 1) As Single, Ntra As Single, ndctra As Integer Dim msg As String '0. Nhap du lieu: 'Cac hang so PI, g: Da tinh tu truoc! 'Cac bien Q1, F1, a1, Q2, F2, a2: Da tinh o tren! M1 = Val(cboM1.Text) '[kg] B = Val(cboB.Text) '[m] alfa = Val(cboalfa.Text) '[rad] fi = Val(cbofi.Text) '[rad] u = Val(cbou.Text) '[/] RL = Val(cboRL.Text) r = Val(cborn.Text) ro = Val(cboro.Text) dlan = Val(cbodlan.Text) eta1 = Val(cboeta1.Text) eta2 = Val(cboeta2.Text) eta3 = Val(cboeta3.Text) fms = Val(cbofms.Text) '--------------------------------------- 'Kiem tra du lieu nhap vao: ' msg = "PI = " & CStr(PI) & " [/]" & vbCrLf & _ "g = " & CStr(g) & " [m/s^2]" & vbCrLf & _ "Q1= " & CStr(Q1) & " [t/h]" & vbCrLf & _ "F1= " & CStr(F1) & " [m^2]" & vbCrLf & _ "a1= " & CStr(a1) & " [mm]" & vbCrLf & _ "d1= " & CStr(d1) & " [mm]" & vbCrLf & _ "Q2= " & CStr(Q2) & " [t/h]" & vbCrLf & _ "F2= " & CStr(F2) & " [m^2]" & vbCrLf & _ "a2= " & CStr(a2) & " [mm]" & vbCrLf & _ "d2= " & CStr(d2) & " [mm]" & vbCrLf & _ "M1 = " & CStr(M1) & " [kg]" & vbCrLf & _ "B = " & CStr(B) & " [m]" & vbCrLf & _ "alfa = " & CStr(Round(alfa * 180 / PI, 3)) & " [deg]" & vbCrLf & _ "fi = " & CStr(fi) & " [rad]" & vbCrLf & _ "u = " & CStr(u) & " [/]" ' MsgBox msg, vbInformation, "Nhap du lieu" '---------------------------------------- '1. Chon co dien tich mat luoi sang, F [m^2]: If F1 < F2 Then Fmax = F2 Else Fmax = F1 '[m^2] '2. Tinh chieu dai mat luoi sang, L [m]: L = Round(Fmax / B, 1) '[m] '3. Tinh bien do dao dong cua thuyen sang, a [mm]: a = (a1 + a2) / 2 '[mm] For j = 0 To 4 atc(j) = Choose(j + 1, 2.5, 3, 3.5, 4, 4.5) 29 Next j For j = 0 To 3 If a > atc(j) And a <= atc(j + 1) Then Exit For Next j achon = atc(j + 1) '[mm] '4. Tinh tan so dao dong cua thuyen sang, n [lan/ph]: 'Bien d1 da xac dinh o lop thu 1! n = 5 * (1 + 13.5 * d1) / achon For i = 0 To 6 Ntc(i) = Choose(i + 1, 700, 750, 800, 850, 900, 950, 1000) Next i For i = 0 To 5 If n > Ntc(i) And n < Ntc(i + 1) Then Exit For Next i delta1 = n - Ntc(i) delta2 = Ntc(i + 1) - n If delta1 < delta2 Then nchon = Ntc(i) Else nchon = Ntc(i + 1) nol = nchon '[rot/min] '5. Tinh goc hat vat lieu tren mat luoi sang, beta [rad]: omega = PI * nchon / 30 '[dd/s] beta = Atn((u * g * Cos(alfa) * 1000 / achon / omega ^ 2) / Sqr(-(u * g * Cos(alfa) _ * 1000 / achon / omega ^ 2) * (u * g * Cos(alfa) _ * 1000 / achon / omega ^ 2) + 1)) '6. Tinh toc do cua dong lieu tren mat luoi sang, v [m /s]: v = 1.4 * (u - 1) * g / Tan(beta - alfa) / omega '[m/s] '6.Tinh chieu cao phan dau cua lop vat lieu tren cac mat luoi sang, h1,h2 [m]: gamma = Val(cbogamma.Text) betad = Val(cbobetaL.Text) betad1 = Val(cbobetaL.Text) h1 = Q1 / 3600 / v / B / gamma '[m] h2 = Q2 / 3600 / v / B / gamma '[m] '7. Tinh khoi luong vat lieu tren cac mat luoi sang, M21, M22 [kg]: M21 = h1 * (2 - (100 - betad) / 100) * B * L * gamma * 1000 / 2 '[kg] M22 = h2 * (2 - (100 - betad1) / 100) * B * L * gamma * 1000 / 2 '[kg] '8. Tinh tong khoi luong tham gia rung, Mt [kg]: Mt = M1 + M21 + M22 '[kg] '9. Be day qua vang, bqv [m]: bqv = 3 * achon * Mt / 8000 / ro / (RL ^ 3 - r ^ 3) / Sin(fi / 2) '[m] bchon = Round(bqv, 2) '10. Luc ly tam cua mot qua vang, Pu [N]: Pu = (2 / 3) * bchon * ro * (RL ^ 3 - r ^ 3) * Sin(fi / 2) * omega ^ 2 '[N] 30 '11. Cong suat dong co dan dong, Ndc [kW]: Ntt = fms * 4 * Pu * omega * dlan / 2 / 1000 / eta1 / eta2 ^ 2 / eta3 '[kW] ' Chon dong co tieu chuan: ' Xay dung bang dong co DC: For i = 0 To 3 Motor(i, 0) = Choose(i + 1, 5.5, 7.5, 11, 15) '[kW] Motor(i, 1) = Choose(i + 1, 1460, 1460, 1460, 1460) '[vong/phut] Next i ' Tra Motor the Ntt: For i = 0 To 2 If Ntt >= Motor(i, 0) And Ntt < Motor(i + 1, 0) Then Exit For Next i Ntra = Motor(i + 1, 0) '[kW] ndctra = Motor(i + 1, 1) '[rot/min] ' Hien cong suat tra cua dong co tieu chuan: cboPdc.Text = CStr(Ntra) cbondc.Text = CStr(ndctra) '12. Tinh cac thanh phan luc khac tac dung len cac o, Mx [N.m], Pr, Pt [N]: DC = Val(cbodc.Text) alfa1 = Val(cboalfa1.Text) ' Mo men xoan cua dong co, Mx [N.m]: Mx = 30 * 1000 * Ntra / PI / ndctra '[N.m] ' Ti so truyen dong, idai [/]: idai = ndctra / nchon '[/] ' Mo men xoan tren truc vao bo gay rung, Mxr [N.m]: Mxr = Mx * idai * eta1 * eta2 '[N.m] ' Luc tiep tuyen va huong tam tren duong kinh chia cua banh rang, Pt, Pr [N]: Pt = Mxr * 2 / DC '[N] Pr = Pt * Sin(alfa1) '[N] '13. Nghiem lai hieu suat cua sang (etatt [%]): Dim Bo As Single, Ftt As Single, Qo As Single, qt As Single, qno As Single, _ Rqd As Single, etatt1 As Single, etatt2 As Single, Q As Single For i = 1 To 2 Select Case i Case 1 Bo = 0.95 * B '[m] Ftt = Bo * L '[m^2] Qo = Q1 / gamma '[m^3/h] qt = Qo / Ftt '[m^3/(h.m^2)] qno = 1.67 * d1 '[m^3/(h.m^2)] Rqd = qt / qno '[/] etatt1 = 100 - 7.5 * Rqd '[%] 31 Case 2 Bo = 0.95 * B '[m] Ftt = Bo * L '[m^2] Qo = Q2 / gamma '[m^3/h] qt = Qo / Ftt '[m^3/(h.m^2)] qno = 1.67 * d2 '[m^3/(h.m^2)] Rqd = qt / qno '[/] etatt2 = 100 - 7.5 * Rqd '[%] End Select Next i '14. Luu va thong bao ket qua: Results(8) = "7. Diện tích max của mặt l−ới sàng, Fmax = " & Format(Fmax, "###.###") & " [m^2]" Results(9) = "8. Chiều dài của mặt l−ới sàng, L = " & CStr(L) & " [m]" Results(10) = "9. Biên độ dao động của thuyền sàng, a = " & CStr(achon) & " [mm]" Results(11) = "10. Tần số dao động của thuyền sàng, n = " & Format(n, "####.###") & " [lan/phut]" Results(12) = "11. Góc hất tung vật liệu trên mặt l−ới sàng, beta = " & Format(beta, "###.###") & " [rad]" Results(13) = "12. Tốc độ của dòng vạt liệu trên mặt l−ới sàng, v = " & Format(v, "#0.###") & " [m/s]" Results(14) = "13. Chiều cao của lớp vật liệu trên mặt l−ới sàng trên, h1 =" & Format(h1, "#0.###") & " [m]" Results(15) = "14. Chiều cao của lớp vật liệu trên mặt l−ới sàng d−ới, h2 =" & Format(h2, "#0.###") & " [m]" Results(16) = "15. Khối l−ợng của dòng vật liệu nằm trên mặt l−ới sàng trên, M21 = " & Format(M21, "####.###") & " [kg]" Results(17) = "16. Khối l−ợng của dòng vật liệu nằm trên mặt l−ới sàng d−ới, M22 = " & Format(M22, "####.###") & " [kg]" Results(18) = "17. Khối l−ợng tổng cộng tham gia rung, Mt = " & Format(Mt, "####.###") & " [kg]" Results(19) = "18. Bề dày của quả văng, bqv = " & Format(bqv, "##.###") & " [m]" Results(20) = "19. Lực ly tâm của quả văng, P = " & Format(Pu, "#####.###") & " [N]" Results(21) = "20. Công suất của động cơ dẫn động, P = " & Format(Ntra, "####.###") & " [kW]" Results(22) = "21. Mô men xoắn của động cơ, Mx = " & Format(Mx, "####.###") & " [Nm]" Results(23) = "22. Tỷ số truyền động, idai = " & Format(idai, "##.###") & " [/]" Results(24) = "23. Mô men xoắn trên trục vào của bộ gây rung, Mxr = " & Format(Mxr, "####.###") & " [Nm]" Results(25) = "24. Lực tiếp tuyến trên đ−ờng kính chia của bánh răng, Pt = " & Format(Pt, "####.###") & " [N]" Results(26) = "25. Lực h−ớng tâm trên đ−ờng kính chia của bánh răng,Pr = " & Format(Pr, "####.###") & " [N]" Results(27) = "26. Hiệu suất tính toán của l−ới sàng trên, eta_tt1 = " & Format(etatt1, "##.###") & " [%]" 32 Results(28) = "27. Hiệu suất tính toán của l−ới sàng d−ới, eta_tt2 = " & Format(etatt2, "##.###") & " [%]" Results(29) = " " ' msg = "" ' For i = 8 To 20 ' msg = msg & Results(i) & vbCrLf ' Next i ' msg = msg & "Còn nữa..." ' MsgBox msg, vbInformation, "3. Tính lực tác dụng của bộ gây rung" ' msg = "" ' For i = 21 To 29 ' msg = msg & Results(i) & vbCrLf ' Next i ' MsgBox msg, vbInformation, "3. Tính lực tác dụng của bộ gây rung" End Sub '------------------------------------------ ' 4/ Tinh chon o con lan '------------------------------------------ Private Sub Layer4_initialize() Dim i As Integer, mark As String, e As Single, _ Y1 As Single, Y2 As Single, Yo As Single 'Cac kich thuoc cua truc: txtlo.Text = "570" '[mm] txtl1.Text = "190" '[mm] 'Cac ngoai luc tac dung len truc: txtPu.Text = Pu '[kN] txtPr.Text = "278" '[kN] txtPcd.Text = "1600" '[kN] txtGtr.Text = "630" '[kN] txtGbr.Text = "325" '[kN] txtGbd.Text = "265" '[kN] 'Cac thong so cua o: txtnol.Text = CStr(nol) '[rot/min] With cboBType .Clear .AddItem "0_ổ con lăn tang trống 2 dãy tự lựa" .Text = "0_ổ con lăn tang trống 2 dãy tự lựa" End With With cboBCode .Clear For i = 1 To 14 mark = Choose(i, "22324ES.TVPB", _ "22324ES.TVPB.C3", _ 33 "22324ES.TVPB.C4", _ "22324ESK.TVPB", _ "22324ESK.TVPB.C3", _ "22324ESK.TVPB.C4", _ "22324AS.MA.T41A", _ "22324ASK.MA.T41A", _ "22324EAS.M", _ "22324EAS.M.C3", _ "22324EASK.M", _ "22324EASK.M.C3", _ "22324EAS.MA.T41A", _ "22324EASK.MA.T41A") .AddItem mark Next i .Text = "22324EASK.M.C3" End With cboBSizes.Text = "120x260x86" '[mm] cboBCo.Text = "1140" '[kN] cboBC.Text = "900" '[kN] cboBnmax.Text = "1400/1800" '[rot/min] End Sub Private Sub cboBCode_Click() Dim i As Integer i = cboBCode.ListIndex Select Case i Case 6, 7 cboBSizes.Text = "120x260x86" '[mm] cboBCo.Text = "1140" '[kN] cboBC.Text = "900" '[kN] cboBnmax.Text = "1300/1700" '[rot/min] Case Else cboBSizes.Text = "120x260x86" '[mm] cboBCo.Text = "1140" '[kN] cboBC.Text = "900" '[kN] cboBnmax.Text = "1400/1800" '[rot/min] End Select End Sub Private Sub Layer4_Calc() 'Tinh kiem tra o con lan tren goi truc chiu tai trong lon nhat. Dim i As Integer, j As Integer Dim lo As Single, l1 As Single Dim Pu As Single, Pr As Single, Pcd As Single, _ Gtr As Single, Gbr As Single, Gbd As Single Dim RA1 As Single, RB1 As Single, RA2 As Single, RB2 As Single, _ RA As Single, RB As Single, BName As String Dim BType As String, BCode As String, BSizes As String, _ 34 dt As Single, Dn As Single, B As Single, _ Co As Single, C As Single, n1 As Single, n2 As Single, _ e As Single, Y1 As Single, Y2 As Single, Yo As Single Dim n As Single, P As Single, L As Single, Lh As Single Dim msg As String, letter As String, data As String '0. Xac dinh phan luc tai cac o lan (RA, RB [N]): lo = txtlo.Text '[mm] l1 = txtl1.Text '[mm] Pu = txtPu.Text '[kN] Pr = txtPr.Text '[kN] Pcd = txtPcd.Text '[kN] Gtr = txtGtr.Text '[kN] Gbr = txtGbr.Text '[kN] Gbd = txtGbd.Text '[kN] 'a) Trong mat phang dung: RB1 = ((2 * Pu + Gtr + Gbr) * lo / 2 + Gbd * (lo + l1)) / lo '[N] RA1 = (2 * Pu + Gtr + Gbr + Gbd) - RB1 '[N] 'b) Trong mat phang nghieng: RB2 = ((2 * Pu + Pr) * lo / 2 + Pcd * (lo + l1)) / lo '[N] RA2 = (2 * Pu + Pr + Pcd) - RB2 '[N] RA = IIf(RA1 > RA2, RA1, RA2) RB = IIf(RB1 > RB2, RB1, RB2) If RA > RB Then BName = "A" Else BName = "B" '---------------------------------------- ' MsgBox "RA1 = " & RA1 & " [N]" & vbCrLf & _ "RB1 = " & RB1 & " [N]" & vbCrLf & _ "RA2 = " & RA2 & " [N]" & vbCrLf & _ "RB2 = " & RB2 & " [N]" & vbCrLf & _ "RAmax = " & RA & " [N]" & vbCrLf & _ "RBmax = " & RB & " [N]" '---------------------------------------- '1. Tinh kiem tra tuoi tho cua o lan (Lh [h]): 'Lay va tra cac thong so cua o lan: BType = cboBType.Text BCode = cboBCode.Text BSizes = cboBSizes.Text & "x" j = 0: data = "" For i = 1 To Len(BSizes) letter = Mid(BSizes, i, 1) If letter = "x" Then j = j + 1 Select Case j Case 1: dt = Val(data) '[mm] Case 2: Dn = Val(data) '[mm] 35 Case 3: B = Val(data) '[mm] End Select data = "" Else data = data & letter End If Next i i = cboBCode.ListIndex Select Case i Case 6, 7 Co = 1140 '[kN] C = 900 '[kN] n1 = 1300 '[rot/min] n2 = 1700 '[rot/min] e = 0.36 '[/] Y1 = 1.9 '[/] Y2 = 2.8 '[/] Yo = 1.8 '[/] Case Else Co = 1140 '[kN] C = 900 '[kN] n1 = 1400 '[rot/min] n2 = 1800 '[rot/min] e = 0.33 '[/] Y1 = 2.1 '[/] Y2 = 3.1 '[/] Yo = 2 '[/] End Select '--------------------------------------- ' msg = "BType = " & BType & vbCrLf & _ "BCode = " & BCode & vbCrLf & _ "dt = " & dt & vbCrLf & _ "Dn = " & Dn & vbCrLf & _ "B = " & B & vbCrLf & _ "Co = " & Co & vbCrLf & _ "C = " & C & vbCrLf & _ "n_mo = " & n1 & vbCrLf & _ "n_dau = " & n2 & vbCrLf & _ "e = " & e & vbCrLf & _ "Y1 = " & Y1 & vbCrLf & _ "Y2 = " & Y2 & vbCrLf & _ "Yo = " & Yo ' MsgBox msg, vbInformation, "Thông số của ổ lăn" '--------------------------------------- 'Tinh tai trong tuong duong (P): Dim Fa As Single, Fr As Single, qn As Single Fa = 0 '[kN] 36 Fr = RB / 1000 '[kN] If Fa / Fr <= e Then P = Fr + Y1 * Fa '[kN] Else P = 0.67 * Fr + Y2 * Fa '[kN] End If 'Tinh tuoi tho cua o Lh [h]: qn = 10 / 3 L = (C / P) ^ qn '[10^6 rev] n = Val(txtnol.Text) '[rot/min] Lh = L * 10 ^ 6 / (n * 60) '[h] '2. Thong bao ket qua: Results(30) = "28. Phản lực của các ổ trong mặt phẳng đứng, RA = " & RA1 & " [N]" Results(31) = String(75, " ") & "RB = " & RB1 & " [N]" Results(32) = "29. Phản lực của các ổ trong mặt phẳng nghiêng, RA = " & RA2 & " [N]" Results(33) = String(75, " ") & "RB = " & RB2 & " [N]" Results(34) = "30. ổ chịu tải lớn nhất: " & BName Results(35) = "31. Kiểu ổ, Type = " & BType Results(36) = "32. Mã hiệu của ổ, Code = " & BCode Results(37) = "33. Đ−ờng kính trong của ổ, d = " & CStr(dt) & " [mm]" Results(38) = "34. Đ−ờng kính ngoài của ổ, D = " & CStr(Dn) & " [mm]" Results(39) = "35. Chiều rộng của ổ, B = " & CStr(B) & " [mm]" Results(40) = "36. Khả năng chịu tải tĩnh của ổ, Co = " & CStr(Co) & " [kN]" Results(41) = "37. Khả năng chịu tải động của ổ, C = " & CStr(C) & " [kN]" Results(42) = "38. Số vòng quay giới hạn của ổ khi bôi trơn bằng mỡ, n1 = " & CStr(n1) & " [rot/min]" Results(43) = String(52, " ") & "khi bôi trơn bằng dầu, n2 = " & CStr(n2) & " [rot/min]" Results(44) = "39. Hệ số e của ổ, e = " & CStr(e) & " [/]" Results(45) = "40. Hệ số Y khi Fa/Fr <= e của ổ, Y1 = " & CStr(Y1) & " [/]" Results(46) = "41. Hệ số Y khi Fa/Fr > e của ổ, Y2 = " & CStr(Y2) & " [/]" Results(47) = "42. Hệ số Yo của ổ, Yo = " & CStr(Yo) & " [/]" Results(48) = "43. Tải trọng t−ơng đ−ơng đọng của ổ, P = " & CStr(P) & " [kN]" Results(49) = "44. Số vòng quay của ổ, n = " & CStr(n) & " [rot/min]" Results(50) = "45. Tuổi thọ tính theo giờ của ổ, Lh = " & CStr(Lh) & " [h]" Results(51) = "" ' msg = "" ' For i = 30 To 45 ' msg = msg & Results(i) & vbCrLf ' Next i ' msg = msg & "Còn nữa..." ' MsgBox msg, vbInformation, "4. Tính ổ con lăn" ' msg = "" 37 ' For i = 46 To 51 ' msg = msg & Results(i) & vbCrLf ' Next i ' MsgBox msg, vbInformation, "4. Tính ổ con lăn" End Sub '------------------------------------------ ' 5/ Hien ket qua tinh toan '------------------------------------------ Private Sub Layer5_initialize() Dim i As Integer With txtResults .Left = 960 .Top = 0 .Text = "" For i = 0 To 51 .Text = txtResults.Text & Results(i) & vbCrLf Next End With End Sub 'The end. '_____________________________________________________________________