AutoLISP文字加上下划线
2011-03-29 15:17 精诚所至 金石为开 阅读(581) 评论(0) 编辑 收藏 举报AutoLISP文字加上下划线，代码如下。
(defun c:test()
(initget "T B A")
(setq typ (getkword "\n绘图形式[T顶线，B底线，A上下线]<B>:"))
(if (null typ) (setq typ "B"))
(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)))
(setq ang (angle p1 p4))
(setq ee (entlast))
(cond ((= typ "T") (command "line" (polar p4 ang dd) (polar p3 and dd) ""))
((= typ "B") (command "line" (polar p1 (- ang) dd) (polar p2 (- ang) dd) ""))
((= typ "A") (command "line" (polar p4 ang dd) (polar p3 ang dd) "")
(command "line" (polar p1 (- ang) dd) (polar p2 (- ang) dd) ""))
)
)
)
(setq i (1+ i))
)
(command "ucs" "")
(prin1)
)
代码完。
上划线T不成功。
