Const pi = 3.1415926
Dim angle As Integer
Private Sub Form_Load() '调整空间尺寸，位置及初始参数
    Me.ScaleMode = 2
    Me.Caption = "I型曲柄滑块"
    Me.Width = 10000
    Me.Height = 7000
    Picture1.ScaleMode = 2
    Picture1.AutoRedraw = True
    Picture1.Move 0, 0, Me.ScaleWidth, 1500
    Command1.Caption = "开始(&B)"
    Command1.Move 20, 260, 70, 30
    Label1.Caption = "速度:"
    Label1.Move 120, 170, 100, 30
    HScroll1.Min = 1
    HScroll1.Max = 20
    HScroll1.Move 160, 260, 140, 30
    Timer1.Interval = 20
    Timer1.Enabled = False
End Sub
Private Sub Command1_Click()
    Timer1.Enabled = Not Timer1.Enabled
    If Timer1.Enabled Then
        Command1.Caption = "暂停(&S)"
    Else
        Command1.Caption = "开始(&B)"
    End If
End Sub
Sub draw(ByVal ox As Integer, ByVal oy As Integer, ByVal orad As Integer) 'ox,oy圆心坐标,orad半径
    angle = (angle + HScroll1.Value) Mod 360
    xo = ox + orad * Cos(angle * pi / 180) 'ox,oy圆心坐标,orad半径
    yo = oy - orad * Sin(angle * pi / 180)
    xs = Sqr((3 * orad) ^ 2 - 10 ^ 2) + xo '滑块的左边界x坐标，连杆长度取4*orad,滑块高度取20(像素)?
    xz = 3 * Sqr((3 * orad) ^ 2 - 10 ^ 2) + xo
    Picture1.BackColor = Picture1.BackColor
    Picture1.DrawStyle = 0 '实线
    Picture1.DrawWidth = 2 '线宽2
    Picture1.Line (ox + 2 * orad, oy + 10)-(ox + 6 * orad, oy + 10) '壁面
    Picture1.Line (ox, oy)-(xo, yo) '连接圆心与圆周上的铰链点
    Picture1.Line (xs, oy)-(xo, yo), vbBlue  '连接滑块与圆周上的铰链点
    Picture1.Line (xz, 3 * oy - 2 * yo)-(xs, oy), vbBlue
    Picture1.FillStyle = 1 '透明填充
    Picture1.Circle (ox, oy), orad '画圆
    Picture1.FillStyle = 0 '实体填充
    Picture1.FillColor = vbWhite '圆心
    Picture1.Circle (ox, oy), 5
    Picture1.FillColor = vbGreen '圆周上的铰接点
    Picture1.Circle (xo, yo), 4
    Picture1.FillColor = vbRed '滑块
    Picture1.Line (xs - 20, oy - 10)-(xs + 20, oy + 10), , B
    Picture1.DrawStyle = 2 '虚线
    Picture1.DrawWidth = 1 '线宽1
    For i = 0 To 9 '表示壁面的虚线
        Picture1.Line (i * 3 * orad / 10 + ox + 2 * orad - 5, oy + 10)-(i * 3 * orad / 10 + ox + 2 * orad + 20 - 5, oy + 20)
    Next
End Sub
Private Sub Timer1_Timer() '画
    draw 60, 160, 40
End Sub


源码有了，请大佬们指点一下

点的坐标是(xz, 3 * oy - 2 * yo)

你把这句去掉Picture1.BackColor = Picture1.BackColor
在draw最后面加上一句Picture1.PSet (xz, 3 * oy - 2 * yo), vbRed就可以了

不对呀，按照你的所有轨迹都出现了

在你代码基础上，draw过程中最后面加上这段代码就可以了
    N = N + 1
    Picture1.DrawWidth = 10
    If angle Then
       ReDim Preserve PointArray(1 To 2 * N)
       PointArray(2 * N - 1) = xz
       PointArray(2 * N) = 3 * oy - 2 * yo
       For i = 1 To N
           Picture1.PSet (PointArray(2 * i - 1), PointArray(2 * i)), vbRed
       Next
    Else
       N = 1
       ReDim PointArray(1 To 2 * N)
       PointArray(2 * N - 1) = xz
       PointArray(2 * N) = 3 * oy - 2 * yo
       For i = 1 To N
           Picture1.PSet (PointArray(2 * i - 1), PointArray(2 * i)), vbRed
       Next
    End If


记得在声明部分定义：
Dim PointArray()
Dim N As Long

谢谢老师，你太厉害了

不客气。
你的动画挺有意思的。