⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 form4.frm

📁 很好的齿轮-五杆机构随参数变化的动态轨迹曲线以及速度和加速度曲线
💻 FRM
字号:
VERSION 5.00
Begin VB.Form Form4 
   BackColor       =   &H80000009&
   Caption         =   "c点速度曲线"
   ClientHeight    =   6870
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   6675
   LinkTopic       =   "Form4"
   ScaleHeight     =   6870
   ScaleWidth      =   6675
   StartUpPosition =   1  '所有者中心
   WindowState     =   2  'Maximized
   Begin VB.CommandButton Command3 
      Caption         =   "退出"
      Height          =   375
      Left            =   13560
      TabIndex        =   4
      Top             =   10200
      Width           =   1335
   End
   Begin VB.CommandButton Command2 
      Caption         =   "生成坐标"
      Height          =   375
      Left            =   10680
      TabIndex        =   3
      Top             =   10200
      Width           =   1335
   End
   Begin VB.CommandButton Command1 
      Caption         =   "生成曲线"
      Height          =   375
      Left            =   12120
      TabIndex        =   2
      Top             =   10200
      Width           =   1335
   End
   Begin VB.PictureBox Picture1 
      BackColor       =   &H00FFFFFF&
      Height          =   10000
      Left            =   120
      ScaleHeight     =   9945
      ScaleWidth      =   14745
      TabIndex        =   0
      Top             =   120
      Width           =   14805
   End
   Begin VB.Label Label1 
      BackColor       =   &H00FFFFFF&
      Caption         =   "Label1"
      Height          =   495
      Left            =   120
      TabIndex        =   1
      Top             =   10200
      Width           =   10455
   End
End
Attribute VB_Name = "Form4"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim X(10) As Double, Y(10) As Double, u1(4000) As Double, v1(4000) As Double
Dim num As Integer
Function hypot(ByVal X As Double, ByVal Y As Double)
 hypot = Sqr(X ^ 2 + Y ^ 2)
End Function

Private Sub Command1_Click()
Picture1.DrawWidth = 2
bi = Val(Form2.Text1.Text)
linkages.getvalue
Picture1.Scale (linkages.Y1 * 180 / 3.14159265358979 - 20, 100 * bi2)-(linkages.Y1 * 180 / 3.14159265358979 + linkages.Text10 * 360 + 20, -5 * bi2)

Dim i, j As Long
Do While i < linkages.num
         i = i + 1
         linkages.jisuan
        
         linkages.Y1 = linkages.Y1 + linkages.BJ '角度1=初始角度+步进角度
         linkages.Y4 = linkages.Y4 - linkages.BJ * linkages.RAB
         
         'Picture1.PSet (Me.Picture1.Width / 2 + linkages.XC * 200, Me.Picture1.Height / 2 + linkages.YC * 200), RGB(0, 0, 255)
         
         Picture1.PSet (linkages.Y1 * 180 / 3.14159265358979, linkages.VC)
         
         X(0) = X(1)
         Y(0) = Y(1)
         X(1) = X(2)
         Y(1) = Y(2)
         X(2) = X(3)
         Y(2) = Y(3)
         X(3) = linkages.Y1 * 180 / 3.14159265358979
         Y(3) = linkages.VC
                         
         If i < 4 Then GoTo l1
         
          DrawWidth = 3
          For j = 0 To 3
          Picture1.PSet (X(j), Y(j))
          Next j
          DrawWidth = 1
          tspLine 3, 2, 0, 0, 0, 0
          Picture1.PSet (u1(0), v1(0))
          For j = 1 To num - 1
          Picture1.Line -(u1(j), v1(j))
          Next j
l1: Loop

 
End Sub


Sub tspLine(ByVal n As Integer, ByVal ch As Integer, ByVal tx1 As Double, ByVal tx2 As Double, ByVal ty1 As Double, ByVal ty2 As Double)
Dim a(10) As Double, b(10) As Double, c(10) As Double, dx(10) As Double, dy(10) As Double
Dim qx(10) As Double, qy(10) As Double
Dim tt As Double, bx3 As Double, bx4 As Double, by3 As Double, by4 As Double
Dim cx As Double, cy As Double, t(10) As Double, px(10) As Double, py(10) As Double
Dim u(3) As Double, v(3) As Double, i As Integer
num = 0
For i = 1 To n
 t(i) = hypot(X(i) - X(i - 1), Y(i) - Y(i - 1))
