单行/多行文本添加/删除下划线

langjs

程序虽小用起来比较舒服。
一个命令即可实现添加或者删除文本下划线功能，支持单行和多行文本，支持多选。
(如果选择的是没有下划线的文本是添加下划线，如果选择的是带下划线的文本是删除下划线）



(defun c:xhx (/ a b ent i name ss str str1 txt txt1)
  (defun chstr (a b str / i str1)      ; 查找替换字符串
    (setq i 1  str1 "" )
    (while (< i (+ (strlen str) 1))
      (if (= a (substr str i (strlen a)))
        (setq str1 (strcat str1 b) i (+ i (strlen a)))
        (setq str1 (strcat str1 (substr str i 1)) i (+ i 1))))
    str1 )
  (setvar "cmdecho" 0)                       ; 主程序开始
  (vl-load-com)
  (princ "\n单行多行文本添加/删除下划线:")
  (while (setq ss (setq ss (ssget ":S" '((0 . "*TEXT")))))
    (vl-cmdf ".UNDO" "BE")
    (repeat (setq i (sslength ss))
      (setq name (ssname ss (setq i (1- i))) ent (entget name) txt (cdr (assoc 1 ent)))
      (cond
        ((= (cdr (assoc 0 ent)) "MTEXT") ; 多行文本
          (setq txt1 (chstr "\\L" "" txt))
          (if (= txt1 txt)
            (setq txt (chstr "\\P" "\\P\\L" txt) txt (strcat "\\L" txt))
            (setq txt txt1)))
        ((= (cdr (assoc 0 ent)) "TEXT")        ; 单行文本
          (if (/= (substr txt 1 3) "%%U")
            (setq txt (strcat "%%U" txt))(setq txt (substr txt 4))))
        (t))
      (entmod (subst(cons 1 txt)(assoc 1 ent)ent)))
    (vl-cmdf ".UNDO" "E"))
  (princ)
)

langjs

wangsr 发表于 2024-2-12 18:39
用过了不错，最好的一点是修改字后下划线也自动变。请教怎么删除下划线

如果能做这种线我觉的更好看点。 ...

修改后下划线长是跟着变的。如果选择的是没有下划线的文本是添加下划线，如果选择的是带下划线的文本是删除下划线

wangsr

用过了不错，最好的一点是修改字后下划线也自动变。请教怎么删除下划线

如果能做这种线我觉的更好看点。

friendship

谢谢，很方便。
要是能够同时实现选择上划线和下划线，就完美了。

szhorse

大师龙年大吉

atone

高产大神，龙年大吉

dingtiedt

新春快乐，龙年大吉！

lxl217114

大师新年好，感谢分享。

guosheyang

大师新年快乐，龙年大吉！ 感谢分享！

ghgh0130

大师新年好，感谢分享。

wangsr

谢谢分享。