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

📄 form5.frm

📁 很好的齿轮-五杆机构随参数变化的动态轨迹曲线以及速度和加速度曲线
💻 FRM
字号:
VERSION 5.00
Begin VB.Form Form5 
   BackColor       =   &H80000009&
   Caption         =   "c点加速度曲线"
   ClientHeight    =   6915
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   6225
   LinkTopic       =   "Form5"
   ScaleHeight     =   6915
   ScaleWidth      =   6225
   StartUpPosition =   1  '所有者中心
   WindowState     =   2  'Maximized
   Begin VB.CommandButton Command3 
      Caption         =   "生成坐标"
      Height          =   375
      Left            =   11520
      TabIndex        =   4
      Top             =   10200
      Width           =   1095
   End
   Begin VB.CommandButton Command2 
      Caption         =   "退出"
      Height          =   375
      Left            =   13920
      TabIndex        =   2
      Top             =   10200
      Width           =   1095
   End
   Begin VB.CommandButton Command1 
      Caption         =   "生成曲线"
      Height          =   375
      Left            =   12720
      TabIndex        =   1
      Top             =   10200
      Width           =   1095
   End
   Begin VB.PictureBox Picture1 
      BackColor       =   &H00FFFFFF&
      Height          =   10000
      Left            =   120
      ScaleHeight     =   9945
      ScaleWidth      =   14835
      TabIndex        =   0
      Top             =   120
      Width           =   14895
   End
   Begin VB.Label Label1 
      BackColor       =   &H00FFFFFF&
      Caption         =   "Label1"
      Height          =   375
      Left            =   120
      TabIndex        =   3
      Top             =   10200
      Width           =   10575
   End
End
Attribute VB_Name = "Form5"
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 * bi3)-(linkages.Y1 * 180 / 3.14159265358979 + linkages.Text10 * 360 + 20, -5 * bi3)

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.AC)
         
         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.AC
                         
         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()
Unload Me

End Sub
Private Sub Command3_Click()
Me.Picture1.Cls
Picture1.DrawWidth = 1
bi3 = Form2.Text3
zuobiao
End Sub
Private Sub Picture1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Me.Label1.Caption = "鼠标的坐标位置是X=" & X & "      Y=" & Y
End Sub
Public Sub zuobiao() '加速度的坐标线
 Picture1.Scale (-20, 100 * bi3)-(linkages.Text10 * 360 + 20, -5 * bi3)
'_____________下面画横坐标线__________________________________________
For i = 10 To linkages.Text10 * 360 Step 10
  Picture1.Line (i, 0)-(i, 90 * bi3), 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 * bi3 To 90 * bi3 Step 5 * bi3
  Picture1.Line (0, i)-(linkages.Text10 * 360, i), QBColor(7)
Next i
For i = 0 To 90 * bi3 Step 10 * bi3
  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 * bi3)
 Picture1.Print "Vc(每格代表" & bi3 * 5 & "的曲线)"
End Sub

⌨️ 快捷键说明

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