明经CAD社区

 找回密码
 注册

扫一扫,访问微社区

QQ登录

只需一步,快速开始

楼主: 荒野孤行

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

[复制链接]
发表于 2015-6-16 08:27 | 显示全部楼层
这个和lee-mac好像
发表于 2015-6-16 11:11 | 显示全部楼层
学习下,太牛了
发表于 2015-6-19 14:50 | 显示全部楼层
[code="lisp] ;;;****程序开始*****
(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 pcen vcen)
  (setq r (* 2 (/ (abs (- (cadr a) (cadr b))) 10)))
  (setq  a (list (+ (car a) r) (+ (cadr a) r))
  b (list (- (car b) r) (- (cadr b) r))
  )
  (setq  ss (ssadd)
  n  0
  )
  (command "color" 1)
  (while (< n 10)
    (command "circle" pcen r)
    (ssadd (entlast) ss)
    (setq n (+ n 1))
  )
;;;  (setq obj (entlast)
;;;  e (entget obj))
  (xunhuan ss a b r)
)


(defun xunhuan (ss a b r / col n ang angs ang1 col)
  (setq angs (list 0.1 0.2 0.3 0.4 0.5 0.6 0.7 0.8 0.9 1))
  (while T
    (setq n 0)
    (while (< n 10)
      (setq e   (entget (ssname ss n))
      obj   (ssname ss n)
      pcen (cdr (assoc 10 e))
      col   (cdr (assoc 62 e))
      ang   (nth n angs)
      )
;;;      (setq f (polar pcen ang (/ r 100)))
;;;      (setq e (subst (cons 10 f) (assoc 10 e) e))
;;;      (entmod e)
      (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 ang1 (- pi ang))
    )
    ((inters pcen pcen0 b (list (car b) (cadr a)))
     (setq ang1 (- pi ang))
    )
    (t (setq ang1 (- (* 2 pi) ang)))
    )
    (princ ang)
    (princ ang1)
    (setq angs (subst ang1 ang angs))
    (princ angs)
    (setq col (1+ col))
    (if (= 7 col)
      (setq col 1)
    )
    (command "change" obj "" "p" "c" col "")
;;;    (setq e (subst (cons 62 col) (assoc 62 e) e))
;;;    (entmod e)
  )
      )
      (setq n (+ n 1))
;;;      (command "delay" "1")
    )
  )
)[/code]
发表于 2015-10-11 01:54 | 显示全部楼层
这个好玩,又可以拿来装了
发表于 2015-10-11 01:59 | 显示全部楼层
可否加点东西,在按ESC结束后,自动删除图中的回弹球
发表于 2015-10-11 09:33 | 显示全部楼层
好玩好玩啊
发表于 2015-10-11 18:16 | 显示全部楼层
这个厉害学习了
发表于 2015-10-12 17:12 | 显示全部楼层
鼓掌
发表于 2015-10-13 08:04 | 显示全部楼层
路过,学习了
发表于 2016-8-4 12:58 | 显示全部楼层
这个不错,,,,
您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号  
©2000-2017 明经通道 版权所有 本站代码,在未取得本站及作者授权的情况下,不得用于商业用途

GMT+8, 2018-4-25 04:52 , Processed in 0.215784 second(s), 22 queries , Gzip On.

Powered by Discuz! X3.3

© 2001-2013 Comsenz Inc.

快速回复 返回顶部 返回列表