动画 → 撞壁回弹球

荒野孤行 · 发表于 2015-5-25 20:08

本帖最后由荒野孤行于 2015-5-25 20:11 编辑

能让你的私人定制工具箱更好玩。
请看图片动画演示：

;;;****程序开始*****
(defun c:ft ()
(setvar "cmdecho" 0)
(setvar "osmode" 0)
(princ "\n提示：程序开始...按Esc键可结束.\n")
(setq dx (getvar "screensize"))
(setq kgb (/ (car dx) (cadr dx)))
(setq hd (getvar "viewsize"))
(setq vcen (getvar "viewctr"))
(setq a (list (- (car vcen) (* hd kgb 0.5))
(- (cadr vcen) (/ hd 2))
)
)
(setq b (list (+ (car a) (* hd kgb)) (+ (cadr a) hd)))
(setq ang 1)
(setq pcen vcen)
(setq r (/ (abs (- (cadr a) (cadr b))) 10))
(setq a (list (+ (car a) r) (+ (cadr a) r))
b (list (- (car b) r) (- (cadr b) r))
)
(setq col 1)
(command "color" col)
(command "donut" 0 (* 2 r) pcen "")
(setq obj (entlast))
(while T
(command "move" obj "" pcen (polar pcen ang (/ r 100)))
(setq pcen (polar pcen ang (/ r 100)))
(if (or (> (car pcen) (car b))
(< (car pcen) (car a))
(> (cadr pcen) (cadr b))
(< (cadr pcen) (cadr a))
)
(progn
(setq pcen0 (polar pcen (+ ang pi) (/ r 100)))
(cond ((inters pcen pcen0 a (list (car a) (cadr b)))
(setq ang (- pi ang))
)
((inters pcen pcen0 b (list (car b) (cadr a)))
(setq ang (- pi ang))
)
(t (setq ang (- (* 2 pi) ang)))
)
(setq col (1+ col))
(if (= 7 col)
(setq col 1)
)
(command "change" obj "" "p" "c" col "")
))))
;;;后面还有，想看请回复。

;;;****程序开始***** 
(defun c:ft () 
  (setvar "cmdecho" 0) 
  (setvar "osmode" 0) 
  (princ "\n提示：程序开始...按Esc键可结束.\n") 
  (setq dx (getvar "screensize")) 
  (setq kgb (/ (car dx) (cadr dx))) 
  (setq hd (getvar "viewsize")) 
  (setq vcen (getvar "viewctr")) 
  (setq        a (list        (- (car vcen) (* hd kgb 0.5)) 
                (- (cadr vcen) (/ hd 2)) 
          ) 
  ) 
  (setq b (list (+ (car a) (* hd kgb)) (+ (cadr a) hd))) 
  (setq ang 1) 
  (setq pcen vcen) 
  (setq r (/ (abs (- (cadr a) (cadr b))) 10)) 
  (setq        a (list (+ (car a) r) (+ (cadr a) r)) 
        b (list (- (car b) r) (- (cadr b) r)) 
  ) 
  (setq col 1) 
  (command "color" col) 
  (command "donut" 0 (* 2 r) pcen "") 
  (setq obj (entlast)) 
  (while T 
    (command "move" obj "" pcen (polar pcen ang (/ r 100))) 
    (setq pcen (polar pcen ang (/ r 100))) 
    (if        (or (> (car pcen) (car b)) 
            (< (car pcen) (car a)) 
            (> (cadr pcen) (cadr b)) 
            (< (cadr pcen) (cadr a)) 
        ) 
      (progn 
        (setq pcen0 (polar pcen (+ ang pi) (/ r 100))) 
        (cond ((inters pcen pcen0 a (list (car a) (cadr b))) 
               (setq ang (- pi ang)) 
              ) 
              ((inters pcen pcen0 b (list (car b) (cadr a))) 
               (setq ang (- pi ang)) 
              ) 
              (t (setq ang (- (* 2 pi) ang))) 
        ) 
        (setq col (1+ col)) 
        (if (= 7 col) 
          (setq col 1) 
        ) 
        (command "change" obj "" "p" "c" col "") 
      )))) 
;;;后面还有，想看请回复。

;;;*****程序结束*****
其实源码已经全丢出去了，为了避免你们只看不回复，所以我才隐藏的，哈！！！

xiaoerduo888 · 发表于 2016-9-29 19:47

啊啊啊啊啊啊啊啊啊啊啊啊啊啊啊啊啊啊啊啊啊啊啊啊啊啊啊啊啊啊啊啊啊啊啊啊啊啊啊啊啊

永不言弃 · 发表于 2018-1-13 19:57

谢谢分享

GILES.LEI · 发表于 2019-8-12 09:52

感谢分享，想看下有没有图元接触后反馈的函数

ymcui · 发表于 2015-5-25 20:39

看起来很不错的东西，顶起来。

aming001 · 发表于 2015-5-25 21:00

xuexi bucuo!

LIULISHENG · 发表于 2015-5-26 08:29

看下什么效果

USER2128 · 发表于 2015-5-26 08:38

好玩，有创意！

love1030312 · 发表于 2015-5-26 08:54

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

[源码] 动画 → 撞壁回弹球

本帖子中包含更多资源

相关帖子