月之左半 发表于 2023-10-25 14:59:11

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

工作有时需要把部分文字加下划线。有时要取消下划线。以前直接在文字下方画一条线，后来学了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 (entgetssn))
      (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 发表于 2023-10-26 06:57:02

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

vista228 发表于 2023-11-10 17:57:34

感谢大佬分享
页: [1]
查看完整版本: 选文字，没有下划线加下划线，有下划线删下划线