自定义过程.bas

本程序针对Y180L-6三相感应电动机而设计

Attribute VB_Name = "自定义过程"
Rem  (1)查线规
Public Function Ac(ByVal d11)
   Dim i As Integer
   Dim d() As Variant, s() As Variant
   d = Array(0.71, 0.75, 0.77, 0.8, 0.83, 0.85, 0.8, 0.93, 0.95, 1, 1.06, 1.12, _
   1.18, 1.25, 1.3, 1.35, 1.4, 1.45, 1.5, 1.56, 1.6, 1.7, 1.8, 1.9, 2)
   s = Array(0.3959, 0.4418, 0.4657, 0.5227, 0.541, 0.5675, 0.6362, 0.6793, _
   0.7088, 0.7854, 0.8825, 0.9852, 1.0936, 1.2272, 1.3273, 1.4314, 1.5394, 1.6513, _
   1.7672, 1.9114, 2.0106, 2.2698, 2.5447, 2.8353, 3.1416)
   For i = 0 To 24
     If d11 = d(i) Then
     Ac = s(i): Exit For
     End If
   Next i
End Function

Rem  (2)求波幅系数Fs
Public Sub Fs1()
   If Ks1 <= 1.25 Then
   Fs = 1.97 - 0.4 * Ks1
   Else
   Fs = 1.49 - (0.425 * Ks1 - 0.51) / (1.15 * Ks1 - 0.38)
   End If
End Sub

Rem  (3)查磁化曲线
Public Function cihua(ByVal B1 As Double)
   Dim H As Double
   If B1 >= 0.4 And B1 < 1.1 Then
   H = -0.4614 + 8.319 * B1 - 12.87 * B1 ^ 2 + 8.9 * B1 ^ 3
   ElseIf B1 >= 1.1 And B1 < 1.37 Then
   H = 46.158 - 85.84 * B1 + 44 * B1 ^ 2
   ElseIf B1 >= 1.37 And B1 < 1.5 Then
   H = 179.485 - 215.5 * B1 + 13.54 * B1 ^ 2 + 39.5 * B1 ^ 3
   ElseIf B1 >= 1.5 And B1 < 1.9 Then
   H = 1690.465 - 2324.85 * B1 + 807.5 * B1 ^ 2
   End If
   cihua = H
End Function

Rem  (41)查定子轭部校正系数Cj1
Public Function Cjs(ByVal p1 As Double, ByVal B2 As Double, ByVal hc1 As Double)
  If p = 1 Then
      If B2 < 1.395 Then
      Cjs = (0.085 - 0.038 * hc1 - 0.08 * hc1 ^ 2) * (1.395 - B2) / 0.155 + 0.37 + 1.51 * hc1 - 1.887 * hc1 ^ 2
      ElseIf B2 >= 1.395 And B2 < 1.55 Then
      Cjs = (0.07 + 0.948 * hc1 - 3.031 * hc1 ^ 2) * (1.55 - B2) / _
      0.155 + 0.3 + 0.56 * hc1 + 1.144 * hc1 ^ 2
      Else: Cjs = (0.033 + 0.24 * hc1 - 0.084 * hc1 ^ 2) * (1.71 - B2) / _
      0.16 + 0.267 + 0.316 * hc1 + 1.227 * hc1 ^ 2
      End If
  ElseIf p = 2 Then
      If B2 < 1.395 Then
      Cjs = (0.089 - 0.06535 * hc1 - 0.2174 * hc1 ^ 2) * (1.395 - B2) / 0.155 + 0.361 + 0.8633 * hc1 - 0.6752 * hc1 ^ 2
      ElseIf B2 >= 1.395 And B2 < 1.55 Then
      Cjs = (0.057 + 0.5283 * hc1 - 1.3152 * hc1 ^ 2) * (1.55 - B2) / _
      0.155 + 0.304 + 0.335 * hc1 + 0.64 * hc1 ^ 2
      Else: Cjs = (0.038 + 0.144 * hc1 - 0.015 * hc1 ^ 2) * (1.71 - B2) / _
      0.16 + 0.266 + 0.191 * hc1 + 0.625 * hc1 ^ 2
      End If
  ElseIf p = 3 Then
      If B2 < 1.395 Then
      Cjs = (0.18 - 0.004 * hc1 + 0.94 * hc1 ^ 2) * (1.395 - B2) / 0.155 + 0.36 + 0.144 * hc1 + 0.645 * hc1 ^ 2
      ElseIf B2 >= 1.395 And B2 < 1.55 Then
      Cjs = (0.055 + 0.1656 * hc1 + 0.0194 * hc1 ^ 2) * (1.55 - B2) / _
      0.155 + 0.305 - 0.0216 * hc1 + 0.6265 * hc1 ^ 2
      Else: Cjs = (0.031 + 0.2 * hc1 - 0.9844 * hc1 ^ 2) * (1.71 - B2) / _
      0.16 + 0.274 - 0.224 * hc1 + 1.61 * hc1 ^ 2
      End If
  End If
  If Cjs > 0.7 Then
  Cjs = 0.7
  End If
