选文字，没有下划线加下划线，有下划线删下划线

月之左半

工作有时需要把部分文字加下划线。有时要取消下划线。以前直接在文字下方画一条线，后来学了LISP，自己编了一个。
;;;选文字，没下划线加下划线，有下划线则删下划线**********************************************
(   defun c:xf(/ ss i ssn ssdata key oldltxtlist oldtxt pp1 newtxt newtxtlist )
     (princ "\n请选择需修改的文字，没有下划线将增加下划线，有下划线则将删除下划线：")
     (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
                      (setq oldtxtlist (assoc 1 ssdata))   
                    (setq oldtxt (cdr oldtxtlist))
                    (setq pp1 (substr oldtxt 1 3))
                    (if (= pp1 "%%u")
                      ( progn
                              (setq newtxt (substr oldtxt 4))
                           (setq newtxtlist (cons 1 newtxt))   
                          (setq ssdata (subst newtxtlist oldtxtlist ssdata))
                            (entmod ssdata)
                      )
                      (   progn
                          (setq newtxt (strcat "%%u" oldtxt))  
                             (setq newtxtlist (cons 1 newtxt))   
                            (setq ssdata (subst newtxtlist oldtxtlist ssdata))
                              (entmod ssdata)
                      ))
                 )
           )
        (setq i (1+ i))
    )                       
    (prin1)
)

wangsr

选择对象后做不下去了，请楼主出个图片

vista228

感谢大佬分享