三维 动态仿真 vba编程 运行后 鼠标会闪动 请问一下 有没有好的办法解决 代码如下

liaoqt

' N/ r, d# k) u- Q0 H9 j: k
Option Explicit
! X. l: w0 }8 b* `6 bPrivate Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
Public Sub test()
    Dim Boxobj  As Acad3DSolid
    Dim cylinderobj As Acad3DSolid
    Dim Ptcen(2) As Double
4 p/ K2 P3 l& E9 r' Y    Dim Heigth As Double, Length As Double, Width As Double, Radius As Double
    Dim pt1(2) As Double
    pt1(0) = 12: pt1(1) = 0: pt1(2) = 0
    Dim sset As AcadSelectionSet
- A9 y0 {  D/ G5 M" }) U    Dim Objentity As AcadEntity
    Set sset = ThisDrawing.SelectionSets.Add("NewSSet")
  G  f6 c+ ^4 _% W3 J5 `- e" G    sset.Select acSelectionSetAll
" p( j) Y1 s% E+ U% x- ^. r! H( N/ k        For Each Objentity In sset
8 M4 h+ v7 f+ \            Objentity.Delete
/ k; Z7 D; G8 k8 H1 N7 O* y! |        Next
    sset.Delete
! W2 C& X/ b0 B( [    With ThisDrawing
/ Y3 F( T- G; w* z5 X' G6 i
! P5 k& q  [, L7 n, L' x        Ptcen(0) = 0: Ptcen(1) = -57: Ptcen(2) = -40:
        Length = 30: Width = 6: Heigth = 100
        Set Boxobj = .ModelSpace.AddBox(Ptcen, Length, Width, Heigth)
        Boxobj.color = 28
        Ptcen(0) = 0: Ptcen(1) = 57: Ptcen(2) = -40:
        Length = 30: Width = 6: Heigth = 100
. V% k( m+ E/ V7 A8 }! g        Set Boxobj = .ModelSpace.AddBox(Ptcen, Length, Width, Heigth)
        Boxobj.color = 28
6 s& E& l  t$ k  U8 z3 J
        Ptcen(0) = 0: Ptcen(1) = 0: Ptcen(2) = 0:
        Length = 10: Width = 10: Heigth = 10: Radius = 3
        Set Boxobj = .ModelSpace.AddBox(Ptcen, Length, Width, Heigth)
! j" `9 A: |2 R. w! G9 Q  Q        Set cylinderobj = .ModelSpace.AddCylinder(Ptcen, Radius, Heigth)
        cylinderobj.Rotate3D Ptcen, pt1, 90 * 3.1415926 / 180
        Boxobj.Boolean acSubtraction, cylinderobj
        Boxobj.color = 1
        Radius = 2.8
$ l$ G' O1 Z3 C) }9 `/ F        Heigth = 120
        Set cylinderobj = .ModelSpace.AddCylinder(Ptcen, Radius, Heigth)
& n. o. x3 R$ B7 p+ x* x        cylinderobj.Rotate3D Ptcen, pt1, 90 * 3.1415926 / 180
9 ]' F( ?( l  ~1 r' i+ k        cylinderobj.color = 2
6 x" D$ J! y7 v5 B: N
    End With
+ K0 B3 L& T4 X' H$ [" |5 [    Dim Frompt(2) As Double, Topt(2) As Double
    Frompt(0) = 0: Frompt(1) = 0: Frompt(2) = 0
    Topt(0) = 0: Topt(1) = -49: Topt(2) = 0
( b2 ?; v+ ^8 ?    Boxobj.Move Frompt, Topt
    Boxobj.Update
    Frompt(1) = -49
1 K  X1 H+ j/ p) N! a* X- j  v    Topt(1) = -48.9
    Dim num1 As Double, num As Double
( [) l# x) x. W8 u( W" e% {; u$ x    num1 = 1
; h1 ?  d+ h( Y" b8 E" \3 @% a+ t    Do
3 b+ z: F9 F5 {% y        If Topt(1) >= 49 Then
7 Q9 k8 s' n9 R- [9 |( a            num = Topt(1)
# [1 E. Y% _: O% F% U            Topt(1) = Frompt(1)
            Frompt(1) = num
            num1 = -1
# b6 `% ?* o  K) T        ElseIf Topt(1) <= -49 Then
9 k/ l7 M' r" }" e5 }2 z            num = Topt(1)
0 ~2 S1 s1 B" b' |  H* ^            Topt(1) = Frompt(1)
$ ~9 F& }8 x  N            Frompt(1) = num
2 f+ q) B) A! f/ i8 X  @" U: i            num1 = 1
        End If
6 ^( A5 t( p% Y        Frompt(1) = Frompt(1) + 0.1 * num1
        Topt(1) = Topt(1) + 0.1 * num1
4 L9 K0 i4 C$ u* T4 Z4 s        Boxobj.Move Frompt, Topt
6 G4 h4 ^5 c" Y" J" W8 ]; i        Call DelayTime(1)
9 j+ s, W; h9 n; |        Boxobj.Update
- B8 E; U) P+ W& e& z* @7 j        If GetAsyncKeyState(27) = -32767 Then
- N1 b) J  h- y1 m            Exit Do
        End If
6 r* U$ `5 K. g( N- s    Loop
1 k* y  k: N5 _  jEnd Sub
  j) y) U  ~5 u: v" I3 L# q, R0 I4 u8 J

Public Function DelayTime(ByVal timer As Integer)  '延时函数
/ D6 w7 y" Z1 e& E" w    Dim firsttimer As Long
    Dim i As Integer
9 Y6 ?$ W, V+ m' O% }1 I    firsttimer = timeGetTime
    For i = 0 To timer
       While timeGetTime < firsttimer + 20
) m9 V  I: {$ g& f1 B, z            DoEvents
& I, P2 a- E5 {; n       Wend
* o9 r5 _/ K" I# v# Z       firsttimer = timeGetTime
) S! k6 T  R) d, y4 L: |% y4 A+ h    Next i
End Function

# W/ r$ a6 z0 j2 O) u7 [
% b& j3 {. Q& D- Q
7 S7 a8 z" P! H: U; G6 z% T
1 l7 ~/ d! |" H2 V# T2 I

woaishuijia

timeGetTime函数没有声明

liaoqt

woaishuijia 发表于 2014-10-8 08:23 static/image/common/back.gif
7 Z# d5 J) ]% J: ktimeGetTime函数没有声明

是我粘贴时后忘了   实际上是申明过了的    主要问题是鼠标会闪在运行时   

woaishuijia

5 T, Z9 V( Z' o$ i3 i8 ^
把要移动的对象做成块,再插入块参照,用修改块参照对象的InsertionPoint属性的办法改变它的位置,不使用MOVE方法
  g* z9 E! @2 F- U8 C- D/ M! T看这个用什么方法使曲柄连杆机构转动？
PS:重帖下你的代码.以后发帖时请注意用"添加代码文字"的方法,否则代码中会有大量乱码,别人复制你的代码会很麻烦

1. Option Explicit
   9 T: `& R+ a; n$ _) Q
2. Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
   4 }  e4 m9 T7 T7 }/ a
