frmoptionxhdla.frm

来自「齿轮传动设计计算的开发软件」· FRM 代码 · 共 735 行 · 第 1/2 页

        n(2, x) = nn2(x)
        Next x
        For x = 1 To 18
        n(3, x) = nn3(x)
        Next x
        For x = 1 To 17
        n(4, x) = nn4(x)
        Next x
        For x = 1 To 17
        n(5, x) = nn5(x)
        Next x
        For x = 1 To 16
        n(6, x) = nn6(x)
        Next x
        Open App.Path + "\b10-6z.dat" For Input As #1
        For x = 1 To 6
           Input #1, d(1, x)
        Next x
        For x = 1 To 6
         For y = 1 To 16
           Input #1, p(1, x, y)
         Next y
         Next x
         Close
       Open App.Path + "\b10-6a.dat" For Input As #1
        For x = 1 To 8
           Input #1, d(2, x)
        Next x
        For x = 1 To 8
         For y = 1 To 16
           Input #1, p(2, x, y)
         Next y
         Next x
         Close
        Open App.Path + "\b10-6b.dat" For Input As #1
        For x = 1 To 8
           Input #1, d(3, x)
        Next x
        For x = 1 To 8
         For y = 1 To 18
           Input #1, p(3, x, y)
         Next y
         Next x
         Close
        Open App.Path + "\b10-6c.dat" For Input As #1
        For x = 1 To 8
           Input #1, d(4, x)
        Next x
        For x = 1 To 8
         For y = 1 To 17
           Input #1, p(4, x, y)
         Next y
         Next x
         Close
        Open App.Path + "\b10-6d.dat" For Input As #1
        For x = 1 To 8
           Input #1, d(5, x)
        Next x
        For x = 1 To 8
         For y = 1 To 17
           Input #1, p(5, x, y)
         Next y
         Next x
         Close
         Open App.Path + "\b10-6e.dat" For Input As #1
        For x = 1 To 8
           Input #1, d(6, x)
        Next x
        For x = 1 To 8
         For y = 1 To 16
           Input #1, p(6, x, y)
         Next y
         Next x
         Close
       j = 1
       While xh1 <> belttype(j)        '定位最大行j
       j = j + 1
       Wend
       Dim xmax As Integer  '表示每种带型具有的带轮直径个数
       Dim ymax As Integer  '表示每种带型具有的转速个数
       If j = 1 Then
          xmax = 5: ymax = 17
          ElseIf j = 2 Then
          xmax = 8: ymax = 16
          ElseIf j = 3 Then
          xmax = 8: ymax = 18
          
        ElseIf j = 4 Then
          xmax = 8: ymax = 17
         ElseIf j = 5 Then
          xmax = 8: ymax = 17
        Else
          xmax = 8: ymax = 16
        End If
        For x = 1 To xmax - 1
            If dd1 <= d(j, x) Then Exit For  '定位行是x
        Next x
        For y = 1 To ymax - 1
         If n1 <= n(j, y) Then Exit For   '定位列是y
        Next y
        If x = 1 And y = 1 Then
        x = x + 1: y = y + 1
        ElseIf y = 1 Then
             y = y + 1
        ElseIf x = 1 Then
             x = x + 1
        End If
        Rem 插值法求出基本额定功率p1：
        p11 = p(j, (x - 1), (y - 1)) + (p(j, (x - 1), y) - p(j, (x - 1), (y - 1))) / (n(j, y) - n(j, (y - 1))) * (n1 - n(j, (y - 1)))
        p12 = p(j, x, (y - 1)) + (p(j, x, y) - p(j, x, (y - 1))) / (n(j, y) - n(j, (y - 1))) * (n1 - n(j, (y - 1)))
        p1 = p11 + (p12 - p11) / (d(j, x) - d(j, (x - 1))) * (dd1 - d(j, (x - 1)))
        
End Sub

Sub beltdp1()
Rem 输入参数:     带型xh1
Rem 输入参数:     传动比sis
Rem 输入参数:     带速v1
Rem 输入参数:     功率增量dp1
'数据文件  B10-7I.DAT存储传动比
'数据文件  B10-7Z.DAT,B10-7A.DAT,B10-7B.DAT,B10-7C.DAT,B10-7D.DAT,B10-7E.DAT
'存储Z,A,B,C,D,E型号的线速度，功率增量
Dim m As Integer   '存储行数
Dim n As Integer   '存储列数
Dim i As Integer
Dim j As Integer
Dim x As Integer
Dim y As Integer
Dim p11 As Single
Dim p12 As Single
Dim ii(11) As Single '存储传动比
Dim Vv()             '动态数组，存储线速度
Dim DP()             '动态数组，存储功率增量
m = 10               '传动比共有10行
Open App.Path + "\B10-7I.DAT" For Input As #1
For i = 1 To m
Input #1, ii(i)
Next i
Close #1
If xh1 = "Z" Then
Open App.Path + "\B10-7Z.DAT" For Input As #1
n = 15
ReDim Vv(n), DP(m, n)
For j = 1 To n
Input #1, Vv(j)
Next j
For i = 1 To m
For j = 1 To n
   Input #1, DP(i, j)
   Next j
 Next i
 Close #1
 ElseIf xh1 = "A" Then
