代码改变世界

AutoLISP手指图案

2011-03-28 20:26  精诚所至 金石为开  阅读(331)  评论(0编辑  收藏  举报

AutoLISP手指图案,代码如下。

(defun c:test()
  (setvar "cmdecho" 0)
  (setq os (getvar "osmode"))
  (setq oldlayer (getvar "clayer"))
  (setvar "osmode" 0)
  (setq cenpt (getpoint "圆心:"))
  (setq dia (getpoint "\n直径<96>:")) (if (null dia) (setq dia 96))
  (setq n (getint "\n手指头数目<4>:")) (if (null n) (setq n 4))
  (command "-layer" "m" "str" "c" 4 "" "")
  (command "circle" cenpt "d" dia)
  (setq ent (entlast))
  (setq r (* dia 0.5) x1 (/ r n) x2 (* x1 0.5))
  (setq k (- r x2) p0 cenpt)
  (setq i 1)
  (repeat (1- n)
    (setq ang (acos (/ x2 k)))
    (setq arcen (polar cenpt ang k))
    (setq p0 (polar cenpt 0 (* i x1)))
    (setq p1 (polar arcen 0 (/ x1 2)))
    (setq p2 (polar arcen pi (/ x1 2)))
    (command "arc" p1 "c" arcen p2)
    (if (= i 1) (command "line" cenpt p2 ""))
    (command "line" p0 p1 "")
    (command "arc" p0 "c" cenpt "a" -90)
    (setq i (1+ i) x2 (+ x2 x1))
    )
  (command "arc" p0 "e" (polar p0 0 x1) "a" -180)
  (command "array" (get_ss ent) "" "p" cenpt 2 "" "")
  (command "-layer" "m" "dim" "c" 1 "" "")
  (command "dim1" "ver" "" (list ent cenpt) "t" (strcat "%%c" "<>") (polar cenpt 0 (+ r 10)))
  (command "-group" "c" "*" "" ent (get_ss ent) "")
  (setvar "osmode" os)
  (setvar "clayer" oldlayer)
  (prin1)
  )
(defun acos(val)
  (atan (/ (sqrt (- 1.0 (* val val))) val))
  )
(defun get_ss(ref_en)
  (setq ss (ssadd))
  (while (setq en (entnext ref_en))
    (setq ss (ssadd en ss) ref_en en)
    )
  ss
  )

代码完。