3. Private Declare Function timeGetTime Lib "winmm.dll" () As Long
   ) F$ i$ _3 v) t4 P
4. Public Sub test()
   
5. Dim Boxobj As Acad3DSolid
   7 m* o* r3 y6 I
6. Dim cylinderobj As Acad3DSolid
   % Y: G" D3 R/ _7 B! ?0 u0 g$ C
7. Dim Ptcen(2) As Double
   ' s+ w: O+ H8 u, I6 ]9 \
8. Dim Heigth As Double, Length As Double, Width As Double, Radius As Double
   
9. Dim pt1(2) As Double
   
10. pt1(0) = 12: pt1(1) = 0: pt1(2) = 0
    ) n% U! e0 c) l+ x6 Y
11. Dim sset As AcadSelectionSet
    : ~6 w9 r+ ]1 \' w& ?' ?- e
12. Dim Objentity As AcadEntity
    
13. Set sset = ThisDrawing.SelectionSets.Add("NewSSet")
    6 u! p6 y6 C; K1 g* b$ a
14. sset.Select acSelectionSetAll
    # L+ x8 h" `; d: i4 I1 \
15. For Each Objentity In sset
    
16. Objentity.Delete
    - R- b: P- x% |# M
17. Next
    4 I' q/ p# w: G" `
18. sset.Delete
    - a3 F! X: J( ^6 B
19. With ThisDrawing
    
20. 
    * }  h$ M) P- @9 T
21. Ptcen(0) = 0: Ptcen(1) = -57: Ptcen(2) = -40:
    
22. Length = 30: Width = 6: Heigth = 100
    & z* n- w: k7 L/ o+ W! R
23. Set Boxobj = .ModelSpace.AddBox(Ptcen, Length, Width, Heigth)
    + s1 I6 w- _  k
24. Boxobj.color = 28
    1 d) s" ^9 A  q* K5 z3 P2 M5 A
25. Ptcen(0) = 0: Ptcen(1) = 57: Ptcen(2) = -40:
    . c7 S$ T! p; p. K& y
