;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;幕匠LISP实验室;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;程序功能：文字加上下划线  [备注：文字加上下划线]
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(DEFUN C:MJ170 ()
    (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.0))
    (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 ang 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)
)  