End Function

Rem  (42)查转子轭部校正系数Cj2
Public Function Cjr(ByVal p1 As Double, ByVal B3 As Double, ByVal hc2 As Double)
  If p = 1 Then
      If B3 < 1.395 Then
      Cjr = (0.0812 - 0.3 * hc2 + 0.65 * hc2 ^ 2) * (1.395 - B3) / 0.155 + 0.364 - 0.8 * hc2 + 2.34 * hc2 ^ 2
      ElseIf B3 >= 1.395 And B3 < 1.55 Then
      Cjr = (0.0655 + 0.494 * hc1 - 0.92 * hc1 ^ 2) * (1.55 - B3) / _
      0.155 + 0.2985 - 1.294 * hc2 + 3.26 * hc2 ^ 2
      Else: Cjr = (0.0355 - 0.214 * hc2 + 0.582 * hc2 ^ 2) * (1.71 - B3) / _
      0.16 + 0.263 - 1.08 * hc2 + 2.732 * hc2 ^ 2
      End If
  ElseIf p = 2 Then
      If B3 < 1.395 Then
      Cjr = (0.0975 - 0.514 * hc2 + 3.334 * hc2 ^ 2) * (1.395 - B3) / 0.155 + 0.3535 - 0.0489 * hc2 - 0.5 * hc2 ^ 2
      ElseIf B3 >= 1.395 And B3 < 1.55 Then
      Cjr = (0.05 + 0.545 * hc1 - 2.06 * hc1 ^ 2) * (1.55 - B3) / _
      0.155 + 0.304 - 0.594 * hc2 + 1.56 * hc2 ^ 2
      Else: Cjr = (0.0302 - 0.204 * hc2 + 0.49 * hc2 ^ 2) * (1.71 - B3) / _
      0.16 + 0.2716 - 0.39 * hc2 + 1.07 * hc2 ^ 2
      End If
  ElseIf p = 3 Then
      If B3 < 1.395 Then
      Cjr = (0.18 - 0.004 * hc2 + 0.94 * hc2 ^ 2) * (1.395 - B3) / 0.155 + 0.36 + 0.144 * hc2 + 0.645 * hc2 ^ 2
      ElseIf B3 >= 1.395 And B3 < 1.55 Then
      Cjr = (0.054 + 0.244 * hc1 - 0.733 * hc1 ^ 2) * (1.55 - B3) _
      / 0.155 + 0.306 - 0.1 * hc2 + 1.378 * hc2 ^ 2
      Else: Cjr = (0.033 + 0.124 * hc2 - 0.629 * hc2 ^ 2) * (1.71 - B3) _
      / 0.16 + 0.273 - 0.224 * hc2 + 2.07 * hc2 ^ 2
      End If
  End If
  If Cjr > 0.7 Then
  Cjr = 0.7
  End If
End Function