Open App.Path + "\B10-7A.DAT" For Input As #1
n = 10
ReDim Vv(n), DP(m, n)
For j = 1 To n
Input #1, Vv(j)
Next j
For i = 1 To m
For j = 1 To n
   Input #1, DP(i, j)
   Next j
 Next i
 Close #1
ElseIf xh1 = "B" Then
Open App.Path + "\B10-7B.DAT" For Input As #1
n = 8
ReDim Vv(n), DP(m, n)
For j = 1 To n
Input #1, Vv(j)
Next j
For i = 1 To m
For j = 1 To n
   Input #1, DP(i, j)
   Next j
 Next i
 Close #1
ElseIf xh1 = "C" Then
Open App.Path + "\B10-7C.DAT" For Input As #1
n = 9
ReDim Vv(n), DP(m, n)
For j = 1 To n
Input #1, Vv(j)
Next j
For i = 1 To m
For j = 1 To n
   Input #1, DP(i, j)
   Next j
 Next i
 Close #1
ElseIf xh1 = "D" Then
Open App.Path + "\B10-7D.DAT" For Input As #1
n = 9
ReDim Vv(n), DP(m, n)
For j = 1 To n
Input #1, Vv(j)
Next j
For i = 1 To m
For j = 1 To n
   Input #1, DP(i, j)
   Next j
 Next i
 Close #1
ElseIf xh1 = "E" Then
Open App.Path + "\B10-7E.DAT" For Input As #1
n = 9
ReDim Vv(n), DP(m, n)
For j = 1 To n
Input #1, Vv(j)
Next j
For i = 1 To m
For j = 1 To n
   Input #1, DP(i, j)
   Next j
 Next i
 Close #1
   End If

For x = 1 To m - 1
    If sis <= ii(x) Then Exit For '定位行是x
    Next x
    For y = 1 To n - 1
    If sis <= Vv(y) Then Exit For '定位列是y
    Next y
    If x = 1 And y = 1 Then
    x = x + 1: y = y + 1
    ElseIf y = 1 Then
      y = y + 1
    ElseIf x = 1 Then
      x = x + 1
     End If
Rem 用插值法求功率增量dp1
If sis <= 1.01 Then
dp1 = 0
ElseIf sis < 2 Then
p11 = DP((x - 1), (y - 1)) + (DP((x - 1), y) - DP((x - 1), (y - 1))) / (Vv(y) - Vv(y - 1)) * (v1 - Vv(y - 1))
p12 = DP(x, (y - 1)) + (DP(x, y) - DP(x, (y - 1))) / (Vv(y) - Vv(y - 1)) * (v1 - Vv(y - 1))
dp1 = p11 + (p12 - p11) / (ii(x) - ii(x - 1)) * (sis - ii(x - 1))
dp1 = Int(dp1 * 1000) / 1000
ElseIf sis > 2 Then
dp1 = DP(x, (y - 1)) + (DP(x, y) - DP(x, (y - 1))) / (Vv(y) - Vv(y - 1)) * (v1 - Vv(y - 1))
dp1 = Int(dp1 * 1000) / 1000
  
  End If
  
  End Sub
  
Sub beltKL(a0 As Single)  '功能：查询普通V带长度系数KL
Rem 输入参数:  中心距a0
Rem 输入参数:  带型 xh1
Rem 输入参数:  小带轮直径 dd1
Rem 输入参数:  大带轮直径 dd2
Rem 输出参数:  V带基准长度 Ld
Rem 输出参数:  长度系数 kL
Rem 输出参数:  中心距 a0
Rem 输出参数:  最大中心距 AMAX
Rem 输出参数:  最小中心距 AMIN
Rem 输出参数:  小带轮包角 X1
'数据文件 B10-9Z.DAT,B10-9A.DAT,B10-9B.DAT,B10-9C.DAT,B10-9D.DAT,B10-9E.DAT
'存储Z,A,B,C,D,E型带标准长度，长度系数
  Dim i As Integer
  Dim Ld0 As Single     '初选带长
  Dim m As Integer      '数据文件中各带型的数据行数
  Dim zL() As Single    '动态数组，存储带长
  Dim kk() As Single    '动态数组，存储长度系数
