【递增】【完善】JJJ（汉字序号、字母左加右减）
本帖最后由 1028695446 于 2020-10-27 19:27 编辑已更新！！！ 支持CAD2021
===============================================
原贴：http://bbs.mjtd.com/forum.php?mo ... %D3%D2%BC%FC&page=1
原贴，适用对象：单行文字
本帖，修正后，适用对象：单行文字+多行文字
见下面的第三个附件 时间为 2020.3.21 的lsp文件
(defun c:qrr ( / *error* ang_text b_find badd bo2 box1 box2 dl e e1 e2 edata elist ell en ename ent etext f_width i i_length ipos lendelimiter lensource lst1 lstresult lstsource lstsub minx n newe pt ptt sdelimiter sname ss ss1 ssource str str_current str_defined str_given str_lst_return str_lst_temp str_lst_text str_text string string1 string2 strlst_defined strlst_defined2 text x lst elist right_change old_SHORTCUTMENU enable_change)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun *error* (msg)
(and id (unload_dialog id))
(and exprt (setvar 'expert exprt))
(and file (vl-file-delete file))
(if (not (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*"))
(princ (strcat "\程序函数被取消: " msg))
)
(princ)
)
(defun wzhb(ss /i ename dl ell x text e1 e2)
;(setq ss ss2)
(setq
i0
dl nil
minx nil
);setq
(if ss (progn(sssetfirst nil ss)))
(if (setq ss(ssget "P" '((0 . "TEXT"))))
(progn
(if (/= (sslength ss) 1)
(progn
(repeat (sslength ss)
(setq ename (ssname ss i)
ell (entget ename)
x (cadr (assoc 10 ell))
text (cdr (assoc 1 ell))
i (1+ i)
);setq
(setq dl (append dl (list (list x text ename))))
);repeat
(setq dl (vl-sort dl (function (lambda (e1 e2) (< (car e1) (car e2)))))
i 1
text(cadr (nth 0 dl))
ename (caddr (nth 0 dl))
ell (entget ename)
);setq
(repeat (- (length dl) 1)
(setq text (strcat text (cadr (nth i dl))))
(entdel (caddr (nth i dl)))
(setq i (1+ i))
);repeat
(setq ell (subst (cons 1 text) (assoc 1 ell) ell))
(entmod ell)
(entupd ename)
);progn
(progn
(setq ename(ssname ss 0))
(setq text (cdr(assoc 1 (entget ename))))
)
)
)
);if
;(princ)
(list ename text)
)
;=====================================================
;================= 文字打断 ===================
;=====================================================
;打断所有文字
(defun wzcf (ss /i n )
(if ss
(progn
(setvar "CMDECHO" 0)
(if (= 0 (boole 1 8 (getvar 'undoctl))) (command "_.undo" "_group"))
(setq i -1
n (sslength ss)
)
(while (< (setq i (1+ i)) n)
(if (and (setq ss2 (EF_Text:BreakAll (ssname ss i)) )
(>= (sslength ss2) 1)
)
(EF:PickSet-Group ss2 "文字炸开")
)
)
(if (= 8 (boole 1 8 (getvar 'undoctl))) (command "_.undo" "_end"))
)
)
)
;将ss成组
(defun EF:PickSet-Group (ss sName / )
(command "Group" "C" "*" sName ss "")
)
;文字打断所有
(defun EF_Text:BreakAll (eText ;待炸开的文字
/
ss
edata
str_Text
str_lst_Text
ang_Text
pt
)
(setq ss (ssadd))
(setq edata (entget eText))
(setq str_Text (cdr (assoc 1 edata)))
(setq str_lst_Text (EF_Text:StringExplode str_Text)
) ;将字符串拆解成单字列表
(if (or (= (assoc 72 edata) 3) ;对齐方式对齐
(= (assoc 72 edata) 5) ;对齐方式拟合
)
(setq ang_Text (angle (cdr (assoc 10 edata)) (cdr (assoc 11 edata))))
(setq ang_Text (cdr (assoc 50 edata)))
)
(setq pt (cdr (assoc 10 edata)))
(setq edata (list '(0 . "TEXT")
(assoc 8 edata) ;图层
(assoc 40 edata) ;高度
(assoc 41 edata) ;宽度
(assoc 7 edata) ;样式
(assoc 71 edata) ;文字镜像
(cons 50 ang_Text) ;转角
(assoc 51 edata) ;倾角
)
)
(while str_lst_Text
(setq str_Current (car str_lst_Text))
(setq f_Width (EF_Text:getTextWidth str_Current edata))
;(EF-Text-PointWrite str_Current pt edata) ;按实际插入点填写文字
;;; (if (and (/= str_Current " ") (/= str_Current " "))
;;; (progn
(entmake (EF:List-SubstAssoc (list (cons 1 str_Current) (cons 10 pt)) edata T))
(setq ss (ssadd (entlast) ss))
;;; )
;;; )
(if (= (boole 1 (cdr (assoc 71 edata)) 2) 2)
(setq pt (polar pt ang_Text (- 0 f_Width)))
(setq pt (polar pt ang_Text f_Width))
)
(setq str_lst_Text (cdr str_lst_Text))
)
;(entdel eText);;;;修改
ss
)
;=============================================================;
;拆分字符串 ;
;EF_Text:StringExplode ;
;=============================================================;
;取得 空格 宽度
(defun EF_Text:getTextWidth (str ;需要检测的字符串,如果为nil则取 edata
edata ;需要检测的文字样式图元表
/
box1 bo2
)
(if (not str) (setq str (cdr (assoc 1 edata))))
(setq box1 (textbox (EF:List-SubstAssoc (list (cons 1 (strcat "m" str "m"))) edata T)))
(setq box2 (textbox (EF:List-SubstAssoc (list (cons 1 "mm")) edata T)))
(- (- (caadr box1) (caar box1))
(- (caadr box2) (caar box2))
)
)
;获取打断排除列表(单字符)
(defun EF_Text:getBreakDefined ( / )
(EF:String->List "%%130||%%131||%%132||%%133||%%134||%%135||%%136||%%p||%%P||%%c||%%C" "||")
)
;获取打断排除列表(成对字符)
(defun EF_Text:getBreakDefined2 ( / )
(mapcar '(lambda (e)
(EF:String->List e "*")
)
(EF:String->List "%%140*%%141||%%142*%%143||%%200*%%201||%%202*%%203||%%204*%%205" "||")
)
)
;字符串拆分
(defun EF_Text:StringExplode (str_Given ;需要转换的字符串
/
strlst_Defined ;单定义字符例：'("%%130" "%%131" "%%132" "%%p" ...)
strlst_Defined2 ;成对定义字符 例 '((%%200 %%201) (%%202 %%203))
b_Find ;是否找到特殊字符串
str_Defined ;特殊字符串
i_Length ;特殊字符串 长度
str_lst_Return ;返回字符串列表
e
)
(setq strlst_Defined (EF_Text:getBreakDefined))
(setq strlst_Defined2 (EF_Text:getBreakDefined2))
;检查字符串首是否在特殊字符串列表中
(while (> (strlen str_Given) 0)
(setq b_Find nil)
;检查 单定义字符
(setq str_lst_Temp strlst_Defined)
(while (and str_lst_Temp (not b_Find))
(setq str_Defined (car str_lst_Temp ))
(setq i_Length (strlen str_Defined))
(if (= (substr str_Given 1 i_Length) str_Defined)
(setq b_Find T)
)
(setq str_lst_Temp (cdr str_lst_Temp))
)
;检查 成对定义字符
(setq str_lst_Temp strlst_Defined2)
(while (and str_lst_Temp (not b_Find))
(setq str_Defined (caar str_lst_Temp ))
(setq i_Length (strlen str_Defined))
(if (= (substr str_Given 1 i_Length) str_Defined)
(progn
(setq b_Find T)
(setq str_Defined (car str_lst_Temp))
)
)
(setq str_lst_Temp (cdr str_lst_Temp))
)
(cond (b_Find ;特殊字符串
(progn
(if (equal (type str_Defined) 'STR)
(progn
(setq str_lst_Return (cons str_Defined str_lst_Return))
(setq str_Given (substr str_Given (1+ i_Length)))
)
(progn
(if (setq i (vl-string-search (cadr str_Defined) str_Given))
(progn
(setq e (substr str_Given 1 (+ i (strlen (cadr str_Defined)))))
(setq str_lst_Return (cons e str_lst_Return))
(setq str_Given (substr str_Given (+ 1 i (strlen (cadr str_Defined)))))
)
(progn
(setq str_lst_Return (cons (car str_Defined) str_lst_Return))
(setq str_Given (substr str_Given (1+ i_Length)))
)
)
)
)
)
)
((> (ascii (substr str_Given 1 1)) 128) ;大于128为汉字
(if (>= (atof (getvar "acadver")) 24)
(progn
(setq str_lst_Return (cons (substr str_Given 1 1) str_lst_Return))
(setq str_Given (substr str_Given 2))
)
(progn
(setq str_lst_Return (cons (substr str_Given 1 2) str_lst_Return))
(setq str_Given (substr str_Given 3))
)
)
)
(T
(setq str_lst_Return (cons (substr str_Given 1 1) str_lst_Return))
(setq str_Given (substr str_Given 2))
)
)
)
(reverse str_lst_Return)
)
;将字符串字符串以 给定 Key 分解成
;例：(EF:String->list "a,b,c" ",") →("a" "b" "c")
(defun EF:String->list (sSource sDelimiter / lenSource lenDelimiter iPos lstResult)
(if (= sDelimiter "") (progn (princ "EF:String->list 分割参数不能为空字符\"\"") (exit)))
(setq
lenSource (strlen sSource)
lenDelimiter (strlen sDelimiter)
)
(while (setq iPos (vl-string-search sDelimiter sSource))
(setq
lstResult (cons (substr sSource 1 iPos) lstResult)
sSource (substr sSource (+ 1 iPos lenDelimiter))
)
)
(reverse (cons sSource lstResult))
) ;_ end EF:String->list
;根据 lstSub 子表中的首元素 替换 lstSource 中对应表元
(defun EF:List-SubstAssoc (lstSub ;需要替换的列表
lstSource ;源列表
bAdd ;是否向源列表中追加 原本没有的元素
/
e1
)
(foreach e lstSub
(if (setq e1 (assoc (car e) lstSource))
(setq lstSource (subst e (assoc (car e) lstSource) lstSource))
(if bAdd (setq lstSource (append lstSource (list e))))
)
)
lstSource
)
;删除选择集
(defun EF:PickSet-Erase (ss/ e )
(while (> (sslength ss) 0)
(setq e (ssname ss 0))
(setq ss (ssdel e ss))
(entdel e)
)
)
;选择集并集
(defun EF:PickSet-Join (ss1 ;第一选择集
ss2 ;第二选择集
/ i n ename)
(setq i -1)
(setq n (sslength ss1))
(while (< (setq i (1+ i)) n)
(setq ss2 (ssadd (ssname ss1 i) ss2))
)
ss2
)
;选择集→元素列表
(defun EF:PickSet-toList ( ss/ i eList)
(setq i 0)
(if (equal (type ss) 'PICKSET)
(while (< i (sslength ss))
(setq eList (cons (ssname ss i) eList))
(setq i (1+ i))
)
)
eList
)
;元素列表→选择集
(defun EF:PickSet-fromList ( eList / ss )
(setq ss (ssadd))
(while eList
(if (equal (type (car eList)) 'ENAME)
(setq ss (ssadd (car eList) ss))
)
(setq eList (cdr elist))
)
ss
)
(defun *error*(msg)
(if right_change
(setvar "SHORTCUTMENU" old_SHORTCUTMENU)
)
)
(princ "\n请点选要修改的字符:(左键+1右键-1)")
(setq right_change nil)
(if (/=(getvar "SHORTCUTMENU") 11)
(progn
(setq old_SHORTCUTMENU (getvar "SHORTCUTMENU"))
(setvar "SHORTCUTMENU" 11)
(setq right_change T);;标记右键变量有更改过
)
)
(while
(cond
((and (setq pt (grread t 4 2)) ;获取grread值
(equal (car pt) 5);;移动鼠标
)
(progn
(setq ptt (cadr pt))
(setq ent_temp (nentselp ptt))
(setq en (car ent_temp))
(if (or
(and (=(length ent_temp)2)(= (cdr(assoc 0 (entget en))) "ATTRIB"))
(and (=(length ent_temp)2)(= (cdr(assoc 0 (entget en))) "TEXT"))
)
(setq enable_change T)
(setq enable_change nil)
)
t
)
)
((and (equal (car pt) 3) en);_Mouse Left button如果=3为左键;;;上次选择的en
(if enable_change
(progn
(setq ss (ssadd en))
(wzcf ss)
(redraw en 2);;redraw模式2隐藏图元
(setq lst1(EF:PickSet-toList ss2))
(setq newe(car(nentselp ptt)))
(if
(and (setq ent (entget newe)) ;获取图元
(setq str (cdr (assoc 1 ent))) ;读取数值
(cond
((< 47 (setq strascii (ascii str)) 58)
(if (> (1+ strascii) 57)
(setq string (chr 48))
(setq string (chr (1+ strascii)))
)
)
((< 64 strascii 91)
(if (> (1+ strascii) 90)
(setq string (chr 65))
(setq string (chr (1+ strascii)))
)
)
((< 96 strascii 123)
(if (> (1+ strascii) 122)
(setq string (chr 97))
(setq string (chr (1+ strascii)))
)
)
((= str "零")(setq string "首"))
((= str "首")(setq string "一"))
((= str "一")(setq string "二"))
((= str "二")(setq string "三"))
((= str "三")(setq string "四"))
((= str "四")(setq string "五"))
((= str "五")(setq string "六"))
((= str "六")(setq string "七"))
((= str "七")(setq string "八"))
((= str "八")(setq string "九"))
((= str "九")(setq string "十"))
((= str "十")(setq string "零"))
((= str "左")(setq string "右"))
((= str "右")(setq string "左"))
((= str "上")(setq string "下"))
((= str "下")(setq string "上"))
((= str "东")(setq string "南"))
((= str "南")(setq string "西"))
((= str "西")(setq string "北"))
((= str "北")(setq string "东"))
((= str "男")(setq string "女"))
((= str "女")(setq string "男"))
((= str "前")(setq string "后"))
((= str "后")(setq string "前"))
((= str "内")(setq string "外"))
((= str "外")(setq string "内"))
((= str "大")(setq string "小"))
((= str "小")(setq string "大"))
((= str "梁")(setq string "板"))
((= str "板")(setq string "梁"))
((= str "水")(setq string "电"))
((= str "电")(setq string "水"))
((= str "强")(setq string "弱"))
((= str "弱")(setq string "强"))
((= str "平")(setq string "立"))
((= str "立")(setq string "平"))
((= str "明")(setq string "暗"))
((= str "暗")(setq string "明"))
((= str "甲")(setq string "乙"))
((= str "乙")(setq string "丙"))
((= str "丙")(setq string "丁"))
((= str "丁")(setq string "戊"))
((= str "门")(setq string "窗"))
((= str "窗")(setq string "门"))
((= str "开")(setq string "关"))
((= str "关")(setq string "开"))
((= str "给")(setq string "排"))
((= str "排")(setq string "给"))
((= str "正")(setq string "反"))
((= str "反")(setq string "正"))
((= str "主")(setq string "次"))
((= str "次")(setq string "主"))
((= str "雨")(setq string "污"))
((= str "污")(setq string "雨"))
((= str "长")(setq string "短"))
((= str "短")(setq string "长"))
((= str "高")(setq string "中"))
((= str "中")(setq string "低"))
((= str "低")(setq string "高"))
((= str "轻")(setq string "重"))
((= str "重")(setq string "轻"))
((= str "硬")(setq string "软"))
((= str "软")(setq string "硬"))
((= str "壹")(setq string "贰"))
((= str "贰")(setq string "叁"))
((= str "叁")(setq string "肆"))
((= str "肆")(setq string "伍"))
((= str "伍")(setq string "陆"))
((= str "陆")(setq string "柒"))
((= str "柒")(setq string "捌"))
((= str "捌")(setq string "玖"))
((= str "玖")(setq string "拾"))
((= str "拾")(setq string "佰"))
((= str "佰")(setq string "仟"))
((= str "仟")(setq string "萬"))
((= str "萬")(setq string "億"))
((= str "億")(setq string "壹"))
(t (princ "\n非数值或字母!")nil)
)
)
(progn
(setq ent (subst (cons 1 string) (assoc 1 ent) ent))
(entmod ent) ;更新实体数据库
)
)
(setq ss3(EF:PickSet-fromList lst1))
(setq lst(wzhb ss2))
(entdel (car lst))
(setq ss nil ss2 nil ss3 nil)
(setq elist(entget en))
(entmod (subst (cons 1 (cadr lst)) (assoc 1 elist) elist))
(entupd en)
(redraw en 1);;redraw模式2隐藏图元
)
(princ "\n错误提示--请选择 单行文字 或 属性块文字<<<<")
)
T;;继续循环
)
((and (or (equal (car pt) 11) (equal (car pt) 25)) en);_Mouse Right button如果=11为右键
(if enable_change
(progn
(setq ss (ssadd en))
(wzcf ss)
(redraw en 2);;redraw模式2隐藏图元
(setq lst1(EF:PickSet-toList ss2))
(setq newe(car(nentselp ptt)))
(if
(and (setq ent (entget newe)) ;获取图元
(setq str (cdr (assoc 1 ent))) ;读取数值
(cond
((< 47 (setq strascii (ascii str)) 58)
(if (< (1- strascii) 48)
(setq string (chr 57))
(setq string (chr (1- strascii)))
)
)
((< 64 strascii 91)
(if (< (1- strascii) 65)
(setq string (chr 90))
(setq string (chr (1- strascii)))
)
)
((< 96 strascii 123)
(if (< (1- strascii) 97)
(setq string (chr 122))
(setq string (chr (1- strascii)))
)
)
((= str "零")(setq string "十"))
((= str "首")(setq string "零"))
((= str "一")(setq string "首"))
((= str "二")(setq string "一"))
((= str "三")(setq string "二"))
((= str "四")(setq string "三"))
((= str "五")(setq string "四"))
((= str "六")(setq string "五"))
((= str "七")(setq string "六"))
((= str "八")(setq string "七"))
((= str "九")(setq string "八"))
((= str "十")(setq string "九"))
((= str "左")(setq string "右"))
((= str "右")(setq string "左"))
((= str "上")(setq string "下"))
((= str "下")(setq string "上"))
((= str "东")(setq string "北"))
((= str "南")(setq string "东"))
((= str "西")(setq string "南"))
((= str "北")(setq string "西"))
((= str "女")(setq string "男"))
((= str "男")(setq string "女"))
((= str "后")(setq string "前"))
((= str "前")(setq string "后"))
((= str "外")(setq string "内"))
((= str "内")(setq string "外"))
((= str "小")(setq string "大"))
((= str "大")(setq string "小"))
((= str "板")(setq string "梁"))
((= str "梁")(setq string "板"))
((= str "电")(setq string "水"))
((= str "水")(setq string "电"))
((= str "弱")(setq string "强"))
((= str "强")(setq string "弱"))
((= str "立")(setq string "平"))
((= str "平")(setq string "立"))
((= str "暗")(setq string "明"))
((= str "明")(setq string "暗"))
((= str "乙")(setq string "甲"))
((= str "丙")(setq string "乙"))
((= str "丁")(setq string "丙"))
((= str "戊")(setq string "丁"))
((= str "窗")(setq string "门"))
((= str "门")(setq string "窗"))
((= str "关")(setq string "开"))
((= str "开")(setq string "关"))
((= str "排")(setq string "给"))
((= str "给")(setq string "排"))
((= str "反")(setq string "正"))
((= str "正")(setq string "反"))
((= str "次")(setq string "主"))
((= str "主")(setq string "次"))
((= str "污")(setq string "雨"))
((= str "雨")(setq string "污"))
((= str "短")(setq string "长"))
((= str "长")(setq string "短"))
((= str "低")(setq string "中"))
((= str "中")(setq string "高"))
((= str "高")(setq string "低"))
((= str "重")(setq string "轻"))
((= str "轻")(setq string "重"))
((= str "软")(setq string "硬"))
((= str "硬")(setq string "软"))
((= str "贰")(setq string "壹"))
((= str "叁")(setq string "贰"))
((= str "肆")(setq string "叁"))
((= str "伍")(setq string "肆"))
((= str "陆")(setq string "伍"))
((= str "柒")(setq string "陆"))
((= str "捌")(setq string "柒"))
((= str "玖")(setq string "捌"))
((= str "拾")(setq string "玖"))
((= str "佰")(setq string "拾"))
((= str "仟")(setq string "佰"))
((= str "萬")(setq string "仟"))
((= str "億")(setq string "萬"))
((= str "壹")(setq string "億"))
(t (princ "\n非数值或字母!")nil)
)
)
(progn
(setq ent (subst (cons 1 string) (assoc 1 ent) ent))
(entmod ent) ;更新实体数据库
)
)
(setq ss3(EF:PickSet-fromList lst1))
(setq lst(wzhb ss2))
(entdel (car lst))
(setq ss nil ss2 nil ss3 nil)
(setq elist(entget en))
(entmod (subst (cons 1 (cadr lst)) (assoc 1 elist) elist))
(entupd en)
(redraw en 1);;redraw模式2隐藏图元
)
(princ "\n错误提示--请选择 单行文字 或 属性块文字<<<<")
)
T;;继续循环
)
)
)
(setq ss nil ss2 nil ss3 nil)
(if right_change
(setvar "SHORTCUTMENU" old_SHORTCUTMENU)
)
(princ)
)
运行两次后，用ESC退出，出错，CAD要重启，有什么办法解决？
请点选要修改的字符:(左键+1右键-1)应用程序错误: 控制台中断
; 错误: *error* 函数中出错函数被取消
致命错误: 无 LISP 环境，正在退出。
; 错误: 出现异常: 0xE0000002
; 警告: 忽略展开 异常
; 错误: 出现异常: 0xE0000002 在块编辑中提示：有无办法解决？
请点选要修改的字符:(左键+1右键-1)** 参照编辑期间不允许使用 GROUP 命令 **
未知命令“C”。按 F1 查看帮助。
未知命令“*”。按 F1 查看帮助。
未知命令“文字炸开”。按 F1 查看帮助。
<选择集: 1475> 学习学习 感觉有用666666 很强大的功能，谢谢 欢迎发源码。 顶一个。。。。。 感觉还是很不错的。 期待分享..... 汉字还能增加？怎么做的的 10+