Rem  (5)求定子槽比漏磁导λL1
Public Sub Lou1()
   Dim x, b As Double
   x = h21 / 2 / r21: b = b11 / 2 / r21
   If b <> 1 Then
   λL1 = 1 / (x * (1 + b) + Pi / 4) ^ 2 * (x ^ 3 * ((3 + b) / 4 - (3 - b) / _
   2 / (1 - b) ^ 2) - Pi * x ^ 2 / 2 * (1 / (1 - b) - 0.5) - (Pi ^ 2 * x / 16 / _
   (1 - b) + Pi * x ^ 2 / 2 / (1 - b) ^ 2 + x ^ 3 / (1 - b) ^ 3) * Log(b))
   Else: λL1 = 1 / (2 * x + Pi / 4) ^ 2 * (Pi ^ 2 * x / 16 + Pi * x ^ 2 / 2 + 4 * x ^ 3 / 3)
   End If
End Sub

Rem  (6)求定子谐波比漏辞导系数Σs
Public Function s(ByVal q, ByVal b)
   Dim ε As Double
   ε = 3 * q * (1 - b)
   If b >= 2 / 3 And b <= 1 Then
   s = Pi ^ 2 / 54 * ((5 * q ^ 2 + 1) - (3 / 2 * ε ^ 2 + ε / 4 / q - ε ^ 3 / 4 / q)) / q ^ 2 - Kdp1 ^ 2
   ElseIf b >= 1 / 3 And b < 2 / 3 Then
   s = Pi ^ 2 / 72 * ((5 * q ^ 2 + 1) - (2 / 3 * (ε - q) / q + _
   (ε - q) ^ 2 - 2 * (ε - q) ^ 3 / 3 / q + 3 * q * (ε - q))) / q ^ 2 - Kdp1 ^ 2
   End If
End Function

Rem  (7)求凸形槽下部比漏磁导系数Kr
Public Function Kr(ByVal b, K As Integer)
   If b <> 1 Then
      If K = 1 Then
      Kr = (3 * b + 1) / 16 + 3 * b ^ 2 / 8 / (1 - b) - 2 * b ^ 2 / _
      8 / (1 - b) ^ 2 + b ^ 4 * Log(1 / b) / 4 / (1 - b) ^ 3
      ElseIf K = 2 Then
      Kr = 0.5 + b ^ 2 * (1 / b - Log(1 / b) - 1) / (1 - b) ^ 2
      ElseIf K = 3 Then
      Kr = b * Log(1 / b) / (1 - b)
      End If
   Else
      If K = 1 Then
      Kr = 1 / 3
      ElseIf K = 2 Or 3 Then
      Kr = 1
      End If
   End If
End Function

Rem  (8)求转子谐波比漏辞导系数ΣR
Public Function R(ByVal p, ByVal Z2)
   Dim j
   R = 0
   For j = 1 To 300
   R = R + 1 / (2 * Z2 * j / 2 / p + 1) ^ 2 + 1 / (2 * Z2 * j / 2 / p - 1) ^ 2
   Next j
End Function

