[转贴]：autolcad能否做动画?

jjxiao

下面给出几个lisp代码:大家看看效果

(defun c:fg( / dang p1 p2 ang p3 str sname)
  (setvar "cmdecho" 0)
  (setvar "osmode" 0)
  (command "zoom" "w" "0,62" "200,-58")
  (command "line" "-60,0" "260,0" "")

  (setq str '((0 . "LINE") (100 . "AcDbEntity") (67 . 0) (410 . "Model")
       (8 . "center") (100 . "AcDbLine") (10 0.0 0.0 0.0)
       (11 0.0 10.0 0.0) (210 0.0 0.0 1.0)))
  (entmake str)
  (setq sname (entlast))
  (setq dang (/ pi 180) ang (- (/ pi 2) dang))
  (setq p1 (list 0 0) p2 (polar p1 ang 10))
  (while t
          ;(if (<= ang 0) (progn (setq p3 p2 p2 p1 p1 p3 ang pi)(princ "p1==>" )(princ p1 )(princ "p2==>" )(princ p2)))
          (if (and (> dang 0)(<= ang 0)) (setq p3 (polar p1 0 10) p1 p3 p2 (polar p1 pi 10) ang pi))
          (if (and (< dang 0)(>= ang pi)) (setq p3 (polar p1 pi 10) p1 p3 p2 (polar p1 0 10) ang 0))
       (setq str (entget sname))
       (setq str (subst (cons 10 p1) (assoc 10 str) str))
       (setq str (subst (cons 11 p2) (assoc 11 str) str))
       (entmod str)
          (redraw)
       (setq sname (entlast))
          (setq ang (- ang dang))
          (setq p2 (polar p1 ang 10))
          (if (or (>= 0 (car p2))(<= 200 (car p2)))(setq p1 p2 p2 (polar p1 (/ pi 2) 10) dang (* dang -1) ang (/ pi 2)))
    )
  )
  (princ "\n成功调入!键入 fg 运行......")(prin1)


上面的代码加载后,在cad的命令行输入命令fg即可看到效果,很简单,但是起码带给我们进入新的世界.  

下面还有一个:

(defun c:pb( )  
  (setvar "cmdecho" 0)
  (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 "circle" pcen r)
  (setq obj (entlast))
  (while t
    (command "move" obj "" pcen (polar pcen ang (/ r 50)))
    (setq pcen (polar pcen ang (/ r 50)))
    (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 50)))
          (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 "")
        )
     )   
  )
)
(princ "成功调入！  ***键入 pb 运行***")
(prin1)



对应命令位pb


抛砖,请大家讨论!

zxdcad

楼主去下面地址看一看，我做的几个ACAD下运动分析。

http://www.xdcad.net/forum/showt ... pagenumber=1&s=

http://www.xdcad.net/forum/showthre...threadid=194497

http://www.xdcad.net/forum/showthread.php?s=&threadid=196491

下面给一个演示