module.bas

很好的齿轮－五杆机构随参数变化的动态轨迹曲线以及速度和加速度曲线

Attribute VB_Name = "Module"
Option Explicit
Public zou, bi, bi2, bi3, t, t1, bb As Double '为显示曲线图而设定的比例
Public tempf2, temp11, k, A1 As Integer  '分别定义的是周数和显示alam的窗口的条件，如何tempf2 为0的话才显示窗口。
Const pi = 3.14159265358979
Public smsg, mainmsg As String

Public conn As New ADODB.Connection   '创建一个 Connection 实例，在这里使用New等于将Dim和Set合并为一段代码执行
Public rs As ADODB.Recordset    '创建一个 Recordset 实例，不使用New 是因为，经常需要重复使用Set，因此没必要在这里使用
Public CnStr As String, Sql, sql1 As String '创建两个字符串变量分别存放两个集合的SQL语句代码段


Public Sub pduang()

linkages.getvalue         '取得数据后，进行判断条件是否符合能整周转动
'判断循环运动需要的周数_________________________________________________________________________
 k = 0
If linkages.RAB < 0 Then
bb = -(linkages.RAB)
Else
bb = linkages.RAB
End If
 If bb > 1 Then
     For k = 0 To 100 Step 1
      t1 = (1 / (bb - 1)) * (2 ^ k)
       If t1 = Int(t1) Then
       zou = t1
       GoTo l3
       End If
     Next k
 End If
 If bb = Int(bb) Then
      zou = 1
      GoTo l3
   ElseIf bb < 1 Then
     For k = 0 To 100 Step 1
       t = (1 / bb) * (2 ^ k)
       If t = Int(t) Then
       zou = t
       GoTo l3
       End If
     Next k
  

 End If
l3:
If linkages.l1 + linkages.l4 <= linkages.L2 Then
If linkages.l1 + linkages.l4 <= linkages.l3 Then
If linkages.l1 + linkages.l4 <= linkages.L5 Then

 Else
 GoTo l4
End If
Else
GoTo l4
End If
Else
GoTo l4
End If
'____________________________________________________________________________________________________
linkages.pailei          '此时数按照从小到大排列

Dim LS1, LS2, LS3, LS4, LS5 As Double
  LS1 = linkages.l1
  LS2 = linkages.L2
  LS3 = linkages.l3
  LS4 = linkages.l4
  LS5 = linkages.L5
 linkages.getvalue
 '先要符合第二章五杆机构整周转动的条件
       If LS5 < LS3 + LS4 + LS1 + LS2 Then '条件1            (1    if)
    '条件2_____________1和5杆的整周性。1.5取小值
    Dim temp2 As Double
        If linkages.l1 > linkages.L5 Then
        temp2 = linkages.L5
        Else
        temp2 = linkages.l1
        End If
       If LS5 + temp2 <= LS1 + LS2 + LS3 + LS4 - temp2 Then '        (2    if)
        If linkages.l4 > linkages.L5 Then
        temp2 = linkages.L5
        Else
        temp2 = linkages.l4
        End If
       If LS5 + temp2 <= LS1 + LS2 + LS3 + LS4 - temp2 Then '        (3    if)
'(1)_______________________________________________________ 1型组杆
If LS5 + LS1 + LS2 < LS3 + LS4 Then
  If LS5 + LS1 <= LS1 + LS2 + LS3 + LS4 Then '必须符合条件（1）
   '条件（2）
   If linkages.l1 = LS1 Then
    If linkages.L5 = LS2 Then
    smsg = ("1、AB和AE为最短杆，符合A类 1型杆组的周转条件")
    GoTo l1
    End If
    If linkages.l4 = LS2 Then
    smsg = ("1、AB和DE为最短杆，符合A类 1型杆组的周转条件")
    GoTo l1
    End If
   End If
   If linkages.L5 = LS1 Then
    If linkages.l4 = LS2 Then
    smsg = ("1、AE和DE为最短杆，符合A类 1型杆组的周转条件")
    GoTo l1
    End If
    If linkages.l1 = LS2 Then
    smsg = ("1、AE和AB为最短杆，符合A类 1型杆组的周转条件")
    GoTo l1
    End If
   End If
   If linkages.l4 = LS1 Then
    If linkages.l1 = LS2 Then
    smsg = ("1、AB和DE为最短杆，符合A类 1型杆组的周转条件")
    GoTo l1
    End If
    If linkages.L5 = LS2 Then
    smsg = ("1、AE和DE为最短杆，符合A类 1型杆组的周转条件")
    GoTo l1
    End If
   End If
  End If
End If
'(2)_______________________________________________________ 2型组

If LS5 + LS1 + LS2 > LS3 + LS4 Then
 MsgBox ("输入条件属于 2类,有待后续开发！")
 GoTo End1
   '！！！条件（3）
    Dim u, v As Double
    u = (linkages.l1 ^ 2 + linkages.L2 - (linkages.L2 + linkages.l3 - linkages.L5) ^ 2) / (2 * linkages.l1 * linkages.L2)
    v = (linkages.l1 ^ 2 + linkages.L2 - (linkages.L2 + linkages.l3 + linkages.L5) ^ 2) / (2 * linkages.l1 * linkages.L2)
       If (Cos(linkages.Y1) + u) * (Cos(pi - linkages.Y4)) > 0 Then
          smsg = ("1、属于 2型机构，符合整周运动的条件！")
          GoTo l1
          GoTo End1
       End If
       MsgBox ("属于 2型机构，但是由于初始角的问题，不符合整周运动的条件！")
  
End If
'(3)_______________________________________________________ 3型组杆
If LS5 + LS1 + LS2 = LS3 + LS4 Then
      If linkages.RAB = linkages.Y4 / pi Then
      MsgBox ("由于初始角度的关系不符合A类 3型杆组的周转条件")
      '要结束程序??????????
      GoTo End1
      End If
  If LS5 + LS1 <= LS1 + LS2 + LS3 + LS4 Then '必须符合条件（1）
   '条件（2）
   If linkages.l1 = LS1 Then
    If linkages.L5 = LS2 Then
    smsg = ("1、AB和AE为最短杆，符合A类 3型杆组的周转条件")
    GoTo l1
    End If
    If linkages.l4 = LS2 Then
    smsg = ("1、AB和DE为最短杆，符合A类 3型杆组的周转条件")
    GoTo l1
    End If
   End If
   If linkages.L5 = LS1 Then
    If linkages.l4 = LS2 Then
    smsg = ("1、AE和DE为最短杆，符合A类 3型杆组的周转条件")
    GoTo l1
    End If
    If linkages.l1 = LS2 Then
    smsg = ("1、AE和AB为最短杆，符合A类 3型杆组的周转条件")
    GoTo l1
    End If
   End If
   If linkages.l4 = LS1 Then
    If linkages.l1 = LS2 Then
    smsg = ("1、AB和DE为最短杆，符合A类 3型杆组的周转条件")
    GoTo l1
    End If
    If linkages.L5 = LS2 Then
    smsg = ("1、AE和DE为最短杆，符合A类 3型杆组的周转条件")
    GoTo l1
    End If
   End If
  End If
End If
End If '        (3    if)
End If '        (2    if)
End If '        (1    if)

MsgBox ("五杆机构不符合整周转动安装条件！")
GoTo End1
l1:
    alarm.Label4.Visible = False '先把两个可能不显示的控建屏蔽
    
    alarm.label1.Caption = smsg
    alarm.Label2.Caption = "2、连杆AB长度：" & linkages.Text1.Text & "；连杆BC长度：" & linkages.Text2.Text & "；连杆CD的长度：" & linkages.Text3.Text & "；连架杆DE的长度：" & linkages.Text4.Text & "；机架AE的长度：" & linkages.Text5.Text & "；齿轮的传动比：" & linkages.Text6.Text & "；初始角θ：" & linkages.Text7.Text & "；初始角φ：" & linkages.Text8.Text
    
    alarm.Label3.Caption = "3、经过计算，c点完成一个循环需要主动杆转" & zou & " 周。"
    If zou > 10000 Then
    alarm.Label3.Caption = "3、经过计算，C完成一个循环可能需要主动杆转动无限转。"
    End If
    If zou > 10 Then
    alarm.Label4.Visible = True
    
    zou = 10
    End If
   
    alarm.Text2.Text = zou
 
    alarm.Show
linkages.Command3.Enabled = True
GoTo End1
l4:     MsgBox ("不符合双曲柄条件！")
End1: End Sub


Public Sub clear() '清空数据库的程序
Dim i As Long

                i = 1
                linkages.getvalue
                Do While i < linkages.num
                Sql = "delete *  from tempdata where id=" & i & " " 'SQL查询语句
                'Sql = "select  top 1 * from tempdata  Order By id asc"
                Set rs = New ADODB.Recordset '新建一个实例
                rs.Open Sql, conn, 1, 3
                i = i + 1
                Loop
                MsgBox ("数据库清空！")

End Sub