用VBA编制的导杆运动模拟程序

该怎么办呢难哦

这里公布我做的程序中的一部分，参数设置时注意两者关联。要想看得逼真一点，事先将CAD着色。 想搞机械二次开发的可以看看。 Option Explicit
Public l1, l4, l3, lll3, aa, aaa As Double
Public 滑块长, 滑块宽, 铰半径 As Double
Public xa, ya As Double
Public xb(360) As Double
Public yb(360) As Double
Public ll3(360) As Double
Public bb(360) As Double Public xcmax, xcmin, vmax, vmin As Double
Public Const pi As Double = 3.1415926
Public i As Double
Public 曲柄 As Acad3DSolid
Public 导杆 As Acad3DSolid
Public 铰链1 As Acad3DSolid
Public 铰链2 As Acad3DSolid
Public 铰链3 As Acad3DSolid
Public 滑块 As Acad3DSolid
Public 机架1 As Acad3DSolid
Public 机架2 As Acad3DSolid
Public Sub 计算()
Dim w1 As Double
Dim tem(360) As Double
Dim du As Double
lll3 = Sqr(l4 ^ 2 - l1 ^ 2)
aa = Atn(lll3 / l1)
aaa = 3 / 2 * pi + aa
l3 = 1.2 * (l4 + l1) For i = 0 To 360
du = i * pi / 180 + aaa
xb(i) = l1 * Cos(du)
yb(i) = l1 * Sin(du)
tem(i) = l1 ^ 2 + l4 ^ 2 - 2 * l1 * l4 * Cos(du)
ll3(i) = Sqr(tem(i))

bb(i) = Atn(l1 * Cos(du) / (l4 + l1 * Sin(du)))
Next i 滑块长 = l1 / 4
滑块宽 = l1 / 6
铰半径 = l1 / 30 End Sub Public Sub 生成三维模型() Dim center1(0 To 2) As Double
Dim center2(0 To 2) As Double
Dim center3(0 To 2) As Double
Dim centertem(0 To 2) As Double
Dim rotatept1(0 To 2) As Double
Dim rotatept2(0 To 2) As Double
Dim rotateangle As Double
Dim radius As Double
Dim rottem As Double radius = 铰半径 / 2
center1(0) = 0: center1(1) = 0: center1(2) = 0
center2(0) = xb(0): center2(1) = yb(0): center2(2) = 0
center3(0) = 0: center3(1) = -l4: center3(2) = 0 Set 曲柄 = ThisDrawing.ModelSpace.AddCylinder(center1, radius, l1)
Set 导杆 = ThisDrawing.ModelSpace.AddCylinder(center3, radius, l3)
Set 铰链1 = ThisDrawing.ModelSpace.AddSphere(center1, 铰半径)
Set 铰链2 = ThisDrawing.ModelSpace.AddCylinder(center2, 铰半径, 滑块宽 * 1.2)
Set 铰链3 = ThisDrawing.ModelSpace.AddSphere(center3, 铰半径)
Set 滑块 = ThisDrawing.ModelSpace.AddBox(center2, 滑块长, 滑块宽, 滑块宽)
Set 机架1 = ThisDrawing.ModelSpace.AddCone(center1, 铰半径 * 3, 铰半径 * 5)
Set 机架2 = ThisDrawing.ModelSpace.AddCone(center3, 铰半径 * 3, 铰半径 * 5)
rotatept1(0) = 0: rotatept1(1) = 0: rotatept1(2) = 0
rotatept2(0) = 0: rotatept2(1) = 1: rotatept2(2) = 0
rotateangle = 90 * pi / 180 曲柄.Rotate3D rotatept1, rotatept2, rotateangle
centertem(0) = l1 / 2: centertem(1) = 0: centertem(2) = 0
曲柄.Move center1, centertem
曲柄.Rotate center1, aaa 滑块.Rotate center2, aa 导杆.Rotate3D rotatept1, rotatept2, rotateangle
centertem(0) = l3 / 2: centertem(1) = -l4: centertem(2) = 0 导杆.Move center3, centertem
导杆.Rotate center3, aa rotatept2(0) = 1: rotatept2(1) = 0: rotatept2(2) = 0
centertem(0) = 0: centertem(1) = -铰半径 * 2: centertem(2) = 0
机架1.Rotate3D rotatept1, rotatept2, -rotateangle
机架1.Move center1, centertem rotatept1(0) = 0: rotatept1(1) = -l4: rotatept1(2) = 0
rotatept2(0) = 1: rotatept2(1) = -l4: rotatept2(2) = 0
centertem(0) = 0: centertem(1) = -l4 - 铰半径 * 2: centertem(2) = 0
机架2.Rotate3D rotatept1, rotatept2, -rotateangle
机架2.Move center3, centertem 曲柄.Color = acRed
导杆.Color = acRed
铰链1.Color = acBlue
铰链2.Color = acBlue
铰链3.Color = acBlue
滑块.Color = acRed
机架1.Color = acGreen
机架2.Color = acGreen Dim NewDirection(0 To 2) As Double
NewDirection(0) = -1: NewDirection(1) = -1: NewDirection(2) = 1
ThisDrawing.ActiveViewport.Direction = NewDirection
ThisDrawing.ActiveViewport = ThisDrawing.ActiveViewport
ZoomAll End Sub
Public Sub 三维动画(ByVal i As Single)
Dim centertem(0 To 2) As Double
Dim centertemf(0 To 2) As Double
Dim centerteml(0 To 2) As Double
Dim rottem As Double
Static lastt As Double centertem(0) = 0: centertem(1) = 0: centertem(2) = 0
曲柄.Rotate centertem, pi / 180 centertemf(0) = xb(lastt): centertemf(1) = yb(lastt): centertemf(2) = 0
centerteml(0) = xb(i): centerteml(1) = yb(i): centerteml(2) = 0
铰链2.Move centertemf, centerteml centertemf(0) = 0: centertemf(1) = -l4: centertemf(2) = 0
rottem = bb(lastt) - bb(i)
导杆.Rotate centertemf, rottem centertemf(0) = xb(lastt): centertemf(1) = yb(lastt): centertemf(2) = 0
centerteml(0) = xb(i): centerteml(1) = yb(i): centerteml(2) = 0
滑块.Move centertemf, centerteml
rottem = bb(lastt) - bb(i)
滑块.Rotate centerteml, rottem
曲柄.Update
铰链2.Update
滑块.Update
导杆.Update
lastt = i
End Sub Public Sub main()
UserForm1.Show
End Sub