用什么方法使曲柄连杆机构转动？

woaishuijia · 发表于 2008-9-16 15:56:31

说说你期望的运动是什么样子，再把源码发上来，看看误会出在何处。

mimimao383 · 发表于 2008-9-16 16:18:12

woaishuijia老师你好
我找不到DO......LOOP命令的使用格式,也找不到motation命令的使用方法,我期望使块参照能够做直线运动,可是找不到所需要的命令或方法,上图是关掉COS(Ag)得到的.

mimimao383 · 发表于 2008-9-16 16:20:47

Option Explicit

Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer '如不加这一段则无法停止程序运行.
Dim v As Double, ag As Double '旋转角,旋转速度

Sub t()
Dim SS As AcadSelectionSet, Obj As Object
Dim Bt1 As AcadBlockReference, Bt2 As AcadBlockReference '互相垂直的两个圆盘
Dim P1(2) As Double, P2(2) As Double '两个轴点坐标
v = 30 '指定速度
With ThisDrawing 'with后为指定缩写的内容
Set SS = .SelectionSets.Add("SS" ) '使选择内容放到SS当中
SS.Select acSelectionSetAll '全选
For Each Obj In SS '一个一个的选
Obj.Delete '删除所选
Next '选择下一个
SS.Delete '删除放选择内容的空间
.SendCommand "ucs w " '进入到世界坐标系
Set Bt1 = .ModelSpace.InsertBlock(P1, "t1", 1, 1, 1, 0) '把块参照插入T1到点P1,P1不明确指出则是表示为(0,0,0)
P2(0) = P1(0) - 400 'P2点的坐标为(-400,0,0)
P2(1) = 0
P2(2) = 0

Set Bt2 = .ModelSpace.InsertBlock(P2, "t2", 1, 1, 1, 0) '把块参照T2插入到点P2
Do                                     '动命令,到现在还不理解: DO.....LOOP是什么意思.
P1(0) = 200# * Cos(ag) 'P1的X坐标变化规律标,其实是指平放圆盘边上一点的坐标点
P1(1) = 200# * Sin(ag) '不知道为什么就能如此运动

Bt1.Rotation = ag '块参照BT1旋转,不明白ROTATION的使用方法
Bt2.InsertionPoint = P2 '把块参照插入到点P2,实际上就是X=-400的位置
'Bt2.Rotation = Cos(ag) '加入这一句就会引起参照快的水平旋转,不是所需要的.
P2(0) = -600 - 200# * Cos(ag)
P2(2) = 200# * Sin(ag)

