AutoLISP文字外加矩形框
2011-03-29 10:52 精诚所至 金石为开 阅读(631) 评论(0) 编辑 收藏 举报AutoLISP文字外加矩形框，代码如下。
(defun c:test()
(setq dd (getdist "\n输入文字与线间距<2>："))
(if (null dd) (setq dd 2))
(setq ss (ssget))
(setq i 0)
(repeat (sslength ss)
(setq ssn (ssname ss i))
(setq ssdata (entget ssn))
(setq key (cdr (assoc 0 ssdata)))
(if (= key "TEXT")
(progn
(command "ucs" "e" ssn)
(setq box (textbox ssdata))
(setq p1 (car box))
(setq p3 (cadr box))
(setq p2 (list (car p3) (cadr p1)))
(setq p4 (list (car p1) (cadr p3)))
(command "pline" p1 p2 p3 p4 "c")
(setq e (entlast))
(if (/ dd nil)
(progn
(command "offset" dd (list ee p1) (polar p2 (/ pi 2) dd) "")
(entdel ee)
)
)
)
)
(setq i (1+ i))
)
(command "ucs" "")
(prin1)
)
代码完。
