动画 → 撞壁回弹球

keyear

这个和lee-mac好像

snowfq

学习下，太牛了

snowfq

2. ;;;****程序开始*****
   
3. (defun c:ft ()
   
4.   (setvar "cmdecho" 0)
   
5.   (setvar "osmode" 0)
   
6.   (princ "\n提示：程序开始...按Esc键可结束.\n")
   
7.   (setq dx (getvar "screensize"))
   
8.   (setq kgb (/ (car dx) (cadr dx)))
   
9.   (setq hd (getvar "viewsize"))
   
10.   (setq vcen (getvar "viewctr"))
    
11.   (setq  a (list  (- (car vcen) (* hd kgb 0.5))
    
12.     (- (cadr vcen) (/ hd 2))
    
13.     )
    
14.   )
    
15.   (setq b (list (+ (car a) (* hd kgb)) (+ (cadr a) hd)))
    
16.   (setq pcen vcen)
    
17.   (setq r (* 2 (/ (abs (- (cadr a) (cadr b))) 10)))
    
18.   (setq  a (list (+ (car a) r) (+ (cadr a) r))
    
19.   b (list (- (car b) r) (- (cadr b) r))
    
20.   )
    
21.   (setq  ss (ssadd)
    
22.   n  0
    
23.   )
    
24.   (command "color" 1)
    
25.   (while (< n 10)
    
26.     (command "circle" pcen r)
    
27.     (ssadd (entlast) ss)
    
28.     (setq n (+ n 1))
    
29.   )
    
30. ;;;  (setq obj (entlast)
    
31. ;;;  e (entget obj))
    
32.   (xunhuan ss a b r)
    
33. )
    
34. 
    
35. 
    
36. (defun xunhuan (ss a b r / col n ang angs ang1 col)
    
37.   (setq angs (list 0.1 0.2 0.3 0.4 0.5 0.6 0.7 0.8 0.9 1))
    
38.   (while T
    
39.     (setq n 0)
    
40.     (while (< n 10)
    
41.       (setq e   (entget (ssname ss n))
    
42.       obj   (ssname ss n)
    
43.       pcen (cdr (assoc 10 e))
    
44.       col   (cdr (assoc 62 e))
    
45.       ang   (nth n angs)
    
46.       )
    
47. ;;;      (setq f (polar pcen ang (/ r 100)))
    
48. ;;;      (setq e (subst (cons 10 f) (assoc 10 e) e))
    
49. ;;;      (entmod e)
    
50.       (command "move" obj "" pcen (polar pcen ang (/ r 100)))
    
51.       (setq pcen (polar pcen ang (/ r 100)))
    
52.       (if (or (> (car pcen) (car b))
    
53.         (< (car pcen) (car a))
    
54.         (> (cadr pcen) (cadr b))
    
55.         (< (cadr pcen) (cadr a))
    
56.     )
    
57.   (progn
    
58.     (setq pcen0 (polar pcen (+ ang pi) (/ r 100)))
    
59.     (cond  ((inters pcen pcen0 a (list (car a) (cadr b)))
    
60.      (setq ang1 (- pi ang))
    
61.     )
    
62.     ((inters pcen pcen0 b (list (car b) (cadr a)))
    
63.      (setq ang1 (- pi ang))
    
64.     )
    
65.     (t (setq ang1 (- (* 2 pi) ang)))
    
66.     )
    
67.     (princ ang)
    
68.     (princ ang1)
    
69.     (setq angs (subst ang1 ang angs))
    
70.     (princ angs)
    
71.     (setq col (1+ col))
    
72.     (if (= 7 col)
    
73.       (setq col 1)
    
74.     )
    
75.     (command "change" obj "" "p" "c" col "")
    
76. ;;;    (setq e (subst (cons 62 col) (assoc 62 e) e))
    
77. ;;;    (entmod e)
    
78.   )
    
79.       )
    
80.       (setq n (+ n 1))
    
81. ;;;      (command "delay" "1")
    
82.     )
    
83.   )
    
84. )

