单行/多行文本添加/删除下划线
本帖最后由 langjs 于 2024-2-12 19:20 编辑程序虽小用起来比较舒服。
一个命令即可实现添加或者删除文本下划线功能，支持单行和多行文本，支持多选。
(如果选择的是没有下划线的文本是添加下划线，如果选择的是带下划线的文本是删除下划线）
(defun c:xhx (/ a b ent i name ss str str1 txt txt1)
(defun chstr (a b str / i str1) ; 查找替换字符串
(setq i 1str1 "" )
(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)
)
(if (= "MTEXT" (cdr (assoc 0 ent))) ; 如选多行文本，则转化为单行文本
(progn
(command ".EXPLODE" ent1)
(setq ent1 (entlast))
(setq ent (entget ent1))
)
怎么把这个“如选多行文本，则转化为单行文本”的代码加进去，大神能改进一下吗 wangsr 发表于 2024-2-12 18:39
用过了不错，最好的一点是修改字后下划线也自动变。请教怎么删除下划线
如果能做这种线我觉的更好看点。 ...
修改后下划线长是跟着变的。如果选择的是没有下划线的文本是添加下划线，如果选择的是带下划线的文本是删除下划线 本帖最后由 wangsr 于 2024-2-12 18:43 编辑
用过了不错，最好的一点是修改字后下划线也自动变。请教怎么删除下划线
如果能做这种线我觉的更好看点。
大师龙年大吉 高产大神，龙年大吉 新春快乐，龙年大吉！ 大师新年好，感谢分享。 大师新年快乐，龙年大吉！ 感谢分享！ 大师新年好，感谢分享。 谢谢分享。