26. Length = 30: Width = 6: Heigth = 100
    ! \3 N5 p0 W% {
27. Set Boxobj = .ModelSpace.AddBox(Ptcen, Length, Width, Heigth)
    
28. Boxobj.color = 28
    4 |" t7 H/ a+ P1 H" S! A- n9 b6 W3 Y
29. 
    
30. Ptcen(0) = 0: Ptcen(1) = 0: Ptcen(2) = 0:
    
31. Length = 10: Width = 10: Heigth = 10: Radius = 3
    2 b' s9 n( C. }5 d
32. Set Boxobj = .ModelSpace.AddBox(Ptcen, Length, Width, Heigth)
    
33. Set cylinderobj = .ModelSpace.AddCylinder(Ptcen, Radius, Heigth)
    : s4 }- H, j2 C7 ]/ X, ]5 f
34. cylinderobj.Rotate3D Ptcen, pt1, 90 * 3.1415926 / 180
    
35. Boxobj.Boolean acSubtraction, cylinderobj
    
36. Boxobj.color = 1
    / T: X& L& C+ i" A( v
37. Radius = 2.8
    ( L" f/ Z; g! B. w' h! Z
38. Heigth = 120
    
39. Set cylinderobj = .ModelSpace.AddCylinder(Ptcen, Radius, Heigth)
    0 ^( |# l! W7 d+ C2 M  ^
40. cylinderobj.Rotate3D Ptcen, pt1, 90 * 3.1415926 / 180
    
41. cylinderobj.color = 2
    3 l/ M  f; y# z3 d- h
42. 
    
43. End With
    
44. Dim Frompt(2) As Double, Topt(2) As Double
    
45. Frompt(0) = 0: Frompt(1) = 0: Frompt(2) = 0
    
46. Topt(0) = 0: Topt(1) = -49: Topt(2) = 0
    1 |5 q( H' C) F
47. Boxobj.Move Frompt, Topt
    
48. Boxobj.Update
    
49. Frompt(1) = -49
    . k# }! l6 U) F
50. Topt(1) = -48.9
    2 p# r' d+ X. a4 q" B) Q; |% L4 Z+ K
51. Dim num1 As Double, num As Double
    
52. num1 = 1
    * ^" o/ H5 v2 Q; g+ }$ v. A
53. Do
    
54. If Topt(1) >= 49 Then
    
55. num = Topt(1)
    
56. Topt(1) = Frompt(1)
    * @8 y. N% h( `
57. Frompt(1) = num
    4 b5 E; m/ T3 ?
58. num1 = -1
    
59. ElseIf Topt(1) <= -49 Then
    3 G. \" y/ d; {" P: Y
60. num = Topt(1)
    
61. Topt(1) = Frompt(1)
      W( Y# j( Y4 o# o3 t. h
62. Frompt(1) = num
    ; L5 {1 j5 P1 S5 W2 m0 m; @! s
63. num1 = 1
    1 t4 j9 ?' V0 z
64. End If
    
65. Frompt(1) = Frompt(1) + 0.1 * num1
      \0 a" B( [! x
66. Topt(1) = Topt(1) + 0.1 * num1
    , t4 }8 h2 N, B. f* T
67. Boxobj.Move Frompt, Topt
    
68. Call DelayTime(1)
    7 b4 D9 s# c: J0 ^
69. Boxobj.Update
    
70. If GetAsyncKeyState(27) = -32767 Then
    * V& s4 W! l8 x& D1 o- H  b
71. Exit Do
    0 Z) w0 `  b+ G! t
72. End If
    
73. Loop
    
74. End Sub
    1 `' i5 F7 b4 [$ `! Q
75. 
    . d9 d& m0 s; M5 u9 M
76. 
    ) G8 T3 Q; R9 S; V+ i% K
77. Public Function DelayTime(ByVal timer As Integer) '延时函数
    3 H; Q/ c+ m  l+ b' K; q! n; t
78. Dim firsttimer As Long
    
79. Dim i As Integer
    4 r  ?) \1 w& F& O+ ?
80. firsttimer = timeGetTime
    
81. For i = 0 To timer
    8 r# g& \; O) \7 c7 ?5 t; L
82. While timeGetTime < firsttimer + 20
    
83. DoEvents
    
84. Wend
    ) }" L' h* W+ `: [4 V, c
85. firsttimer = timeGetTime
    
86. Next i
    - R! K/ ]% [5 u) g9 E* S
87. End Function

复制代码

liaoqt

woaishuijia 发表于 2014-10-9 06:42 static/image/common/back.gif
把要移动的对象做成块,再插入块参照,用修改块参照对象的InsertionPoint属性的办法改变它的位置,不使用MOVE方 ...

$ @; d- V& T& k非常感谢你  推荐的帖子里 有代码解释 赞一个 :lol: