无聊的时候玩CAD动态演示

菜卷鱼

不知道有没有人经常用CAD做动态演示？
还有另一个帖子 【再玩一次】无聊的时玩玩CAD动态演示

1. (defun undow_err(s)  
   
2. (setvar "cmdecho" 0 )      
   
3. (command "undo" "e")
   
4. (command "undo" "b" "y")
   
5. (setvar 'osmode os)
   
6. (setvar "cmdecho" 1 )
   
7. (prin1)
   
8. )
   
9. (defun c:moni ( )
   
10. (setq *error* undow_err)
    
11. (setq os (getvar 'osmode))
    
12. (princ "\n先选择待料，再选择合料主线 \n选择待料：")
    
13. (setq x1 (ssget )
    
14.       s1 (ssget )
    
15. )
    
16. (if (/= x1 nil)(setq x2 x1)(setq x1 x2))
    
17. (if (/= s1 nil)(setq s2 s1)(setq s1 s2))
    
18. 
    
19. (setq n 8)
    
20. (setq n2 4)
    
21. (setq t (/ 900 n))
    
22. 
    
23. (setvar 'cmdecho 0)
    
24. (command "undo" "be")
    
25. (setvar 'osmode 0)
    
26. (repeat 2  (command "delay" t )
    
27. (command "move" s1  ""  p0 p1)
    
28. )
    
29. 
    
30. (repeat 10
    
31. (repeat (* 2 n)
    
32. (command "delay" t )(pointt)
    
33. (command "move" s1 "" p0 p1)
    
34. )
    
35. 
    
36. (setq x 0)
    
37. (repeat (sslength x1)
    
38. (redraw (ssname x1 x) 1)
    
39. (setq x (1+ x))
    
40. )
    
41. 
    
42. (repeat (+ n 6 ) (command "delay" t )
    
43. (command "move" s1  ""  p0 p1)
    
44. )
    
45. 
    
46. (repeat 2
    
47. (command "delay" (/ t 2) )(pointt)
    
48. (command "move" x1 "" p0 p2)
    
49. 
    
50. (command "delay" (/ t 2) )(pointt)
    
51. (command "move" s1  ""  p0 p1)
    
52. (command "move" x1 ""   p0 p2)
    
53. )
    
54. 
    
55. 
    
56. 
    
57. (command "move" x1 ""   p2 p2-)
    
58. (setq x 0)
    
59. (repeat (sslength x1)
    
60. (redraw (ssname x1 x) 2)
    
61. (setq x (1+ x))
    
62. )
    
63. (command "move" s1  ""  p1 p1-)
    
64. )
    
65. 
    
66. (command "undo" "e")
    
67. (command "undo" "b" "y")
    
68. (setvar 'osmode os)
    
69. (setvar 'cmdecho 1)
    
70. (prin1))
    
71. (defun pointt ( )
    
72. (setq p0 (car(sscornerp s1)))
    
73. (setq p1 (polar p0 0 (/ 1800 (* 4 n)))    p1- (mapcar '- p1 (list 1800 0 0 ) ))
    
74. (setq p2 (polar p0 (/ pi 2) (/ 125 2))    p2- (mapcar '- p2 (list 0 250 0 ) ) )
    
75. )
    
76. 
    
77. (defun sscornerp ( s / a b i m n o ) ;;;;通用程序，取选择集对角点
    
78.     (repeat (setq i (sslength s))
    
79.         (if
    
80.             (and
    
81.                 (setq o (vlax-ename->vla-object (ssname s (setq i (1- i)))))
    
82.                 (vlax-method-applicable-p o 'getboundingbox)
    
83.                 (not (vl-catch-all-error-p (vl-catch-all-apply 'vla-getboundingbox (list o 'a 'b))))
    
84.             )
    
85.             (setq m (cons (vlax-safearray->list a) m)
    
86.                   n (cons (vlax-safearray->list b) n)
    
87.             )
    
88.         )
    
89.     )
    
90.     (if (and m n)
    
91.         (mapcar '(lambda ( a b ) (apply 'mapcar (cons a b))) '(min max) (list m n))
    
92.     )
    
93. )

(defun undow_err(s)  <br /> (setvar "cmdecho" 0 )       <br /> (command "undo" "e")<br /> (command "undo" "b" "y")<br /> (setvar 'osmode os)<br /> (setvar "cmdecho" 1 )<br /> (prin1)<br /> )<br /> (defun c:moni ( )<br /> (setq *error* undow_err)<br /> (setq os (getvar 'osmode))<br /> (princ "\n先选择待料，再选择合料主线 \n选择待料：")<br /> (setq x1 (ssget )<br />       s1 (ssget )<br /> )<br /> (if (/= x1 nil)(setq x2 x1)(setq x1 x2))<br /> (if (/= s1 nil)(setq s2 s1)(setq s1 s2))<br /> <br /> (setq n 8)<br /> (setq n2 4)<br /> (setq t (/ 900 n))<br /> <br /> (setvar 'cmdecho 0)<br /> (command "undo" "be")<br /> (setvar 'osmode 0)<br /> (repeat 2  (command "delay" t )<br /> (command "move" s1  ""  p0 p1)<br /> )<br /> <br /> (repeat 10<br /> (repeat (* 2 n)<br /> (command "delay" t )(pointt)<br /> (command "move" s1 "" p0 p1)<br /> )<br /> <br /> (setq x 0)<br /> (repeat (sslength x1)<br /> (redraw (ssname x1 x) 1)<br /> (setq x (1+ x))<br /> )<br /> <br /> (repeat (+ n 6 ) (command "delay" t )<br /> (command "move" s1  ""  p0 p1)<br /> )<br /> <br /> (repeat 2<br /> (command "delay" (/ t 2) )(pointt)<br /> (command "move" x1 "" p0 p2)<br /> <br /> (command "delay" (/ t 2) )(pointt)<br /> (command "move" s1  ""  p0 p1)<br /> (command "move" x1 ""   p0 p2)<br /> )<br /> <br /> <br /> <br /> (command "move" x1 ""   p2 p2-)<br /> (setq x 0)<br /> (repeat (sslength x1)<br /> (redraw (ssname x1 x) 2)<br /> (setq x (1+ x))<br /> )<br /> (command "move" s1  ""  p1 p1-)<br /> )<br /> <br /> (command "undo" "e")<br /> (command "undo" "b" "y")<br /> (setvar 'osmode os)<br /> (setvar 'cmdecho 1)<br /> (prin1))<br /> (defun pointt ( )<br /> (setq p0 (car(sscornerp s1)))<br /> (setq p1 (polar p0 0 (/ 1800 (* 4 n)))    p1- (mapcar '- p1 (list 1800 0 0 ) ))<br /> (setq p2 (polar p0 (/ pi 2) (/ 125 2))    p2- (mapcar '- p2 (list 0 250 0 ) ) )<br /> )<br /> <br /> (defun sscornerp ( s / a b i m n o ) ;;;;通用程序，取选择集对角点<br />     (repeat (setq i (sslength s))<br />         (if<br />             (and<br />                 (setq o (vlax-ename->vla-object (ssname s (setq i (1- i)))))<br />                 (vlax-method-applicable-p o 'getboundingbox)<br />                 (not (vl-catch-all-error-p (vl-catch-all-apply 'vla-getboundingbox (list o 'a 'b))))<br />             )<br />             (setq m (cons (vlax-safearray->list a) m)<br />                   n (cons (vlax-safearray->list b) n)<br />             )<br />         )<br />     )<br />     (if (and m n)<br />         (mapcar '(lambda ( a b ) (apply 'mapcar (cons a b))) '(min max) (list m n))<br />     )<br /> )

Lewis

感觉可以用来做动画

伪书虫86

才发现，原来可以这么强大

chenbh2

这年代屁股指挥脑袋！

aihuyujian

好牛逼的样子

zhengchuan

好厉害啊

tianyi1230

好厉害的传送带！

834798417

看着确实厉害，顶一个

就像个白痴一样

好牛逼啊,佩服...............

zuicai

很牛逼，不过用PPT来做应该更快演示效果更好。

ymp333

有啥用途呢