Bt1.Update
Bt2.Update
If GetAsyncKeyState(27) = -32767 Then Exit Do
DoEvents
ag = ((ag * 500# / v + 1#) Mod Int(3.14159265358979 * 1000# / v)) / 500# * v

  Loop
   End With

End Sub

woaishuijia · 发表于 2008-9-17 15:04:36

一、关于DO循环
Do...Loop是循环语句。常见的用法有下面几种：
1、
Do
代码行1
代码行2
.
.
.
代码行n
Loop
当程序运行到Do后，进入循环体执行其中的代码行1到n，见到Loop再回去重新执行代码行1到n......反复执行循环块中的语句。
如果代码行1到n中没有能使循环结束的指令，循环将永远进行下去--死循环。
所以中间的代码中至少要有一个Exit Do命令，使循环能够结束。
Exit Do命令通常与条件判断语句合用，比如
If 条件 Then Exit Do
当然，条件判断语句不仅If...then一种，还有Select Case语句等。
例子：
Dim I As Intiger,J As Intiger,S As String
S="GGG"
Do
J=I*20
If J>100 Then Exit Do
I=I+2
Loop
S="HHH"
程序由上而下执行，运行完S="GGG"来到Do循环，首先执行J=I*20使J=0，然后执行If J>100 Then Exit Do，看J是否大于100，此时J=0不大于100，继续执行I=I+2使I=2，程序来到Loop后返回再次执行J=I*20使J=40，然后检查J是否大于100，此时J=40不大于100，程序再继续执行I=I+2使I=4，再返回执行J=I*20使J=80，再检查J是否小于100，此时J=80不大于100，程序再继续执行I=I+2使I=6，再返回执行J=I*20，再检查J是否小于100，此时J=120大于100，于是程序退出循环向下执行S="HHH"这一行

2、
Do While 条件
代码行1
代码行2
.
.
.
代码行n
Loop
当条件满足时进入循环执行其中的代码1到n(条件不满足则跳过中间的代码和Loop向下执行)。执行完代码行n后来到Loop，再次检查条件是否满足，满足时再次执行代码行1到n(否则执行Loop后面的语句)，然后再检查条件......直到条件不满足
例子：
Dim I As Intiger,J As Intiger,S As String
S="GGG"
Do While J<100
J=I*20
I=I+2
Loop
S="HHH"
程序由上而下执行，运行完S="GGG"来到Do循环，首先看J是否小于100，此时J=0小于100，程序进入Do循环内部，执行其中的语句，使J=0，I=2，程序来到Loop后再次检查J是否小于100，此时J=0小于100，程序再执行中间的两行，使J=40，程序来到Loop后再次检查J是否小于100，此时J=40小于100，程序再执行中间的两行，使J=80，I=6，,程序见到Loop后再次检查J是否小于100，此时J=80小于100，程序再执行中间的两行，使J=120，I=8，程序见到Loop后再次检查J是否小于100，此时J=120大于100，于是程序向下执行S="HHH"这一行

3、
Do
代码行1
代码行2
.
.
.
代码行n
Loop While 条件
先执行循环语句块中的代码，来到Loop这一行时检查条件，当条件满足时再次执行循环语句块中的代码行1到n(否则向下执行Loop后面的语句)。执行完代码行n后再次检查条件是否满足......直到条件不满足
这种用法和第二种一样，都是条件满足时执行循环体中间的语句。二者的不同点是：第二种方法是首先检查条件是否满足，如一开始就不能满足条件则直接跳过循环体执行Loop后面的语句，而第三种方法是先要无条件地执行一遍循环体中间的语句然后再检查条件决定是否结束循环。
例子：
Dim I As Intiger,J As Intiger,S As String
S="GGG"
Do
J=I*20
I=I+2
Loop While J<100
S="HHH"
程序由上而下执行，运行完S="GGG"来到Do循环，首先进入Do循环内部，执行其中的语句，使J=0，I=2，程序见到Loop后检查J是否小于100，此时J=0小于100，程序再执行中间的两行，使J=40，I=4，,程序见到Loop后再次检查J是否小于100，此时J=40小于100，程序再执行中间的两行，使J=80，I=6，,程序见到Loop后再次检查J是否小于100，此时J=80小于100，程序再执行中间的两行，使J=120，I=8，程序见到Loop后再次检查J是否小于100，此时J=120大于100，于是程序向下执行S="HHH"这一行

4、
Do Until 条件
代码行1
代码行2
.
.
.
代码行n
Loop
与第二种方法刚好相反，当条件满足时跳过中间的代码和Loop向下执行；否则进入循环体执行其中的代码行1到n。执行完代码行n后再次检查条件是否满足，满足时执行Loop后面的语句；否则再次执行代码1到n，,然后再检查条件......直到条件满足
例子：
Dim I As Intiger,J As Intiger,S As String
S="GGG"
Do Until J>100
J=I*20
I=I+2
Loop
S="HHH"
程序由上而下执行，运行完S="GGG"来到Do循环，首先看J是否大于100，此时J=0不大于100，程序进入Do循环内部，执行其中的语句，使J=0，I=2，程序见到Loop后再次检查J是否大于100，此时J=0不大于100，程序再执行中间的两行，使J=40，I=4，程序见到Loop后再次检查J是否大于100，此时J=40不大于100，程序再执行中间的两行，使J=80，I=6，,程序见到Loop后再次检查J是否大于100，此时J=80不大于100，程序再执行中间的两行，使J=120，I=8，程序见到Loop后再次检查J是否大于100，此时J=120大于100，于是程序向下执行S="HHH"这一行

While的中文意思是“当......时候”，Until的中文意思是“直到......时候”，理解了含义就容易区分它们了。

5、
Do
代码行1
代码行2
.
.
.
代码行n
Loop Until 条件
先执行循环语句块中的代码，来到Loop这一行时检查条件，当条件满足时向下执行Loop后面的语句；否则执行循环体中间的的代码行1到n。执行完代码行n后再次检查条件是否满足，满足时执行Loop后面的语句；否则再次执行代码1到n，,然后再检查条件......直到条件满足
这种方法与第四种相似，都是条件不满足时循环，条件满足时结束循环。不同点是第四种方法先检查条件如一开始就满足条件则直接跳过循环体，而第五种方法是先执行一遍循环体中间的语句然后再检查条件。
例子：
Dim I As Intiger,J As Intiger,S As String
S="GGG"
Do
J=I*20
I=I+2
Loop Until J>100
S="HHH"
程序由上而下执行，运行完S="GGG"来到Do循环，首先进入Do循环内部执行其中的语句，使J=0，I=2，程序见到Loop后检查J是否大于100，此时J=0不大于100，程序再执行中间的两行，使J=40，I=4，,程序见到Loop后再次检查J是否大于100，此时J=40不大于100，程序再执行中间的两行，使J=80，I=6，,程序见到Loop后再次检查J是否大于100，此时J=80不大于100，程序再执行中间的两行，使J=120，I=8，程序见到Loop后再次检查J是否大于100，此时J=120大于100，于是程序向下执行S="HHH"这一行

第二到第五种方法都可以在循环体内部代码中带有Exit Do命令，在满足条件时直接退出循环
例子：
Dim I As Intiger,J As Intiger,S As String
S="GGG"
Do Until J>100
J=I*20
If I>3 Then Exit Do
I=I+2
Loop
S="HHH"
程序由上而下执行，运行完S="GGG"来到Do循环，首先看J是否大于100，此时J=0不大于100，程序进入Do循环内部，执行J=I*20，使J=0，再执行If......Then语句，此时I=0不大于3，程序再执行I=I+2使I=2，来到Loop后再次检查J是否大于100，此时J=0不大于100，程序返回重新执行J=I*20使J=40，再执行If......Then语句，此时I=2不大于3，程序再执行I=I+2使I=4，来到Loop后再次检查J是否大于100，此时J=40不大于100，程序返回重新执行J=I*20使J=80，再执行If......Then语句，此时I=4大于3，于是退出循环向下执行S="HHH"这一行

二、关于Rotation属性
打开CAD，进入模型空间，命令行输入“I”，回车，弹出“插入”对话框，在其右侧有一个“旋转”角度(见图1)，这是决定块参照在图形中的角度的。插入块参照后，选择它，“Ctrl+1”打开特性选项板，会看到“旋转”角度(见图2)。再在图形中添加一个多行文字，然后选择它，“特性”选项板上也有一个“旋转”角度(见图3)。这些旋转角度就是VBA中的Rotation属性。

在“特性”选项板上修改“旋转”角度，会看到被选择的图元的角度在变。如果连续不停地修改“旋转”角度，图元会随着属性被修改而不停地旋转。
我们在VBA中通过循环语句连续不断地修改块参照的Rotation属性，其实和在“特性”选项板上修改“旋转”角度是一样的，所以块参照会旋转。
如果我们在“特性”选项板上连续修改块参照的“位置X坐标”，也会看到块参照连续的水平移动，这个“位置坐标”对应VBA中的是块参照对象的InsertionPoint属性。
说白了，我们的“让图形动起来”的程序就是在用VBA方法替我们接照特定的规律连续不断地修改图元的角度和位置。

[ 本帖最后由 woaishuijia 于 2008-9-17 15:07 编辑 ]

mimimao383 · 发表于 2008-9-17 15:55:41

谢谢你
你讲的这些为什么在书中都看不到呢？
在对你写的这段“A”代码的不断理解中总有新的发现，在模仿的过程中不断有新的收获。
学习中。。。。。。。。。。。。。。。。

mimimao383 · 发表于 2008-9-18 00:11:31

这是期望移动的程序，可以移动，但只能在AG<0.3时控制，当大于0.3时就没有动静了

。
Option Explicit
Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
Dim  Ag As Double
Sub AAA()
Dim SS As AcadSelectionSet, Obj As Object
Dim BA11 As AcadBlockReference, BA12 As AcadBlockReference, BA21 As AcadBlockReference, BA22 As AcadBlockReference
Dim BA31 As AcadBlockReference, BA32 As AcadBlockReference
Dim P1(2) As Double, P2(2) As Double, P3(2) As Double

With ThisDrawing
      Set SS = .SelectionSets.Add("SS" )
      SS.Select acSelectionSetAll
      For Each Obj In SS
         Obj.Delete
      Next
      SS.Delete
      .SendCommand "ucs w "    '以上语句没有变化


      Set BA11 = .ModelSpace.InsertBlock(P1, "A11", 1, 1, 1, 0)
      Set BA12 = .ModelSpace.InsertBlock(P1, "A12", 1, 1, 1, 0)
      P2(0) = 1000
      P2(1) = -200
      Set BA21 = .ModelSpace.InsertBlock(P2, "A21", 1, 1, 1, 0)
      P3(0) = 0
      P3(1) = 500
      Set BA22 = .ModelSpace.InsertBlock(P2, "A22", 1, 1, 1, 0)
      Set BA31 = .ModelSpace.InsertBlock(P3, "A31", 1, 1, 1, 0)
      Set BA32 = .ModelSpace.InsertBlock(P3, "A32", 1, 1, 1, 0) '这组语句对块参照定位

      Do
         BA11.Rotation = -2 * Ag
         BA12.Rotation = Ag
         BA21.Rotation = Ag
         BA22.Rotation = Ag
         BA31.Rotation = Ag
         BA32.Rotation = Ag '使块参照转动

         P2(2) = -1000
         If Ag = 0.1 Then BA22.InsertionPoint = P2
         P2(2) = 0
         If Ag = 0.3 Then BA22.InsertionPoint = P2 '移动块参照A22

         BA11.Update
         BA12.Update
         BA21.Update
         BA22.Update
         BA31.Update
         BA32.Update
         If GetAsyncKeyState(27) = -32767 Then Exit Do
         DoEvents

         Ag = Ag + 0.05
         If Ag >2* 3.14159265358979 Then Ag = 0

      Loop
End With
End Sub

目前,
1、严重的问题是当Ag大于0.3时,无论上还是下,块参照A22都不动,只有小于0.3时才动问题出在哪呢?
2、之所以画了三个立柱，想在不同方向移动或转动他们，但只能在Z方向移动或转动，在X或Y方向如何做呢？
请woaishuijia老师有时间时讲解。

woaishuijia · 发表于 2008-9-18 06:50:46

P2(2) = -1000
'这一行把P2坐标从(1000,-200,0)改到了(1000,-200,-1000)
If Ag = 0.1 Then BA22.InsertionPoint = P2
'这一行在Ag=0.1时把BA22块参照的插入点改到了(1000,-200,-1000)，在Ag=0.3（使后面一个改变插入点的语句生效）之前，它的插入点就在这个新的P2点不会动
P2(2) = 0
'这一行把P2坐标人(1000,-200,-1000)改回了(1000,-200,0)
If Ag = 0.3 Then BA22.InsertionPoint = P2 '移动块参照A22
'这一行在Ag=0.3时把BA22块参照的插入点改到了(1000,-200,0)，在Ag=0.1（使前面一个改变插入点的语句生效）之前，它的插入点就在这个点不会动

有一个小问题，Do循环中的代码每执行一次，P2(2) = -1000 和 P2(2) = 0 都要被执行，这是不必要的。应该把它放到条件判断语句的里面，符合条件时才对它赋值。看下面
   If Ag = 0.1 Then
      P2(2) = -1000
      BA22.InsertionPoint = P2
   end if
   If Ag = 0.3 Then
      P2(2) = 0
      BA22.InsertionPoint = P2
   end if

说句题外话，像这种对同一个变量的多个不同的值进行检查的条件判断，有一个更适合的语句，就是我们前面多次提到的多重条件判断Select Case语句，看下面
Select Case Ag
      Case 0.1
         P2(2) = -1000
         BA22.InsertionPoint = P2
      Case 0.3
         P2(2) = 0
         BA22.InsertionPoint = P2
End Select

回到上面的话题，这段程序中，每旋转一周，BA22块参照只动了两次，一次是在Ag=0.1时从(1000,-200,0)跳到了(1000,-200,-1000)，再一次是在Ag=0.3时从(1000,-200,-1000)跳回了(1000,-200,0)
如果想让它在Ag>0.3时也能动，必须在Ag>0.3时对块参照的InsertionPoint属性赋值。就像下面
   If Ag > 0.3 Then
      P2(2) = ......
      BA22.InsertionPoint = P2
   end if

在X或Y方向移动块参照，只需要修改它的X或Y坐标就行。就像上面的程序，你一直在修改P2(2)，这是Z坐标。你可以尝试修改P2(0)和P2(1)，就是点的X和Y坐标，你可以让块参照移到你希望的任何地方(当然在CAD允许的范围内)，而不限于哪个方向。
如果在XY平面插入块参照，却要让它在其它平面旋转，靠修改块参照的Rotation属性就不行了，因为这个属性只针对所在平面。这时要用Rotate3D方法，就是我们画三维图时常用的三维旋转命令。这个方法需要三个参数，第一个和第二个是两个点，用来定义旋转轴，第三个是旋转角度(弧度)，就像下面
Dim P4(2) As Double, P5(2) As Double
P4(0) = 0: P4(1) = 1: P4(2) = 0
P5(0) = 0: P5(1) = -1: P5(2) = 0
BA11.Rotate3D P4, P5, 0.05
BA12.Rotate3D P4, P5, 0.05
你把上面几行代码插入你的Do循环中看看效果吧。

[ 本帖最后由 woaishuijia 于 2008-9-18 08:08 编辑 ]

mimimao383 · 发表于 2008-9-18 10:24:49

1、改边判断和插入的语句使得计算机的效率提高，现在计算机的高速度掩盖了这些现象，这就是高手和菜鸟的差别。
2、如何对块参照的InsertionPoint属性赋？就象rotation 一样，我只能在块参照的属性拦中看到或在模型空间观察，并修改不了他们的属性，是指用>代替=就修改了他们的属性?的确用>代替了=后，在AG等于任何值时都可以移动了。不理解[0.05，0.3]与（0.05，2PI）数域间有什么差别。
3、对于下面这些内容正在理解和测试中
“第一个和第二个是两个点，用来定义旋转轴，第三个是旋转角度(弧度)，就像下面
Dim P4(2) As Double, P5(2) As Double
P4(1) = 1
P5(1) = -1
BA11.Rotate3D P4, P5, 0.05
BA12.Rotate3D P4, P5, 0.05”

woaishuijia · 发表于 2008-9-18 11:23:52

BA22.InsertionPoint = P2
这可是你写的呀。这不就是在向BA22的InsertionPoint 属性赋值吗？和“特性”管理器不同的是，那里边三维坐标是分开的，在VBA里是用点同时对三维坐标赋值。

“>”和“=”的区别
If...Then语句是让电脑知道在什么时候做什么事。用“=”就是告诉电脑在变量和常数刚好相等的时候做你指定的事，而用“>”是只要变量大于那个常数它就做。
这里涉及到逻辑运算。事实上，这里的“Ag=0.1”是一个逻辑运算式，当Ag等于0.1时，这个式子的运算结果为“True”(真)；Ag不等于0.1时结果为“False”(假)。If...Then语句的完整格式是
If 逻辑值1或逻辑运算式1 Then
代码1'当逻辑值1为True或逻辑运算式1的结果为True时执行此代码。代码可以是多行--可以做不止一件事；也可以没有--如果此时并不打算做什么。
Else
代码2'当逻辑值1为False或逻辑运算式1的结果为False时执行此代码，代码可以是多行；如果逻辑值1为False或逻辑运算式1的结果为False时我们不需要程序做什么，Else可以省略，当然代码2也没有了。
Elseif 逻辑值2或逻辑运算式2 Then
代码3'当逻辑值1或逻辑运算式1的结果为False的同时逻辑值2或逻辑运算式2的结果为True时执行此代码，代码可以是多行。Elseif 这一行和Else一样，如果我们不需要在逻辑值1或逻辑运算式1的结果为False时做什么，就可以省略它。Elseif 这一行可以有多个，在逻辑值1或逻辑运算式1的结果为False时可以根据其它条件让电脑做不同的事
Een If'这个必须有，让电脑知道条件判断到此为止。

If...Then语句还有一种简写形式
If 逻辑值或逻辑运算式 Then 代码1 Else 代码2
在逻辑值或逻辑运算式为True时执行代码1，否则执行代码2。
代码1是必须有的。
Else和代码2是可以省略的，如果此时不需要做什么的话。
代码1和代码2都可以是多个指令，但必须写在一行里，每句之间用“：”隔开，就像这样
If 逻辑值或逻辑运算式 Then P4(0) = 0: P4(1) = 1: P4(2) = 0 Else P4(0) = 0: P4(1) = 5: P4(2) = 0
这种简写形式是微软要淘汰的东西，只是为了向下兼容才保留着。一般我们也是在代码简单时才用它，比如
If Ag >2* 3.14159265358979 Then Ag = 0
我也懒得把它写成标准的形式
If Ag >2* 3.14159265358979 Then
Ag = 0
End If
能偷懒就偷嘛。

至于逻辑运算，不知你是否学过逻辑代数(也叫布尔代数)，如果学过，这个部分就好理解了。

mimimao383 · 发表于 2008-9-18 20:26:14

逻辑代数学过，大约丢掉99.39，和好的黄金的纯度差不多

。

XY，XZ，YZ三个面的对象都可以转起来了，对IF...THEN...的理解进了一步，所以制造了一些小摆动。

遇到的问题：每次做作业都重新构造新的块，这些块做些简单修改或编辑从帮助上正在看。
能否再告诉我一个类似“ 动画程序解析.rar”的范例，我现在所做的一切都是在 “动画程序解析.rar”的框内锻炼，收获是很大的。老师辛苦。下面是今天的作业。

mimimao383 · 发表于 2008-9-18 20:32:13

只是主要对Rotate3D进行了练习。Ag的使用存在问题。

Option Explicit

Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
Dim V As Double, Ag As Double, Am As Double

Sub b()
Dim SS As AcadSelectionSet, Obj As Object
Dim Bb1 As AcadBlockReference, BB2 As AcadBlockReference, BB3 As AcadBlockReference
Dim P1(2) As Double, P2(2) As Double, P3(2) As Double
With ThisDrawing
      Set SS = .SelectionSets.Add("SS")
      SS.Select acSelectionSetAll
      For Each Obj In SS
         Obj.Delete
      Next
      SS.Delete
      .SendCommand "ucs w "
      Set Bb1 = .ModelSpace.InsertBlock(P1, "b1", 1, 1, 1, 0)
      P2(1) = 500
      Set BB2 = .ModelSpace.InsertBlock(P2, "B2", 1, 1, 1, 0)
      P3(0) = 500
      Set BB3 = .ModelSpace.InsertBlock(P3, "B3", 1, 1, 1, 0)

      Do

         Dim P4(2) As Double, P5(2) As Double
         P4(0) = 1: P4(1) = 0: P4(2) = 0
         P5(0) = -1: P5(1) = 0: P5(2) = 0
         Ag = Ag + 0.01
         Bb1.Rotate3D P4, P5, 0.01
         P4(0) = 0: P4(1) = 1: P4(2) = 0
         P5(0) = 0: P5(1) = -1: P5(2) = 0
         If Ag > 5 Then Am = 0.05
         If Ag > 5.5 Then Am = 0
         If Ag > 6 Then Am = -0.05
         If Ag > 6.5 Then Am = 0
         BB2.Rotate3D P4, P5, Am
         P4(0) = 500: P4(1) = 0: P4(2) = 1
         P5(0) = 500: P5(1) = 0: P5(2) = -1
         BB3.Rotate3D P4, P5, 0.01
         Bb1.Update
         BB2.Update
         BB3.Update
         If GetAsyncKeyState(27) = -32767 Then Exit Do
         DoEvents
         Ag = Ag + 0.05
         If Ag > 10 Then Ag = 0

      Loop
End With
End Sub

[ 本帖最后由 mimimao383 于 2008-9-18 20:34 编辑 ]

woaishuijia · 发表于 2008-9-18 21:35:37

Ag的使用的确存在问题，前面增加0.01，后面又增加0.05，一次循环共增加0.06，分两次赋值，有点浪费。

mgame168 · 发表于 2008-9-21 03:18:58

精采的討論~學習中.......
此源碼收藏下了
不知我的R14是否能用

mimimao383 · 发表于 2008-9-21 18:52:22

看老师近两天忙造象棋，不好意思打搅，又憋的慌，又找不到路，乱闯一通，还的麻烦老师。
如“ Bb1.Rotate3D P4, P5, 0.01”，当块B1沿P4、P5确定的轴旋转时，它的速度是0.01，即它是一个角速度常数。

再如在DO......LOOP语句内，“BA12.Rotation = Ag， Ag = Ag + 0.05”，Ag是一个角度，A12每次跳动一个角度增量，连续起来就看似在转，快慢是由跳的步的大小决定。有与Ag的变化方式决定了可以使得
X=COS（Ag）
Y=SIN（Ag）成立
可是在3D空间是给的角速度的常数值，找不到条件确定旋转点的（X，Y，Z）坐标值，也就无法插入连杆的位置。怎么办呢？

woaishuijia · 发表于 2008-9-22 15:48:06

我们首先回顾一下在本讨论题中使用过的让图元旋转的方法：
1、修改对象的Rotation属性。
Rotation属性是一个角度，这个角度的顶点在哪里呢？在基点。角度是在哪个平面上呢？对象所在平面，就是对象坐标系的XY平面。
这里要强调一个概念：对象坐标系OCS。
我们先在俯视图(世界坐标系WCS)上画一个圆，转到左视图(用户坐标系UCS)中将其旋转-45度，回到俯视图(WCS)，再把视图转到西南等轴测视图(仍然是WCS)，用“extrude”(拉伸建模)命令拉伸它。注意，这时UCS图标跑到了圆所在平面的圆心位置，特别是方向和WCS不一样了。见附图。

这时的UCS图标表示的是圆的对象坐标系OCS的Z轴方向(不表示OCS原点在圆心)。OCS的原点与WCS的原点是同一个，Z轴方向是跟着对象的。我们在WCS的XY平面画一个圆，这个圆的OCS就是WCS；当我们把这个圆在左视图中旋转-45度时，圆的OCS就跟着圆一起转了45度。
块参照也一样，它也有OCS。当我们在WCS中插入主动轮块参照时，它的OCS就是WCS。如果我们用三维旋转让它的所在平面不再是WCS的XY平面时，它的OCS也跟着转，OCS的Z轴方向永远和创建块时的UCS的Z轴方向一致。
修改Rotation属性，就是让对象在OCS的XY平面上与X轴呈一个角度，而基点不动。
所以我们在创建块时，当前UCS通过块基点的Z轴就是未来的旋转轴。也就是说，通过修改Rotation属性使对象旋转，只能是绕对象坐标系OCS的通过块基点的Z轴旋转。

2、使用对象的Rotate3D方法
实际上，我们前面讨论到Rotate3D方法时，跳过了Rotate方法。这里有必要提一下。
Rotate方法相当于画图时的Rotate命令。用途是让对象以当前UCS通过指定点的Z轴为旋转轴旋转一个指定的角度。它有两个参数，一个是指定点，另一个是旋转角。因为这个很好理解，就不举例说明了。
Rotate3D方法相当于2006以前版本的三维旋转命令。用途是让对象绕三维空间里指定的旋转轴旋转一个指定的角度。它有三个参数，前两个是点，用于指定旋转轴，第三个是旋转角。

无论使用Rotate还是Rotate3D方法，如果旋转轴与对象坐标系OCS的Z轴方向一致，对象坐标系OCS就不会变，被改变的是对象的位置和角度，对于块参照来说，就是改变InsertionPoint属性和Rotation属性(如果旋转轴通过插入点，InsertionPoint属性也不会变，这和我们修改Rotation属性使对象旋转是完全一样的)。
如果旋转轴与对象坐标系OCS的Z轴方向不一致，对象坐标系OCS就会变。我们可以通过对象的Normal属性获取OCS的Z轴方向，通过InsertionPoint属性获取对象的位置(WCS)，通过Rotation属性获取对象相对于OCS的旋转角度。
InsertionPoint和Rotation属性我们一直在用，只是我们以前都是在向它们赋值，其实它们是可读写属性，也可以向它们要数据从而了解对象当前的状态。比如
dim P as variant
P=对象.InsertionPoint
点坐标变量这时要声明为变体型变量，返回值是一个有三个元素(三维坐标)的数组。再如
dim A as double
A=对象.Rotation
返回值是对象相对于OCS的旋转角。
Normal属性是对象坐标系的Z轴方向。比如获取OCS的Z轴方向
dim Z as variant
Z=对象.Normal
变量Z声明为变体型，返回值是一个有三个元素的数组，三个元素分别是X、Y、Z方向的矢量分量，三个分量的合成方向就是OCS的Z轴方向。比如：(0,0,1)就代表该方向是WCS的Z轴方向，(0.707,0.707,0)就代表WCS的XY平面45度方向。
知道了一个点的WCS(或OCS)坐标和OCS的Z轴方向，就可以通过TranslateCoordinates方法在两个坐标系之间转换坐标。
TranslateCoordinates方法在Document(文档)对象下Utility(实用工具集)子对象下。
把当前文档中一个对象的插入点坐标转换为该对象的OCS坐标可以这样写：
Dim P As Variant
P = ThisDrawing.Utility.TranslateCoordinates(WCS中的点, acWorld, acOCS, False, OCS的Z轴方向)
P是变体变量，返回值是有三个元素的数组，代表对象插入点在OCS中的三维坐标。
5个参数：WCS中的点可以是一个点坐标数组，也可以是代表一个点的属性，在这里可以写成“对象.InsertionPoint”。
acWorld是一个常数，代表WCS；acOCS也是一个常数，代表OCS。这两个参数表明是从WCS转换到OCS。
False在这里表明是在转换一个点坐标，如果是True就表示转换方向矢量。
OCS的Z轴方向可以是一个有三个元素的数组，也可以是对象的Normal属性，就是说可以写成“对象.Normal”
用这个方法，我们可以把块参照的插入点坐标从WCS转换到对象的OCS，不论块参照被旋转移动到任何地方任何方向，我们都能始终面向对象计算它上面的相关位置。
假如按上面的方法我们得到了OCS插入点P，那么连杆轴的位置就是：
P1(0)=P(0)+cos(对象.Rotation)*R'你的连杆轴到主动轮中心的距离我不记得了，就用R代替。
P1(1)=P(1)+sin(对象.Rotation)*R
P1(2)=p(2)'这里它两个Z坐标是不是一样我不记得了，反正意思就是这样，跟原先的算法没有本质的不同。
这里再介绍一个方法PolarPoint。它也是Utility(实用工具集)中的方法，有三个参数，第一个是一个点，第二个是一个角度，第三个是长度。用途就像我们在画图时使用的相对极坐标，它可以得到与第一个点成一个角度和距离的点。用这个方法就不需要再分别用三角函数计算了。可以直接写成
P1=Thisdrawing.Utility.PolarPoint(P,对象.Rotation,R)
当然，现在得到的P1是OCS的，如果需要WCS的坐标，就要用TranslateCoordinates方法再转回去。
P1 = ThisDrawing.Utility.TranslateCoordinates(P1, acOCS, acWorld, False, 对象.Normal)

TranslateCoordinates方法不仅用来转换WCS和OCS，VBA中的坐标基本都用它转换，比如把当前UCS坐标转到WCS或者其它。

当我们把以前的程序改用Rotate或Rotate3D方法旋转块参照时，“Ag=Ag+增量”已经没有意义了。因为块参照每旋转一个角度增量，如果旋转轴就是通过块基点的OCS的Z轴，那么块参照的Rotation属性就增加一个增量(等于360度时还能自动归0)，我们直接用Rotation属性计算P1就可以了；如果不是这种情况，就要用相对复杂的计算甚至坐标变换的方法。

[ 本帖最后由 woaishuijia 于 2008-9-22 16:03 编辑 ]

mimimao383 · 发表于 2008-9-22 17:51:37

精辟解答，认真研读中..................

mimimao383 · 发表于 2008-9-24 12:22:53

在调整程序的时候总是出现“文件处理器错误”，总是说“块参照=空值”，"块=nothing"，我在这里理解有误区：本来已经做好块，程序就是找不到，每次不得不从绘图到做块一气呵成，总是怕中间有什么闪失，但总是经常出现这个问题。
最不敢动的就是块编辑，只要一动全完，这几天就在这个上面苦恼，也真是不开窍。

[ 本帖最后由 mimimao383 于 2008-9-24 18:31 编辑 ]

woaishuijia · 发表于 2008-9-24 21:07:09

从来没遇到这种情况。也许是软件安装有问题？
块是命名对象，插入块参照唯一的标志就是块名称。但单纯地编辑块不会改变块名称啊。
能否把你正确或错误的操作过程尽可能详尽地说一下？

mimimao383 · 发表于 2008-9-25 16:35:37

画的不好，总算转起来了。

[ 本帖最后由 mimimao383 于 2008-9-25 17:14 编辑 ]

mimimao383 · 发表于 2008-9-25 16:50:42

就这个示意图讲，困难的地方依然是坐标系的选取，总是出现错误的是图做好之后，块参照总和原图的坐标不一样，本来连杆长度应该X轴方向，可到转动的时候它与Z轴平行，横在那里，怎么也调整不过来，没办法只有重新画图。在进行创建块时睁大眼睛盯着坐标系，时刻让其保持在WCS状态，有些苦不堪言。前面老师用大量篇幅讲解三种坐标系之间的关系，到现在也没有完全里清。
先交作业，回头在仔细琢磨。

[ 本帖最后由 mimimao383 于 2008-9-25 17:29 编辑 ]

mimimao383 · 发表于 2008-9-25 17:00:11

这是程序，照虎画猫，请老师指教。

Option Explicit
Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
Dim V As Double, Ag As Double
Sub kunaodeshiyan()
Dim SS As AcadSelectionSet, Obj As Object

Dim Bjiti As AcadBlockReference, Bliangan As AcadBlockReference, Bqubing As AcadBlockReference, Blunpan As AcadBlockReference
Dim Bhuakuai As AcadBlockReference, Bshangdonggan As AcadBlockReference, Bxiadogngan As AcadBlockReference '共七个块参照
Dim P1(2) As Double, P2(2) As Double
Dim P3(2) As Double, P4(2) As Double
Dim P5(2) As Double, P6(2) As Double
Dim P7(2) As Double, P8(2) As Double

V = 10
'If V < 1# Then V = 10#
'V = Val(InputBox("输入速度1~100", "autoCAD", V))
'If V > 100# Then V = 100#
'If V < 1# Then V = 1#       '速度暂不调整
With ThisDrawing
      Set SS = .SelectionSets.Add("SS")
      SS.Select acSelectionSetAll
      For Each Obj In SS
         Obj.Delete
      Next
      SS.Delete
      .SendCommand "ucs w "  '坐标问题吃了大苦头,必须每一步都要注意坐标的位置和变化
      P2(2) = 8
      Set Bliangan = .ModelSpace.InsertBlock(P2, "liangan", 1, 1, 1, 0)
      Set Bjiti = .ModelSpace.InsertBlock(P1, "jiti", 1, 1, 1, 0) '将每一个不动的零件都并集到机体
      Set Bqubing = .ModelSpace.InsertBlock(P1, "qubing", 1, 1, 1, 0)
      P3(0) = 800
      P3(1) = 0
      P3(2) = 30
      Set Bhuakuai = .ModelSpace.InsertBlock(P3, "huakuai", 1, 1, 1, 0)
      P4(0) = 1000
      P4(2) = 0
      Set Bshangdonggan = .ModelSpace.InsertBlock(P4, "shangdonggan", 1, 1, 1, 0) '与滑块上下同步,但不知道还能不能前后运动
      P5(0) = 600
      P5(2) = 550
      Set Bxiadogngan = .ModelSpace.InsertBlock(P5, "xiadogngan", 1, 1, 1, 0) '下动杆Z方向前后运动
      P6(0) = 820
      P6(2) = 1010
      P6(1) = -10
      Set Blunpan = .ModelSpace.InsertBlock(P6, "lunpan", 1, 1, 1, 0) '轮盘X轴向运动

      Do
         P2(0) = 250# * Cos(Ag)
         P2(1) = 250# * Sin(Ag)
         P3(0) = P2(0) + Sqr(900# ^ 2 - P2(1) ^ 2) - 120
         Bqubing.Rotation = Ag
         Bliangan.InsertionPoint = P2

            Bhuakuai.InsertionPoint = P3
            P4(0) = P3(0) + 150
            Bhuakuai.InsertionPoint = P3
            Bliangan.Rotation = .Utility.AngleFromXAxis(P2, P3) '曲柄连杆机构的调整到此结束

            If Ag > 0.2 Then
            P4(2) = 50
            Bshangdonggan.InsertionPoint = P4
            End If
            If Ag > 2.2 Then
            P4(2) = -80
            Bshangdonggan.InsertionPoint = P4
            End If '上动杆在随滑快运动时做Z方向的伸缩移动


            If Ag > 0.1 Then
            P5(2) = 400
            Bxiadogngan.InsertionPoint = P5
            End If
            If Ag > 2 Then
            P5(2) = 550
            Bxiadogngan.InsertionPoint = P5
            End If          '使下动杆按给定条件伸缩

            P7(0) = 1: P7(1) = 0: P7(2) = 1010
            P8(0) = -1: P8(1) = 0: P8(2) = 1010
            Blunpan.Rotate3D P7, P8, 0.01
            Blunpan.InsertionPoint = P6 '使轮盘转动





         Bliangan.Update
         Bqubing.Update
         Bhuakuai.Update
         Bshangdonggan.Update
         Bxiadogngan.Update
         Blunpan.Update

         If GetAsyncKeyState(27) = -32767 Then Exit Do
         DoEvents
         Ag = ((Ag * 500# / V + 1#) Mod Int(3.14159265358979 * 1000# / V)) / 500# * V
      Loop
End With
End Sub

[ 本帖最后由 mimimao383 于 2008-9-25 17:03 编辑 ]

woaishuijia · 发表于 2008-9-25 17:37:42

这段代码
      Bhuakuai.InsertionPoint = P3
      P4(0) = P3(0) + 150
      Bhuakuai.InsertionPoint = P3''''''''''重复
      Bliangan.Rotation = .Utility.AngleFromXAxis(P2, P3) '曲柄连杆机构的调整到此结束

这段代码
      P7(0) = 1: P7(1) = 0: P7(2) = 1010
      P8(0) = -1: P8(1) = 0: P8(2) = 1010
      Blunpan.Rotate3D P7, P8, 0.01
      Blunpan.InsertionPoint = P6 '使轮盘转动
由于P6位于(820,-10,10)，这段代码实际上与下面代码是等效的
      P7(0) = 1: P7(1) = -10: P7(2) = 1010
      P8(0) = -1: P8(1) = -10: P8(2) = 1010
      Blunpan.Rotate3D P7, P8, 0.01

mimimao383 · 发表于 2008-9-26 20:46:20

谢谢
我在做这个程序的过程中反复遇到“块=noting"的问题，搞的我焦头烂额..............。看程序调整通过，都有点得意忘形，所以是先交作业为快。问题我马上改理。
另外对于加载宏的文件能不能去掉宏呢？为的是对图形进行修改，是不是加载宏之前应该保留原文件，可是保存了原文件修改后，在对其进行程序加载时本来已经作好的块都不能用了，此时就会出现“块=noting"的问题。我不知道说清楚了没有，即：
1、作图："1.DWG"
2、完成后另存为:"2.DWG"
3、在1.DWG打开VB编辑器编写程序,此时显示的是块参照,是不能再修改的,可是因为需要修改某些局部,如果用块编辑器修改就会出现“块=noting"的现象,即原来做的块不被程序成认了.想退回写程序前的1.DWG文件状态,也退不回去了.

4.如此无奈,就返回修改保存的文件2.DWG,但是修改后的文件,重新创建块后,在VB程序编辑器内拷入编辑好的程序,结果所有的块都通不过,显示:"文件处理器错误",比如:
Set Bliangan = .ModelSpace.InsertBlock(P2, "liangan", 1, 1, 1, 0)
这句就变成黄色,鼠标点上之后出现一个小框,内部显示:liangan=noting
就这样一个问题,我无奈的制图,编程,删除.再制图,再编程,全删除,重复那些画图,创建块,编程的过程,折腾了10遍5天,几近崩溃.;)
老师的耐心的不倦的指点让我不能丧失信心,我努力练习,终于先交了一个不成熟的作业.

woaishuijia · 发表于 2008-9-27 14:05:57

软件方面问题的可能性大.从你的描述看,操作没有错误.
现在我们只能把有可能影响插入块参照的因素都理一遍,你再看看是不是哪个细节有问题,如果不是,就重装一下软件试试吧.
1."块"是命名对象,在CAD文档中,每一个块都有其专用的名称.无论是画图时插入块参照,还是在程序中用insertblock方法插入块参照,都是用块名称检索.检索不到文档中的块,其原因只能是文档中没有叫这个名字的块或是CAD软件本身有问题.
2.新建一个VBA工程的方法有两种:第一种是打开VBA管理器(VBAMAN命令),点"新建"按钮.第二种方法是Alt+F11打开VBA编辑器,如果此时CAD进程中没有VBA工程,就自动新建一个VBA工程.
新建的VBA工程是通用的.单独保存为DVB格式文件.以前保存的通用工程在再次使用之前需要人为加载.
加载通用工程可以使用"加载应用程序"(Appload)命令,"加载工程"(vbaload)命令或在VBA管理器上点"加载"按钮.
保存通用工程,可以在VBA管理器中点"保存"按钮或用保存命令,通用工程被保存为单独的DVB格式文件.
卸载通用工程的方法是在VBA管理器中点"卸载"按钮.如果新建或加载的通用工程没有卸载,在关闭CAD进程时如果工程被编辑修改过且没有保存,CAD会询问你是否保存--就跟其它文档一样.
打开VBA管理器,在上面的"图形"列表框中选择一个文档,在"工程"列表框中选择一个通用工程,按"嵌入"按钮,该文档就内嵌了这个工程的拷贝.一个DWG文件只能内嵌一个VBA工程.
内嵌工程保存在DWG文件中,打开内嵌工程的DWG文件,内嵌的工程自动加载.关闭DWG文件,内嵌的VBA工程随之卸载.
无论是在CAD图形界面,还是在VBA编辑器,点保存按钮或用保存命令整个文件都会被保存下来,包括图形界面和内嵌的VBA工程.
从DWG文件中删除内嵌工程的方法:在VBA管理器中的"图形"列表框选择含有内嵌工程的DWG文件,点"提取"按钮,CAD会询问你是否保存(选择保存就会存为单独的DVB文件),无论是否保存,DWG文件中都没有这个工程了.
我们在编程时经常使用"Thisdrawing"这个关键词.它有两种含义:在通用工程中指活动文档(当前文档),在内嵌工程中指宿主文档.
如果你的程序嵌入在甲文档中,运行程序时VBA就只在甲文档中寻找块而不管你在CAD进程中是否还有其它打开的文档也不管甲文档是否是当前的活动文档.
如果你的程序是通用的,运行时VBA就只在高亮的当前文档中寻找块而不去理会隐藏在背后的其它打开的文档.

如果你编辑块时没有修改块名称,用rename命令检查块名称确信需要的块确实存在;而且VBA工程与含有块的图形文件的关系没有搞错,我们就可以肯定是CAD出问题了,重新安装吧,或者再换个版本--也许你的安装文件也有问题.

附带说一句,在"宏"对话框中点"删除"按钮只是删除工程中某个宏(就是从SUB到END SUB这一段代码),而不是删除工程.

shumabaolong · 发表于 2008-10-8 20:42:10

我不太了解程序
不知这些动画是各个构件分别独立运动，而仅仅是外观上的机构转动，
还是有主动件从动件之分，逻辑上的机构运动，
如果是后者，CAD就可以做运动仿真了，如果加上动态标注，就可以直观的分析机构，使得机构设计的效率大大提高，
非常渴望有高手写出可以使得任意四连杆机构运动的程序。

		自动登录	找回密码
密码			注册

全站		goto3d 说: 版主微信号：caivin811031；还未入三维微信群的小伙伴，速度加	2022-07-04
全站		goto3d 说: 此次SW竞赛获奖名单公布如下，抱歉晚了，版主最近太忙：一等奖：塔山817；二等奖：a9041、飞鱼；三等奖：wx_dfA5IKla、xwj960414、bzlgl、hklecon；请以上各位和版主联系，领取奖金！！！	2022-03-11

通知

[讨论] 用什么方法使曲柄连杆机构转动？

源代码基本结构没什么变化

学习收获大，遇到的问题多。

回复 58# mimimao383 的帖子

专家指点精准，收获令人振奋。

这是源代码

评分

评分

先交作业，近两个月了，感谢大师帮助。

评分

再发一次，为什么贴图看不见呢？

评分

评分