Next i
Select Case ch
 Case 0 '抛物条件
   u(0) = (X(1) - X(0)) / t(1): u(1) = (X(2) - X(1)) / t(2)
   u(2) = (u(1) - u(0)) / (t(2) + t(1))
   tx1 = u(0) - u(2) * t(1)
   u(0) = (Y(1) - Y(0)) / t(1): u(1) = (Y(2) - Y(1)) / t(2)
   u(2) = (u(1) - u(0)) / (t(2) + t(1))
   ty1 = u(0) - u(2) * t(1)
   u(0) = (X(n) - X(n - 1)) / t(n): u(1) = (X(n - 1) - X(n - 2)) / t(n - 1)
   u(2) = (u(0) - u(1)) / (t(n) + t(n - 1))
   tx2 = u(0) + u(2) * t(n)
   u(0) = (Y(n) - Y(n - 1)) / t(n): u(1) = (Y(n - 1) - Y(n - 2)) / t(n - 1)
   u(2) = (u(0) - u(1)) / (t(n) + t(n - 1))
   ty2 = u(0) + u(2) * t(n)
 Case 1 '夹持条件
  a(0) = 1: c(0) = 0: dx(0) = tx1: dy(0) = ty1
  a(n) = 1: b(n) = 0: dx(n) = tx2: dy(n) = ty2
 Case 2 '自由条件
  a(0) = 2: c(0) = 1
  dx(0) = 3 * (X(1) - X(0)) / t(1): dy(0) = 3 * (Y(1) - Y(0)) / t(1)
  a(n) = 2: b(n) = 1
  dx(n) = 3 * (X(n) - X(n - 1)) / t(n): dy(n) = 3 * (Y(n) - Y(n - 1)) / t(n)
 Case 3 '循环条件
  a(0) = 2: c(0) = 1
  dx(0) = 3 * (X(1) - X(0)) / t(1) - (t(1) * (X(2) - X(1)) / t(2) - X(1) + X(0)) / (t(1) + t(2))
  dy(0) = 3 * (Y(1) - Y(0)) / t(1) - (t(1) * (Y(2) - Y(1)) / t(2) - Y(1) + Y(0)) / (t(1) + t(2))
  a(n) = 2: b(n) = 1
  dx(n) = 3 * (X(n) - X(n - 1)) / t(n)
  dx(n) = dx(n) + (X(n) - X(n - 1) - t(n) * (X(n - 1) - X(n - 2)) / t(n - 1)) / (t(n) + t(n - 1))
  dy(n) = 3 * (Y(n) - Y(n - 1)) / t(n)
  dy(n) = dy(n) + (Y(n) - Y(n - 1) - t(n) * (Y(n - 1) - Y(n - 2)) / t(n - 1)) / (t(n) + t(n - 1))
End Select

'计算方程组系数阵和常数阵
For i = 1 To n - 1
 a(i) = 2 * (t(i) + t(i + 1)): b(i) = t(i + 1): c(i) = t(i)
 dx(i) = 3 * (t(i) * (X(i + 1) - X(i)) / t(i + 1) + t(i + 1) * (X(i) - X(i - 1)) / t(i))
 dy(i) = 3 * (t(i) * (Y(i + 1) - Y(i)) / t(i + 1) + t(i + 1) * (Y(i) - Y(i - 1)) / t(i))
Next i

'采用追赶法解方程组
c(0) = c(0) / a(0)
For i = 1 To n - 1
 a(i) = a(i) - b(i) * c(i - 1): c(i) = c(i) / a(i)
Next i
a(n) = a(n) - b(n) * c(i - 1)
qx(0) = dx(0) / a(0): qy(0) = dy(0) / a(0)
For i = 1 To n
  qx(i) = (dx(i) - b(i) * qx(i - 1)) / a(i)
  qy(i) = (dy(i) - b(i) * qy(i - 1)) / a(i)
Next i
px(n) = qx(n): py(n) = qy(n)
For i = n - 1 To 0 Step -1
 px(i) = qx(i) - c(i) * px(i + 1)
 py(i) = qy(i) - c(i) * py(i + 1)
Next i
'计算曲线上点的坐标
For i = 0 To n - 1
 bx3 = (3 * (X(i + 1) - X(i)) / t(i + 1) - 2 * px(i) - px(i + 1)) / t(i + 1)
 bx4 = ((2 * (X(i) - X(i + 1)) / t(i + 1) + px(i) + px(i + 1)) / t(i + 1)) / t(i + 1)
 by3 = (3 * (Y(i + 1) - Y(i)) / t(i + 1) - 2 * py(i) - py(i + 1)) / t(i + 1)
 by4 = ((2 * (Y(i) - Y(i + 1)) / t(i + 1) + py(i) + py(i + 1)) / t(i + 1)) / t(i + 1)
 tt = 0
 While (tt <= t(i + 1))
  cx = X(i) + (px(i) + (bx3 + bx4 * tt) * tt) * tt
  cy = Y(i) + (py(i) + (by3 + by4 * tt) * tt) * tt
  u1(num) = cx: v1(num) = cy: num = num + 1: tt = tt + 0.5
 Wend
 u1(num) = X(i + 1): v1(num) = Y(i + 1): num = num + 1
Next i
End Sub



Private Sub Command2_Click()
Me.Picture1.Cls
Picture1.DrawWidth = 1
bi2 = Form2.Text2
zuobiao
End Sub

Private Sub Command3_Click()
Unload Me
End Sub
Private Sub Picture1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Me.Label1.Caption = "鼠标的坐标位置是θ=" & X & "     Vc=" & Y
End Sub

Private Sub zuobiao()  '速度的坐标线
 Picture1.Scale (-20, 100 * bi2)-(linkages.Text10 * 360 + 20, -5 * bi2)
'_____________下面画横坐标线__________________________________________
For i = 10 To linkages.Text10 * 360 Step 10
  Picture1.Line (i, 0)-(i, 90 * bi2), QBColor(7)
Next i
  Picture1.Line (0, 2)-(0, 0)
  Picture1.Print "θ"
For i = 0.5 To linkages.Text10 Step 0.5
  Picture1.Line (i * 360, 2)-(i * 360, 0)
  Picture1.Print "θ+" & i * 360
Next i
'_____________下面画纵坐标线__________________________________________
For i = 5 * bi2 To 90 * bi2 Step 5 * bi2
  Picture1.Line (0, i)-(linkages.Text10 * 360, i), QBColor(7)
Next i
For i = 0 To 90 * bi2 Step 10 * bi2
  Picture1.Line (0, i)-(-linkages.Text10 * 360 / 80, i)
  Picture1.Print i
Next i
'坐标线_______________________________________________________________
Picture1.Line (0, 0)-(linkages.Text10 * 360 + 10, 0)
 Picture1.Print "θ"
Picture1.Line (0, 0)-(0, 98 * bi2)
 Picture1.Print "Vc(以主动杆的速度为1,每格代表" & bi2 * 5 & "的曲线)"
End Sub

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -