53-101-79-45,精确到弟6位
没法直接上传程序文件，
下面是计算用的源程序，是早期的版本，，直接计算有一点问题，可以按速比计算！
VERSION 5.00
Object = "{5E9E78A0-531B-11CF-91F6-C2863C385E30}#1.0#0"; "MSFLXGRD.OCX"
Begin VB.Form tuneup
AutoRedraw = -1 'True
BorderStyle = 3 'Fixed Dialog
Caption = "机床调整卡计算机辅助制订程序"
ClientHeight = 5220
ClientLeft = 3330
ClientTop = 3735
ClientWidth = 8415
Icon = "tuneup.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
MDIChild = -1 'True
MinButton = 0 'False
ScaleHeight = 5220
ScaleWidth = 8415
ShowInTaskbar = 0 'False
Begin VB.TextBox Text6
BeginProperty Font
Name = "MS Sans Serif"
Size = 12
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 6120
TabIndex = 22
Text = "Text6"
Top = 3120
Width = 2175
End
Begin VB.CommandButton Command3
Appearance = 0 'Flat
Caption = "退出"
BeginProperty Font
Name = "MS Serif"
Size = 18
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 492
Left = 6840
TabIndex = 20
Top = 4440
Width = 975
End
Begin VB.OptionButton Option2
Caption = "按速比计算"
BeginProperty Font
Name = "Arial"
Size = 12
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 276
Left = 2280
TabIndex = 19
Top = 4440
Width = 1692
End
Begin VB.OptionButton Option1
BackColor = &H8000000A&
Caption = "计算差动挂轮"
BeginProperty Font
Name = "Arial"
Size = 12
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 276
Left = 360
TabIndex = 18
Top = 4440
Value = -1 'True
Width = 1812
End
Begin VB.TextBox Text5
BackColor = &H00C0C0C0&
Enabled = 0 'False
BeginProperty Font
Name = "Arial"
Size = 12
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 372
Left = 6120
TabIndex = 17
Top = 2640
Width = 2175
End
Begin VB.TextBox Text4
BeginProperty Font
Name = "MS Sans Serif"
Size = 12
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 372
Left = 6120
TabIndex = 4
Top = 1560
Width = 852
End
Begin VB.TextBox Text3
BeginProperty Font
Name = "MS Sans Serif"
Size = 12
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 372
Left = 6120
TabIndex = 3
Top = 1080
Width = 852
End
Begin VB.CommandButton Command4
Caption = "打印"
Enabled = 0 'False
BeginProperty Font
Name = "MS Serif"
Size = 18
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 1092
Left = 4320
TabIndex = 8
Top = 3840
Width = 1212
End
Begin VB.CommandButton Command2
Caption = "重输"
BeginProperty Font
Name = "MS Serif"
Size = 18
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 504
Left = 5760
TabIndex = 7
Top = 4440
Width = 975
End
Begin MSFlexGridLib.MSFlexGrid Grid
Height = 3972
Left = 120
TabIndex = 0
Top = 240
Width = 3852
_ExtentX = 6800
_ExtentY = 7011
_Version = 393216
Rows = 21
Cols = 6
End
Begin VB.CommandButton Command1
BackColor = &H000000FF&
Caption = "确认"
BeginProperty Font
Name = "MS Serif"
Size = 18
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 540
Left = 5760
MaskColor = &H00FF8080&
TabIndex = 6
Top = 3840
Width = 2055
End
Begin VB.ComboBox Combo1
BeginProperty Font
Name = "MS Sans Serif"
Size = 12
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 420
Left = 6120
TabIndex = 1
Top = 120
Width = 2175
End
Begin VB.TextBox Text2
BeginProperty Font
Name = "MS Sans Serif"
Size = 12
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 372
Left = 6120
TabIndex = 5
Top = 2040
Width = 852
End
Begin VB.TextBox Text1
BeginProperty Font
Name = "MS Sans Serif"
Size = 12
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 372
Left = 6120
TabIndex = 2
Top = 600
Width = 2175
End
Begin VB.Label Label7
Alignment = 1 'Right Justify
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "要求精度:"
BeginProperty Font
Name = "MS Sans Serif"
Size = 13.5
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 360
Index = 1
Left = 4860
TabIndex = 21
Top = 3120
Width = 1155
End
Begin VB.Label Lab
BackColor = &H00C0C0C0&
BorderStyle = 1 'Fixed Single
BeginProperty Font
Name = "Arial"
Size = 12
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 6120
TabIndex = 16
Top = 2640
Width = 1935
End
Begin VB.Label Label7
Alignment = 2 'Center
BackStyle = 0 'Transparent
Caption = "速比(a/b)*(c/d):"
BeginProperty Font
Name = "MS Sans Serif"
Size = 13.5
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Index = 0
Left = 3960
TabIndex = 15
Top = 2640
Width = 2055
End
Begin VB.Label Label6
Caption = "秒"
BeginProperty Font
Name = "MS Sans Serif"
Size = 13.5
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 6960
TabIndex = 9
Top = 1560
Width = 375
End
Begin VB.Label Label5
Caption = "分"
BeginProperty Font
Name = "MS Sans Serif"
Size = 13.5
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 6960
TabIndex = 10
Top = 1080
Width = 375
End
Begin VB.Label Label1
Caption = "度"
BeginProperty Font
Name = "MS Sans Serif"
Size = 13.5
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 372
Left = 7320
TabIndex = 11
Top = 600
Width = 252
End
Begin VB.Label Label4
Alignment = 1 'Right Justify
BackStyle = 0 'Transparent
Caption = "机床型号:"
BeginProperty Font
Name = "MS Sans Serif"
Size = 13.5
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 4800
TabIndex = 12
Top = 120
Width = 1215
End
Begin VB.Label Label3
Alignment = 1 'Right Justify
BackStyle = 0 'Transparent
Caption = "齿轮模数:"
BeginProperty Font
Name = "MS Sans Serif"
Size = 13.5
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 4800
TabIndex = 14
Top = 2040
Width = 1215
End
Begin VB.Label Label2
Alignment = 1 'Right Justify
BackStyle = 0 'Transparent
Caption = "齿轮螺旋角:"
BeginProperty Font
Name = "MS Sans Serif"
Size = 13.5
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 4560
TabIndex = 13
Top = 600
Width = 1455
End
Begin VB.Menu about
Caption = "&About"
End
Begin VB.Menu exit
Caption = "&Exit"
End
End
Attribute VB_Name = "tuneup"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim a As Integer
Dim b As Integer
Dim c As Integer
Dim d As Integer
Dim i As Integer
Dim x As Double '要求速比
Dim jd As Double '要求精度
Dim y As Double '实际速比
Dim t As Single '差动定数
Dim beta As Single '齿轮螺旋角
Dim mn As Single '齿轮模数
Dim ra(21) As Integer 'A挂轮齿数
Dim rb(21) As Integer 'B挂轮齿数
Dim rc(21) As Integer 'C挂轮齿数
Dim rd(21) As Integer 'D挂轮齿数
Dim wc(21) As Single
Dim o As Integer
Private Sub Command1_Click()
Grid.Col = 1
Grid.Row = 0
Grid.Text = "A"
Grid.Col = 2
Grid.Text = "B"
Grid.Col = 3
Grid.Text = "C"
Grid.Col = 4
Grid.Text = "D"
Grid.Col = 5
Grid.Text = "误差"
If Option1.Value = True Then
If Text1.Text = "" Or Text2.Text = "" Or Combo1.Text = "" Then
v = MsgBox("有些必要的参数未输入，请先输入数据！", , "ERROR")
Exit Sub
Else
End If
'--------------------------------------
'读取输入的参数！首先是分齿定数
Select Case Combo1.Text
Case "Y3150", "Y3180"
t = 9
Case "Y31125E", "YM31125E", "Y31200E"
t = 10
Case "3.2米俄"
t = 45
Case "LIBHER"
t = 18.75
Case "SCHIESS卧式"
t = 7.5
Case "SCHIESS立式"
t = 15
Case Else
v = MsgBox("机床型号不存在，请核查！", , "ERROR")
Exit Sub
End Select
beta = (Val(Text1.Text) + Val(Text3.Text) / 60 + Val(Text4.Text) / 3600) * 3.1415926535 / 180 '齿轮螺旋角，转化为弧度制
mn = Val(Text2.Text) '齿轮模数
'---------------------------------------------
'计算分齿参数
x = t * Sin(beta) / (mn * 3.1415926535)
Text5.Text = Str(x)
Else
x = Val(Text5.Text)
If x = 0 Then
v = MsgBox("输入数据错误，请核查！", , "ERROR")
Exit Sub
Else
End If
End If
If Val(Text6.Text) = 0 Then
jd = 0.00001
Else
jd = Text6.Text
End If
'--------------------------------------------------------------------------------------
Grid.Clear
Grid.Col = 0
For i = 1 To 20
Grid.Row = i
Grid.Text = Str(i)
Next i
Grid.Col = 1
Grid.Row = 0
Grid.Text = "A"
Grid.Col = 2
Grid.Text = "B"
Grid.Col = 3
Grid.Text = "C"
Grid.Col = 4
Grid.Text = "D"
Grid.Col = 5
Grid.Text = "误差"
'---------------------------------
'计算挂轮
o = 1 '循环变量初值
j_k = Int(x ^ 0.5 * 125)
For a = 24 To j_k
For b = 24 To 125
For c = 24 To j_k
For d = 24 To 95
y = a / b * (c / d)
If Abs(y - x) < jd And a + b - c > 52 And c + d - b > 19 And a + b >= 100 And a + b <= 190 And c + d >= 100 And c + d <= 175 And a + b + c + d > 206 Then
ra(o) = a
rb(o) = b
rc(o) = c
rd(o) = d
wc(o) = Abs(y - x)
Grid.Row = o
Grid.Col = 1
Grid.Text = Str(ra(o))
Grid.Col = 2
Grid.Text = Str(rb(o))
Grid.Col = 3
Grid.Text = Str(rc(o))
Grid.Col = 4
Grid.Text = Str(rd(o))
Grid.Col = 5
Grid.Text = Str(wc(o))
o = o + 1
Else
End If
If o >= 21 Then
Command4.Enabled = True
Exit Sub
Else
End If
Next d
Next c
Next b
Next a
Command4.Enabled = True
End Sub
Private Sub Command2_Click()
Dim key As Byte
Dim i As Integer
Dim x As Double '要求速比
Dim y As Double '实际速比
Dim t As Single '差动定数
Dim beta As Single '齿轮螺旋角
Dim mn As Single '齿轮模数
Dim ra(21) As Integer 'A挂轮齿数
Dim rb(21) As Integer 'B挂轮齿数
Dim rc(21) As Integer 'C挂轮齿数
Dim rd(21) As Integer 'D挂轮齿数
Dim wc(21) As Single
Command4.Enabled = False
Text1.Text = ""
Text2.Text = ""
Text3.Text = ""
Text4.Text = ""
Text5.Text = ""
Combo1.Text = ""
Grid.Clear
Grid.Col = 0
For i = 1 To 20
Grid.Row = i
Grid.Text = Str(i)
Next i
Grid.Col = 1
Grid.Row = 0
Grid.Text = "A"
Grid.Col = 2
Grid.Text = "B"
Grid.Col = 3
Grid.Text = "C"
Grid.Col = 4
Grid.Text = "D"
Grid.Col = 5
Grid.Text = "误差"
End Sub
Private Sub Command3_Click()
Unload Me
End Sub
Private Sub Command4_Click()
On Error GoTo errhd
i = Printer.FontSize
Printer.FontName = "Arial"
Printer.FontSize = 14
Printer.Print "--------------------------机床挂轮计算机辅助计算(Ver 1.0)-----------------------------"
Printer.Print
If Option1.Value = True Then
Printer.Print "齿轮螺旋角："; Text1.Text + "度" + Text3.Text + "分" + Text4.Text + "秒"
Printer.Print "齿轮模数："; Text2.Text
Printer.Print "机床型号："; Combo1.Text
Printer.Print "差动定数："; t
Printer.Print "理论速比："; t * Sin(beta) / (mn * 3.1415926535)
Else
Printer.Print "速比："; x
End If
Printer.Print
Printer.Print "---------------------------------------------------------------------------------------------"
Printer.Print "序号", "A", "B", "C", "D", "误差"
For i = 1 To o - 1
Printer.Print Str(i), Str(ra(i)), Str(rb(i)), Str(rc(i)), Str(rd(i)), Str(wc(i))
Next i
Printer.Print
Printer.Print "友情推荐:"
j = 1
For i = 1 To o - 1
If j >= wc(i) And wc(i) <> 0 Then
j = wc(i)
k = i
Else
End If
Next i
Printer.Print Str(k), Str(ra(k)), Str(rb(k)), Str(rc(k)), Str(rd(k)), Str(wc(k))
Printer.Print "---------------------------------------------------------------------------------------------"
Printer.Print
Printer.Print "谢谢使用！" '，并欢迎拷贝和传播!(FreeSoft---自由软件工作室)"
Printer.Print Date; Time
Printer.FontSize = i
Printer.EndDoc
'Command4.Enabled = False
On Error GoTo 0
Exit Sub
errhd:
x = MsgBox("打印机缺纸，或未正确连接打印机" + Chr(13) + "请再试一次", , "ERROR")
Command4.Enabled = True
End Sub
Private Sub exit_Click()
Unload Me
End Sub
Private Sub Form_Load()
Combo1.Clear
Combo1.AddItem "Y3150"
Combo1.AddItem "Y3180"
Combo1.AddItem "Y31125E"
Combo1.AddItem "YM31125E"
Combo1.AddItem "Y31200E"
Grid.ColWidth(0) = 350
Grid.ColWidth(1) = 400
Grid.ColWidth(2) = 400
Grid.ColWidth(3) = 400
Grid.ColWidth(4) = 400
Grid.ColWidth(5) = 1500
Grid.Col = 0
For i = 1 To 15
Grid.Row = i
Grid.Text = Str(i)
Next i
Grid.Col = 1
Grid.Row = 0
Grid.Text = "A"
Grid.Col = 2
Grid.Text = "B"
Grid.Col = 3
Grid.Text = "C"
Grid.Col = 4
Grid.Text = "D"
Grid.Col = 5
Grid.Text = "误差"
Text6.Text = ""
End Sub
Private Sub Option1_Click()
'If Option1.Value = True Then '计算差动挂轮
Combo1.Visible = True
Text1.Visible = True
Text3.Visible = True
Text4.Visible = True
Text2.Visible = True
Label1.Visible = True
Label2.Visible = True
Label3.Visible = True
Label4.Visible = True
Label5.Visible = True
Label6.Visible = True
Text5.Enabled = False
Text5.BackColor = &HC0C0C0
'Else
'End If
End Sub
Private Sub Option2_Click()
'If Option2.Value = True Then '按速比计算
Combo1.Visible = False
Text1.Visible = False
Text3.Visible = False
Text4.Visible = False
Text2.Visible = False
Label1.Visible = False
Label2.Visible = False
Label3.Visible = False
Label4.Visible = False
Label5.Visible = False
Label6.Visible = False
Text5.Enabled = True
Text5.Text = ""
Text5.BackColor = &H80000005
'Else
'End If
End Sub
Private Sub Text5_Change()
Command4.Enabled = False
End Sub |
狂战士
发表于 2006-11-3 09:22:13
| Archiver|手机版|小黑屋| 碧波制图网
Stonespider 