;;;****程序开始*****<br /> (defun c:ft ()<br />   (setvar "cmdecho" 0)<br />   (setvar "osmode" 0)<br />   (princ "\n提示：程序开始...按Esc键可结束.\n")<br />   (setq dx (getvar "screensize"))<br />   (setq kgb (/ (car dx) (cadr dx)))<br />   (setq hd (getvar "viewsize"))<br />   (setq vcen (getvar "viewctr"))<br />   (setq  a (list  (- (car vcen) (* hd kgb 0.5))<br />     (- (cadr vcen) (/ hd 2))<br />     )<br />   )<br />   (setq b (list (+ (car a) (* hd kgb)) (+ (cadr a) hd)))<br />   (setq pcen vcen)<br />   (setq r (* 2 (/ (abs (- (cadr a) (cadr b))) 10)))<br />   (setq  a (list (+ (car a) r) (+ (cadr a) r))<br />   b (list (- (car b) r) (- (cadr b) r))<br />   )<br />   (setq  ss (ssadd)<br />   n  0<br />   )<br />   (command "color" 1)<br />   (while (< n 10)<br />     (command "circle" pcen r)<br />     (ssadd (entlast) ss)<br />     (setq n (+ n 1))<br />   )<br /> ;;;  (setq obj (entlast)<br /> ;;;  e (entget obj))<br />   (xunhuan ss a b r)<br /> )<br /> <br /> <br /> (defun xunhuan (ss a b r / col n ang angs ang1 col)<br />   (setq angs (list 0.1 0.2 0.3 0.4 0.5 0.6 0.7 0.8 0.9 1))<br />   (while T<br />     (setq n 0)<br />     (while (< n 10)<br />       (setq e   (entget (ssname ss n))<br />       obj   (ssname ss n)<br />       pcen (cdr (assoc 10 e))<br />       col   (cdr (assoc 62 e))<br />       ang   (nth n angs)<br />       )<br /> ;;;      (setq f (polar pcen ang (/ r 100)))<br /> ;;;      (setq e (subst (cons 10 f) (assoc 10 e) e))<br /> ;;;      (entmod e)<br />       (command "move" obj "" pcen (polar pcen ang (/ r 100)))<br />       (setq pcen (polar pcen ang (/ r 100)))<br />       (if (or (> (car pcen) (car b))<br />         (< (car pcen) (car a))<br />         (> (cadr pcen) (cadr b))<br />         (< (cadr pcen) (cadr a))<br />     )<br />   (progn<br />     (setq pcen0 (polar pcen (+ ang pi) (/ r 100)))<br />     (cond  ((inters pcen pcen0 a (list (car a) (cadr b)))<br />      (setq ang1 (- pi ang))<br />     )<br />     ((inters pcen pcen0 b (list (car b) (cadr a)))<br />      (setq ang1 (- pi ang))<br />     )<br />     (t (setq ang1 (- (* 2 pi) ang)))<br />     )<br />     (princ ang)<br />     (princ ang1)<br />     (setq angs (subst ang1 ang angs))<br />     (princ angs)<br />     (setq col (1+ col))<br />     (if (= 7 col)<br />       (setq col 1)<br />     )<br />     (command "change" obj "" "p" "c" col "")<br /> ;;;    (setq e (subst (cons 62 col) (assoc 62 e) e))<br /> ;;;    (entmod e)<br />   )<br />       )<br />       (setq n (+ n 1))<br /> ;;;      (command "delay" "1")<br />     )<br />   )<br /> )

liu475693830

这个好玩，又可以拿来装了

liu475693830

可否加点东西，在按ESC结束后，自动删除图中的回弹球

819534890

好玩好玩啊

奋斗的研究生

这个厉害学习了

376394482

鼓掌

lidaxiu

路过，学习了

GNJLISP

这个不错，，，，