[函数] 单行/多行文本添加/删除下划线
程序虽小用起来比较舒服。一个命令即可实现添加或者删除文本下划线功能，支持单行和多行文本，支持多选。
(如果选择的是没有下划线的文本是添加下划线，如果选择的是带下划线的文本是删除下划线）
(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)
)
页:
[1]