Rem  (9)查轭部损耗曲线
Public Function p1(ByVal B4 As Double)
   Dim i As Integer
   Dim b() As Variant, p() As Variant
   b = Array(1, 1.01, 1.02, 1.03, 1.04, 1.05, 1.06, 1.07, 1.08, 1.09, _
           1.1, 1.11, 1.12, 1.13, 1.14, 1.15, 1.16, 1.17, 1.18, 1.19, _
           1.2, 1.21, 1.22, 1.23, 1.24, 1.25, 1.26, 1.27, 1.28, 1.29, _
           1.3, 1.31, 1.32, 1.33, 1.34, 1.35, 1.36, 1.37, 1.38, 1.39, _
           1.4, 1.41, 1.42, 1.43, 1.44, 1.45, 1.46, 1.47, 1.48, 1.49, _
           1.5, 1.51, 1.52, 1.53, 1.54, 1.55, 1.56, 1.57, 1.58, 1.59, _
           1.6, 1.61, 1.62, 1.63, 1.64, 1.65, 1.66, 1.67, 1.68, 1.69, _
           1.7, 1.71, 1.72, 1.73, 1.74, 1.75, 1.76, 1.77, 1.78, 1.79, _
           1.8, 1.81, 1.82, 1.83, 1.84, 1.85, 1.86, 1.87, 1.88, 1.89)
   p = Array(2.1, 2.14, 2.19, 2.23, 2.28, 2.32, 2.36, 2.4, 2.45, 2.49, _
           2.53, 2.57, 2.62, 2.66, 2.71, 2.75, 2.8, 2.85, 2.9, 2.95, _
           3, 3.05, 3.1, 3.16, 3.21, 3.26, 3.32, 3.38, 3.44, 3.5, _
           3.56, 3.62, 3.67, 3.73, 3.78, 3.84, 3.91, 3.98, 4.06, 4.13, _
           4.2, 4.28, 4.36, 4.44, 4.52, 4.6, 4.7, 4.8, 4.9, 5, _
           5.1, 5.22, 5.34, 5.46, 5.58, 5.7, 5.84, 5.98, 6.12, 6.26, _
           6.4, 6.53, 6.66, 6.8, 6.93, 7.06, 7.18, 7.28, 7.41, 7.52, _
           7.64, 7.7, 7.77, 7.83, 7.9, 7.96, 8, 8.04, 8.07, 8.11, _
           8.15, 8.24, 8.33, 8.42, 8.51, 8.6, 8.7, 8.8, 8.9, 9)
   For i = 0 To 89
       If B4 = b(i) Then
          p1 = p(i): Exit For
       ElseIf B4 > b(i) And B4 < b(i + 1) Then
          p1 = p(i) + (p(i + 1) - p(i)) * (B4 - b(i)) / (b(i + 1) / b(i))
          Exit For
       End If
   Next i
End Function

Rem  (10)查起动时漏磁饱和系数Kz
Public Function Kz1(ByVal BL)
   If BL > 0 And BL <= 1.75 Then
   Kz1 = 1 - BL * (1.143 + 0.9524 * BL) / 100
   ElseIf BL > 1.75 And BL <= 6 Then
   Kz1 = 1.36787 - BL * (30 - 2.202 * BL) / 100
   ElseIf BL > 6 And BL <= 10 Then
   Kz1 = 0.67976 - BL * (6.768 - 0.2251 * BL) / 100
   ElseIf BL > 10 And BL <= 15 Then
   Kz1 = 0.5147 - BL * (3.389 - 1.0564 * BL) / 100
   End If
End Function

Rem  (11)查转子肌肤效应系数KF,Kx
Public Function KFx(ByVal ξ, i)                  'i=1,求转子电阻增加系数KF;i=2,求电抗减少系数Kx
   If i = 1 Then
      KF = ξ * ((Exp(2 * ξ) - Exp(-2 * ξ)) / 2 + Sin(2 * ξ)) / ((Exp(2 * ξ) + Exp(-2 * ξ)) / 2 - Cos(2 * ξ))
      hpr = (h12 + h22 + h32) * Ka / KF
      If hpr > (h12 + h22) Then
          hr = hpr - (h12 + h22)
          bpr = b42 + (b32 - b42) * (h12 + h22 + h32 - hpr) / h32
          KF = AB / (AB1 + AB2 + (bpr + b32) * hr / 2)
      Else
          hr1 = hpr - h12
          bpr1 = b12 + (b22 - b12) * hr1 / h22
          KF = AB / (AB1 + (b12 + bpr1) * hr1 / 2)
      End If
      KFx = KF
   ElseIf i = 2 Then
      Kx = 3 / 2 / ξ * ((Exp(2 * ξ) - Exp(-2 * ξ)) / 2 - Sin(2 * ξ)) / ((Exp(2 * ξ) + Exp(-2 * ξ)) / 2 - Cos(2 * ξ))
      KFx = Kx
   End If
End Function

Rem  (12)求截面宽度突变系数Ka
Public Function Ka1(ByVal b)
   If b > 1 And b < 1.65 Then
   Ka1 = 0.07 * Exp(-(b - 1)) + 0.93
   ElseIf b >= 1.65 Then
   Ka1 = 0.07 * Exp(-(b - 1.25)) + 0.919
   End If
End Function