Ld0 = 2 * a0 + 3.14159 * (dd1 + dd2) / 2 + (dd2 - dd1) ^ 2 / (4 * a0)
If xh1 = "Z" Then
      m = 14
      ReDim zL(m), kk(m) '为动态数组确定下标上界
      Open App.Path + "\B10-9Z.DAT" For Input As #1
      For i = 1 To m
      Input #1, zL(i), kk(i)
      Next i
      Close #1
ElseIf xh1 = "A" Then
      m = 17
      ReDim zL(m), kk(m) '为动态数组确定下标上界
      Open App.Path + "\B10-9A.DAT" For Input As #1
      For i = 1 To m
      Input #1, zL(i), kk(i)
      Next i
      Close #1
ElseIf xh1 = "B" Then
      m = 16
      ReDim zL(m), kk(m) '为动态数组确定下标上界
      Open App.Path + "\B10-9B.DAT" For Input As #1
      For i = 1 To m
      Input #1, zL(i), kk(i)
      Next i
      Close #1
ElseIf xh1 = "C" Then
      m = 17
      ReDim zL(m), kk(m) '为动态数组确定下标上界
      Open App.Path + "\B10-9C.DAT" For Input As #1
      For i = 1 To m
      Input #1, zL(i), kk(i)
      Next i
      Close #1
ElseIf xh1 = "D" Then
      m = 16
      ReDim zL(m), kk(m) '为动态数组确定下标上界
      Open App.Path + "\B10-9A.DAT" For Input As #1
      For i = 1 To m
      Input #1, zL(i), kk(i)
      Next i
      Close #1
ElseIf xh1 = "E" Then
      m = 12
      ReDim zL(m), kk(m) '为动态数组确定下标上界
      Open App.Path + "\B10-9E.DAT" For Input As #1
      For i = 1 To m
      Input #1, zL(i), kk(i)
      Next i
      Close #1
End If
For i = 1 To m - 1
If Ld0 <= zL(i) Then Exit For '定位行是i
Next
If i = 1 Then i = i + 1
If Abs(Ld0 - zL(i - 1)) < Abs(Ld0 - zL(i)) Then
Ld = zL(i - 1): kL = kk(i - 1)
Else
Ld = zL(i): kL = kk(i)
End If
a = (Ld / 4 - 3.14159 * (dd2 + dd1) / 8) + Sqr((Ld / 4 - 3.14159 * (dd2 + dd1) / 8) ^ 2 - ((dd2 - dd1) ^ 2 / 8))
a = Int(a * 1000) / 1000
amin = a - 0.015 * Ld: amax = a + 0.03 * Ld
x1 = 180 - 57.3 * (dd2 - dd1) / a
x1 = Int(x1 * 100) / 100
End Sub
Sub beltsize(df0 As Single)  '功能：查询V带初拉力增量df0，单位长度质量q
Rem 输入参数：带型号xh1
Rem 输出参数：单位长度质量q
Rem 输出参数：初拉力增量df0
Dim beltq()
Dim beltxh()
Dim x As Integer
Dim df
beltq = Array(1.02, 0.06, 0.1, 0.17, 0.3, 0.62, 0.9)
beltxh = Array("Y", "Z", "A", "B", "C", "D", "E")
df = Array(6, 10, 15, 20, 29.4, 58.5, 108)
For x = 1 To 6
   If xh1 = beltxh(x) Then Exit For
   Next x
     q = beltq(x)
     df0 = df(x)

End Sub

Private Sub kalf1()  '功能：查询带传动的包角系数
Rem  输入参数：包角x1（度）
Rem  输入参数：包角系数kalf1
Dim alf1
Dim kalf1
Dim x As Integer
alf1 = Array(90, 95, 100, 105, 110, 115, 120, 125, 130, 135, 140, 150, 155, 160, 165, 170, 175, 180)
kalf1 = Array(0.69, 0.72, , 0.74, 0.76, 0.78, 0.8, 0.82, 0.84, 0.86, 0.88, 0.89, 0.91, 0.92, 0.93, 0.95, 0.96, 0.98, 0.99, 1)
For x = 1 To 18
  If x1 <= alf1(x) Then Exit For '定位列是x
  Next x
  If x = 1 Then x = x + 1
  kalf = kalf1(x - 1) + (kalf1(x) - kalf1(x - 1)) * (x1 - alf1(x - 1)) / (alf1(x) - alf1(x - 1))
  kalf = Int(kalf * 1000) / 1000

End Sub