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
)
代码完。