明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
楼主: 1028695446

【递增】【完善】JJJ(汉字序号、字母左加右减)

    [复制链接]
发表于 2021-11-24 10:32:38 | 显示全部楼层
很好,很强大,期待能刷天正的房间名称
发表于 2022-3-1 16:10:39 | 显示全部楼层
太厉害了,竟然支持块内文字修改!!!
发表于 2022-5-8 20:32:12 | 显示全部楼层
很强大的功能,谢谢
发表于 2022-7-27 16:59:28 | 显示全部楼层
无法实现多体字的左加右减!!

本帖子中包含更多资源

您需要 登录 才可以下载或查看,没有账号?注册

x
发表于 2022-7-27 17:13:01 | 显示全部楼层
看到有回复,以为又更新了   哈哈
发表于 2022-11-27 09:54:29 | 显示全部楼层
楼主辛苦,改完应该没有测试吧,2020.6.4最后上传这版有问题,递增汉字会变成问号,数字没有问题;之前的过程版本反而没有问题,可以正常使用;其次如果再支持多行文字就完美了
发表于 2023-3-26 00:23:41 | 显示全部楼层
本帖最后由 KO你 于 2023-3-26 00:36 编辑

再加上货币大写就齐了
零 壹 贰 叁 肆 伍 陆 柒 捌 玖 拾 佰 仟 萬 億
多行文字还没支持(期待完善)
发表于 2023-5-20 13:48:39 | 显示全部楼层
  1. (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)
  2.   ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  3.   (defun *error* (msg)
  4.     (and id (unload_dialog id))
  5.     (and exprt (setvar 'expert exprt))
  6.     (and file (vl-file-delete file))
  7.     (if (not (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*"))
  8.       (princ (strcat "\程序函数被取消: " msg))
  9.     )
  10.     (princ)
  11.   )
  12.         (defun wzhb(ss /  i ename dl ell x text e1 e2)
  13.                 ;(setq ss ss2)
  14.     (setq
  15.                         i  0
  16.                         dl nil
  17.                         minx nil
  18.                 );setq
  19.                 (if ss (progn(sssetfirst nil ss)))
  20.                 (if (setq ss(ssget "P" '((0 . "TEXT"))))
  21.                         (progn
  22.                                 (if (/= (sslength ss) 1)
  23.                                         (progn
  24.                                                 (repeat (sslength ss)
  25.                                                         (setq ename (ssname ss i)
  26.                                                                 ell    (entget ename)
  27.                                                                 x      (cadr (assoc 10 ell))
  28.                                                                 text   (cdr (assoc 1 ell))
  29.                                                                 i      (1+ i)
  30.                                                         );setq
  31.                                                         (setq dl (append dl (list (list x text ename))))
  32.                                                 );repeat
  33.                                                 (setq dl    (vl-sort dl (function (lambda (e1 e2) (< (car e1) (car e2)))))
  34.                                                         i     1
  35.                                                         text  (cadr (nth 0 dl))
  36.                                                         ename (caddr (nth 0 dl))
  37.                                                         ell   (entget ename)
  38.                                                 );setq
  39.                                                 (repeat (- (length dl) 1)
  40.                                                         (setq text (strcat text (cadr (nth i dl))))
  41.                                                         (entdel (caddr (nth i dl)))
  42.                                                         (setq i (1+ i))
  43.                                                 );repeat
  44.                                                 (setq ell (subst (cons 1 text) (assoc 1 ell) ell))
  45.                                                 (entmod ell)
  46.                                                 (entupd ename)
  47.                                         );progn
  48.                                         (progn
  49.                                                 (setq ename(ssname ss 0))
  50.                                                 (setq text (cdr(assoc 1 (entget ename))))
  51.                                         )
  52.                                 )
  53.                         )
  54.                 );if
  55.                 ;(princ)
  56.                 (list ename text)
  57.         )
  58.         ;=====================================================
  59.         ;=================    文字打断     ===================
  60.         ;=====================================================
  61.         ;打断所有文字
  62.         (defun wzcf (ss /  i n )
  63.                 (if ss
  64.                         (progn
  65.                                 (setvar "CMDECHO" 0)
  66.                                 (if (= 0 (boole 1 8 (getvar 'undoctl))) (command "_.undo" "_group"))
  67.                                 (setq i -1
  68.                                         n (sslength ss)
  69.                                 )
  70.                                 (while (< (setq i (1+ i)) n)
  71.                                         (if (and (setq ss2 (EF_Text:BreakAll (ssname ss i)) )
  72.                                                                 (>= (sslength ss2) 1)
  73.                                                         )                                               
  74.                                                 (EF:PickSet-Group ss2 "文字炸开")
  75.                                         )
  76.                                 )
  77.                                 (if (= 8 (boole 1 8 (getvar 'undoctl))) (command "_.undo" "_end"))
  78.       )
  79.     )
  80.   )
  81.         ;将ss成组
  82.         (defun EF:PickSet-Group (ss sName / )
  83.                 (command "Group" "C" "*" sName ss "")
  84.   )
  85.         ;文字打断所有
  86.         (defun EF_Text:BreakAll (eText        ;待炸开的文字
  87.                                                                                                                 /
  88.                                                                                                                 ss
  89.                                                                                                                 edata
  90.                                                                                                                 str_Text
  91.                                                                                                                 str_lst_Text
  92.                                                                                                                 ang_Text
  93.                                                                                                                 pt
  94.                                                                                                         )
  95.                 (setq ss (ssadd))
  96.                 (setq edata (entget eText))
  97.                 (setq str_Text (cdr (assoc 1 edata)))
  98.                 (setq str_lst_Text (EF_Text:StringExplode str_Text)
  99.                 ) ;将字符串拆解成单字列表
  100.                 (if (or (= (assoc 72 edata) 3)        ;对齐方式对齐
  101.                                         (= (assoc 72 edata) 5)        ;对齐方式拟合
  102.                                 )
  103.                         (setq ang_Text (angle (cdr (assoc 10 edata)) (cdr (assoc 11 edata))))
  104.                         (setq ang_Text (cdr (assoc 50 edata)))
  105.     )
  106.                 (setq pt (cdr (assoc 10 edata)))
  107.                 (setq edata (list '(0 . "TEXT")
  108.                                                                         (assoc 8 edata)        ;图层
  109.                                                                         (assoc 40 edata)        ;高度
  110.                                                                         (assoc 41 edata)        ;宽度
  111.                                                                         (assoc 7 edata)        ;样式
  112.                                                                         (assoc 71 edata)        ;文字镜像
  113.                                                                         (cons 50 ang_Text)        ;转角
  114.                                                                         (assoc 51 edata)        ;倾角
  115.                                                                 )
  116.                 )
  117.                 (while str_lst_Text
  118.                         (setq str_Current (car str_lst_Text))
  119.                         (setq f_Width (EF_Text:getTextWidth str_Current edata))
  120.                         ;(EF-Text-PointWrite str_Current pt edata) ;按实际插入点填写文字
  121.                         ;;;    (if (and (/= str_Current " ") (/= str_Current " "))
  122.                         ;;;      (progn
  123.                         (entmake (EF:List-SubstAssoc (list (cons 1 str_Current) (cons 10 pt)) edata T))
  124.                         (setq ss (ssadd (entlast) ss))
  125.                         ;;;        )
  126.                         ;;;      )
  127.                         (if (= (boole 1 (cdr (assoc 71 edata)) 2) 2)
  128.                                 (setq pt (polar pt ang_Text (- 0 f_Width)))
  129.                                 (setq pt (polar pt ang_Text f_Width))
  130.       )
  131.                         (setq str_lst_Text (cdr str_lst_Text))
  132.     )
  133.                 ;(entdel eText);;;;修改
  134.                 ss
  135.   )
  136.         ;=============================================================;
  137.         ;拆分字符串                                                   ;
  138.         ;EF_Text:StringExplode                                        ;
  139.         ;=============================================================;
  140.         ;取得 空格 宽度
  141.         (defun EF_Text:getTextWidth (str        ;需要检测的字符串,如果为nil则取 edata
  142.                                                                                                                                 edata        ;需要检测的文字样式图元表
  143.                                                                                                                                 /
  144.                                                                                                                                 box1 bo2
  145.                                                                                                                         )
  146.                 (if (not str) (setq str (cdr (assoc 1 edata))))
  147.                 (setq box1 (textbox (EF:List-SubstAssoc (list (cons 1 (strcat "m" str "m"))) edata T)))
  148.                 (setq box2 (textbox (EF:List-SubstAssoc (list (cons 1 "mm")) edata T)))
  149.                 (- (- (caadr box1) (caar box1))
  150.                         (- (caadr box2) (caar box2))
  151.                 )
  152.   )
  153.         ;获取打断排除列表(单字符)
  154.         (defun EF_Text:getBreakDefined ( / )
  155.                 (EF:String->List "%%130||%%131||%%132||%%133||%%134||%%135||%%136||%%p||%%P||%%c||%%C" "||")
  156.   )
  157.         ;获取打断排除列表(成对字符)
  158.         (defun EF_Text:getBreakDefined2 ( / )
  159.                 (mapcar '(lambda (e)
  160.                                                          (EF:String->List e "*")
  161.                                                  )
  162.                         (EF:String->List "%%140*%%141||%%142*%%143||%%200*%%201||%%202*%%203||%%204*%%205" "||")
  163.           )
  164.   )
  165.         ;字符串拆分
  166.         (defun EF_Text:StringExplode (str_Given                ;需要转换的字符串
  167.                                                                                                                                  /
  168.                                                                                                                                  strlst_Defined        ;单定义字符  例:'("%%130" "%%131" "%%132" "%%p" ...)
  169.                                                                                                                                  strlst_Defined2        ;成对定义字符 例 '((%%200 %%201) (%%202 %%203))
  170.                                                                                                                                  b_Find                ;是否找到特殊字符串
  171.                                                                                                                                  str_Defined        ;特殊字符串
  172.                                                                                                                                  i_Length                ;特殊字符串 长度
  173.                                                                                                                                  str_lst_Return        ;返回字符串列表
  174.                                                                                                                                  e
  175.                                                                                                                          )
  176.                 (setq strlst_Defined (EF_Text:getBreakDefined))
  177.                 (setq strlst_Defined2 (EF_Text:getBreakDefined2))
  178.                 ;检查字符串首是否在特殊字符串列表中
  179.                 (while (> (strlen str_Given) 0)
  180.                         (setq b_Find nil)
  181.                         ;检查 单定义字符
  182.                         (setq str_lst_Temp strlst_Defined)
  183.                         (while (and str_lst_Temp (not b_Find))
  184.                                 (setq str_Defined (car str_lst_Temp ))
  185.                                 (setq i_Length (strlen str_Defined))
  186.                                 (if (= (substr str_Given 1 i_Length) str_Defined)
  187.                                         (setq b_Find T)
  188.                                 )
  189.                                 (setq str_lst_Temp (cdr str_lst_Temp))
  190.       )
  191.                         ;检查 成对定义字符
  192.                         (setq str_lst_Temp strlst_Defined2)
  193.                         (while (and str_lst_Temp (not b_Find))
  194.                                 (setq str_Defined (caar str_lst_Temp ))
  195.                                 (setq i_Length (strlen str_Defined))
  196.                                 (if (= (substr str_Given 1 i_Length) str_Defined)
  197.                                         (progn
  198.                                                 (setq b_Find T)
  199.                                                 (setq str_Defined (car str_lst_Temp))
  200.                                         )
  201.                                 )
  202.                                 (setq str_lst_Temp (cdr str_lst_Temp))
  203.       )
  204.                         (cond (b_Find        ;特殊字符串
  205.                                                         (progn
  206.                                                                 (if (equal (type str_Defined) 'STR)
  207.                                                                         (progn
  208.                                                                                 (setq str_lst_Return (cons str_Defined str_lst_Return))
  209.                                                                                 (setq str_Given (substr str_Given (1+ i_Length)))
  210.                                                                         )
  211.                                                                         (progn
  212.                                                                                 (if (setq i (vl-string-search (cadr str_Defined) str_Given))
  213.                                                                                         (progn
  214.                                                                                                 (setq e (substr str_Given 1 (+ i (strlen (cadr str_Defined)))))
  215.                                                                                                 (setq str_lst_Return (cons e str_lst_Return))
  216.                                                                                                 (setq str_Given (substr str_Given (+ 1 i (strlen (cadr str_Defined)))))
  217.                                                                                         )
  218.                                                                                         (progn
  219.                                                                                                 (setq str_lst_Return (cons (car str_Defined) str_lst_Return))
  220.                                                                                                 (setq str_Given (substr str_Given (1+ i_Length)))
  221.                                                                                         )
  222.                                                                                 )
  223.                                                                         )
  224.                                                                 )
  225.                                                         )
  226.                                                 )
  227.                                 ((> (ascii (substr str_Given 1 1)) 128)        ;大于128为汉字
  228.                                         (if (>= (atof (getvar "acadver")) 24)
  229.                                                 (progn
  230.                                                         (setq str_lst_Return (cons (substr str_Given 1 1) str_lst_Return))
  231.                                                         (setq str_Given (substr str_Given 2))
  232.                                                 )
  233.                                                 (progn
  234.                                                         (setq str_lst_Return (cons (substr str_Given 1 2) str_lst_Return))
  235.                                                         (setq str_Given (substr str_Given 3))
  236.                                                 )                                               
  237.                                         )                                       
  238.                                 )
  239.                                 (T
  240.                                         (setq str_lst_Return (cons (substr str_Given 1 1) str_lst_Return))
  241.                                         (setq str_Given (substr str_Given 2))
  242.                                 )
  243.                         )
  244.     )
  245.                 (reverse str_lst_Return)
  246.   )
  247.         ;将字符串字符串以 给定 Key 分解成
  248.         ;例:(EF:String->list "a,b,c" ",") →("a" "b" "c")
  249.         (defun EF:String->list (sSource sDelimiter / lenSource lenDelimiter iPos lstResult)
  250.                 (if (= sDelimiter "") (progn (princ "EF:String->list 分割参数不能为空字符""") (exit)))
  251.                 (setq
  252.                         lenSource (strlen sSource)
  253.                         lenDelimiter (strlen sDelimiter)
  254.                 )
  255.                 (while (setq iPos (vl-string-search sDelimiter sSource))
  256.                         (setq
  257.                                 lstResult (cons (substr sSource 1 iPos) lstResult)
  258.                                 sSource (substr sSource (+ 1 iPos lenDelimiter))
  259.                         )
  260.                 )
  261.                 (reverse (cons sSource lstResult))
  262.         ) ;_ end EF:String->list
  263.         ;根据 lstSub 子表中的首元素 替换 lstSource 中对应表元
  264.         (defun EF:List-SubstAssoc (lstSub        ;需要替换的列表
  265.                                                                                                                         lstSource        ;源列表
  266.                                                                                                                         bAdd                ;是否向源列表中追加 原本没有的元素
  267.                                                                                                                         /
  268.                                                                                                                         e1
  269.                                                                                                                 )
  270.                 (foreach e lstSub
  271.                         (if (setq e1 (assoc (car e) lstSource))
  272.                                 (setq lstSource (subst e (assoc (car e) lstSource) lstSource))
  273.                                 (if bAdd (setq lstSource (append lstSource (list e))))
  274.       )
  275.     )
  276.                 lstSource
  277.   )
  278.         ;删除选择集
  279.         (defun EF:PickSet-Erase (ss  / e )
  280.                 (while (> (sslength ss) 0)
  281.                         (setq e (ssname ss 0))
  282.                         (setq ss (ssdel e ss))
  283.                         (entdel e)
  284.     )
  285.   )
  286.         ;选择集并集
  287.         (defun EF:PickSet-Join (ss1        ;第一选择集
  288.                                                                                                          ss2        ;第二选择集
  289.                                                                                                          / i n ename)
  290.                 (setq i -1)
  291.                 (setq n (sslength ss1))
  292.                 (while (< (setq i (1+ i)) n)
  293.                         (setq ss2 (ssadd (ssname ss1 i) ss2))
  294.     )
  295.                 ss2
  296.   )
  297.         ;选择集→元素列表
  298.         (defun EF:PickSet-toList ( ss  / i eList)
  299.                 (setq i 0)
  300.                 (if (equal (type ss) 'PICKSET)
  301.                         (while (< i (sslength ss))
  302.                                 (setq eList (cons (ssname ss i) eList))
  303.                                 (setq i (1+ i))
  304.       )
  305.     )
  306.                 eList
  307.   )
  308.         ;元素列表→选择集
  309.         (defun EF:PickSet-fromList ( eList / ss )
  310.                 (setq ss (ssadd))
  311.                 (while eList
  312.                         (if (equal (type (car eList)) 'ENAME)
  313.                                 (setq ss (ssadd (car eList) ss))
  314.       )
  315.                         (setq eList (cdr elist))
  316.     )
  317.                 ss
  318.   )
  319.         (defun *error*(msg)
  320.                 (if right_change
  321.                         (setvar "SHORTCUTMENU" old_SHORTCUTMENU)
  322.                 )
  323.         )
  324.   (princ "\n请点选要修改的字符:(左键+1右键-1)")
  325.         (setq right_change nil)
  326.         (if (/=(getvar "SHORTCUTMENU") 11)
  327.                 (progn
  328.                         (setq old_SHORTCUTMENU (getvar "SHORTCUTMENU"))
  329.                         (setvar "SHORTCUTMENU" 11)
  330.                         (setq right_change T);;标记右键变量有更改过
  331.                 )
  332.         )
  333.   (while
  334.     (cond
  335.                         ((and        (setq pt (grread t 4 2)) ;获取grread值
  336.                                  (equal (car pt) 5);;移动鼠标
  337.                          )
  338.                                 (progn
  339.                                         (setq ptt (cadr pt))
  340.                                         (setq ent_temp (nentselp ptt))
  341.                                         (setq en (car ent_temp))
  342.                                         (if (or
  343.                                                                 (and (=(length ent_temp)2)(= (cdr(assoc 0 (entget en))) "ATTRIB"))
  344.                                                                 (and (=(length ent_temp)2)(= (cdr(assoc 0 (entget en))) "TEXT"))
  345.                                                         )
  346.                                                 (setq enable_change T)
  347.                                                 (setq enable_change nil)
  348.                                         )       
  349.                                         t
  350.                                 )
  351.                         )
  352.                         ((and (equal (car pt) 3) en);_Mouse Left button  如果=3为左键;;;上次选择的en
  353.                                 (if enable_change
  354.                                         (progn                                       
  355.                                                 (setq ss (ssadd en))
  356.                                                 (wzcf ss)
  357.                                                 (redraw en 2);;redraw模式2隐藏图元
  358.                                                 (setq lst1(EF:PickSet-toList ss2))
  359.                                                 (setq newe(car(nentselp ptt)))
  360.                                                 (if
  361.                                                         (and (setq ent (entget newe)) ;获取图元
  362.                                                                 (setq str (cdr (assoc 1 ent))) ;读取数值
  363.                                                                 (cond
  364.                                                                         ((< 47 (setq strascii (ascii str)) 58)
  365.                                                                                 (if (> (1+ strascii) 57)
  366.                                                                                         (setq string (chr 48))
  367.                                                                                         (setq string (chr (1+ strascii)))
  368.                                                                                 )
  369.                                                                         )
  370.                                                                         ((< 64 strascii 91)
  371.                                                                                 (if (> (1+ strascii) 90)
  372.                                                                                         (setq string (chr 65))
  373.                                                                                         (setq string (chr (1+ strascii)))
  374.                                                                                 )
  375.                                                                         )
  376.                                                                         ((< 96 strascii 123)
  377.                                                                                 (if (> (1+ strascii) 122)
  378.                                                                                         (setq string (chr 97))
  379.                                                                                         (setq string (chr (1+ strascii)))
  380.                                                                                 )
  381.                                                                         )
  382.                                                                         ((= str "零")(setq string "首"))
  383.                                                                         ((= str "首")(setq string "一"))
  384.                                                                         ((= str "一")(setq string "二"))
  385.                                                                         ((= str "二")(setq string "三"))
  386.                                                                         ((= str "三")(setq string "四"))
  387.                                                                         ((= str "四")(setq string "五"))
  388.                                                                         ((= str "五")(setq string "六"))
  389.                                                                         ((= str "六")(setq string "七"))
  390.                                                                         ((= str "七")(setq string "八"))
  391.                                                                         ((= str "八")(setq string "九"))
  392.                                                                         ((= str "九")(setq string "十"))
  393.                                                                         ((= str "十")(setq string "零"))
  394.                                                                         ((= str "左")(setq string "右"))
  395.                                                                         ((= str "右")(setq string "左"))
  396.                                                                         ((= str "上")(setq string "下"))
  397.                                                                         ((= str "下")(setq string "上"))
  398.                                                                         ((= str "东")(setq string "南"))
  399.                                                                         ((= str "南")(setq string "西"))
  400.                                                                         ((= str "西")(setq string "北"))
  401.                                                                         ((= str "北")(setq string "东"))
  402.                                                                         ((= str "男")(setq string "女"))
  403.                                                                         ((= str "女")(setq string "男"))
  404.                                                                         ((= str "前")(setq string "后"))
  405.                                                                         ((= str "后")(setq string "前"))
  406.                                                                         ((= str "内")(setq string "外"))
  407.                                                                         ((= str "外")(setq string "内"))
  408.                                                                         ((= str "大")(setq string "小"))
  409.                                                                         ((= str "小")(setq string "大"))
  410.                                                                         ((= str "梁")(setq string "板"))
  411.                                                                         ((= str "板")(setq string "梁"))
  412.                                                                         ((= str "水")(setq string "电"))
  413.                                                                         ((= str "电")(setq string "水"))
  414.                                                                         ((= str "强")(setq string "弱"))
  415.                                                                         ((= str "弱")(setq string "强"))
  416.                                                                         ((= str "平")(setq string "立"))
  417.                                                                         ((= str "立")(setq string "平"))
  418.                                                                         ((= str "明")(setq string "暗"))
  419.                                                                         ((= str "暗")(setq string "明"))
  420.                                                                         ((= str "甲")(setq string "乙"))
  421.                                                                         ((= str "乙")(setq string "丙"))
  422.                                                                         ((= str "丙")(setq string "丁"))
  423.                                                                         ((= str "丁")(setq string "戊"))
  424.                                                                         ((= str "门")(setq string "窗"))
  425.                                                                         ((= str "窗")(setq string "门"))
  426.                                                                         ((= str "开")(setq string "关"))
  427.                                                                         ((= str "关")(setq string "开"))
  428.                                                                         ((= str "给")(setq string "排"))
  429.                                                                         ((= str "排")(setq string "给"))
  430.                                                                         ((= str "正")(setq string "反"))
  431.                                                                         ((= str "反")(setq string "正"))
  432.                                                                         ((= str "主")(setq string "次"))
  433.                                                                         ((= str "次")(setq string "主"))
  434.                                                                         ((= str "雨")(setq string "污"))
  435.                                                                         ((= str "污")(setq string "雨"))
  436.                                                                         ((= str "长")(setq string "短"))
  437.                                                                         ((= str "短")(setq string "长"))
  438.                                                                         ((= str "高")(setq string "中"))
  439.                                                                         ((= str "中")(setq string "低"))
  440.                                                                         ((= str "低")(setq string "高"))
  441.                                                                         ((= str "轻")(setq string "重"))
  442.                                                                         ((= str "重")(setq string "轻"))                                                                       
  443.                                                                         ((= str "硬")(setq string "软"))
  444.                                                                         ((= str "软")(setq string "硬"))
  445.                                                                         ((= str "壹")(setq string "贰"))
  446.                                                                         ((= str "贰")(setq string "叁"))
  447.                                                                         ((= str "叁")(setq string "肆"))
  448.                                                                         ((= str "肆")(setq string "伍"))
  449.                                                                         ((= str "伍")(setq string "陆"))
  450.                                                                         ((= str "陆")(setq string "柒"))
  451.                                                                         ((= str "柒")(setq string "捌"))
  452.                                                                         ((= str "捌")(setq string "玖"))
  453.                                                                         ((= str "玖")(setq string "拾"))
  454.                                                                         ((= str "拾")(setq string "佰"))
  455.                                                                         ((= str "佰")(setq string "仟"))
  456.                                                                         ((= str "仟")(setq string "萬"))
  457.                                                                         ((= str "萬")(setq string "億"))
  458.                                                                         ((= str "億")(setq string "壹"))
  459.                                                                         (t (princ "\n非数值或字母!")nil)
  460.                                                                 )
  461.                                                         )
  462.                                                         (progn
  463.                                                                 (setq ent (subst (cons 1 string) (assoc 1 ent) ent))
  464.                                                                 (entmod ent)                ;更新实体数据库
  465.                                                         )
  466.                                                 )
  467.                                                 (setq ss3(EF:PickSet-fromList lst1))
  468.                                                 (setq lst(wzhb ss2))
  469.                                                 (entdel (car lst))
  470.                                                 (setq ss nil ss2 nil ss3 nil)                                               
  471.                                                 (setq elist(entget en))
  472.                                                 (entmod (subst (cons 1 (cadr lst)) (assoc 1 elist) elist))
  473.                                                 (entupd en)
  474.                                                 (redraw en 1);;redraw模式2隐藏图元                                               
  475.                                         )                                       
  476.                                         (princ "\n错误提示--请选择 单行文字 或 属性块文字<<<<")
  477.                                 )                               
  478.                                 T;;继续循环                               
  479.                         )
  480.                         ((and (or (equal (car pt) 11) (equal (car pt) 25)) en);_Mouse Right button  如果=11为右键               
  481.                                 (if enable_change
  482.                                         (progn                       
  483.                                                 (setq ss (ssadd en))
  484.                                                 (wzcf ss)
  485.                                                 (redraw en 2);;redraw模式2隐藏图元
  486.                                                 (setq lst1(EF:PickSet-toList ss2))
  487.                                                 (setq newe(car(nentselp ptt)))
  488.                                                 (if
  489.                                                         (and (setq ent (entget newe)) ;获取图元
  490.                                                                 (setq str (cdr (assoc 1 ent))) ;读取数值
  491.                                                                 (cond
  492.                                                                         ((< 47 (setq strascii (ascii str)) 58)
  493.                                                                                 (if (< (1- strascii) 48)
  494.                                                                                         (setq string (chr 57))
  495.                                                                                         (setq string (chr (1- strascii)))
  496.                                                                                 )
  497.                                                                         )
  498.                                                                         ((< 64 strascii 91)
  499.                                                                                 (if (< (1- strascii) 65)
  500.                                                                                         (setq string (chr 90))
  501.                                                                                         (setq string (chr (1- strascii)))
  502.                                                                                 )
  503.                                                                         )
  504.                                                                         ((< 96 strascii 123)
  505.                                                                                 (if (< (1- strascii) 97)
  506.                                                                                         (setq string (chr 122))
  507.                                                                                         (setq string (chr (1- strascii)))
  508.                                                                                 )
  509.                                                                         )
  510.                                                                         ((= str "零")(setq string "十"))
  511.                                                                         ((= str "首")(setq string "零"))
  512.                                                                         ((= str "一")(setq string "首"))
  513.                                                                         ((= str "二")(setq string "一"))
  514.                                                                         ((= str "三")(setq string "二"))
  515.                                                                         ((= str "四")(setq string "三"))
  516.                                                                         ((= str "五")(setq string "四"))
  517.                                                                         ((= str "六")(setq string "五"))
  518.                                                                         ((= str "七")(setq string "六"))
  519.                                                                         ((= str "八")(setq string "七"))
  520.                                                                         ((= str "九")(setq string "八"))
  521.                                                                         ((= str "十")(setq string "九"))
  522.                                                                         ((= str "左")(setq string "右"))
  523.                                                                         ((= str "右")(setq string "左"))
  524.                                                                         ((= str "上")(setq string "下"))
  525.                                                                         ((= str "下")(setq string "上"))
  526.                                                                         ((= str "东")(setq string "北"))
  527.                                                                         ((= str "南")(setq string "东"))
  528.                                                                         ((= str "西")(setq string "南"))
  529.                                                                         ((= str "北")(setq string "西"))
  530.                                                                         ((= str "女")(setq string "男"))
  531.                                                                         ((= str "男")(setq string "女"))
  532.                                                                         ((= str "后")(setq string "前"))
  533.                                                                         ((= str "前")(setq string "后"))
  534.                                                                         ((= str "外")(setq string "内"))
  535.                                                                         ((= str "内")(setq string "外"))
  536.                                                                         ((= str "小")(setq string "大"))
  537.                                                                         ((= str "大")(setq string "小"))
  538.                                                                         ((= str "板")(setq string "梁"))
  539.                                                                         ((= str "梁")(setq string "板"))
  540.                                                                         ((= str "电")(setq string "水"))
  541.                                                                         ((= str "水")(setq string "电"))
  542.                                                                         ((= str "弱")(setq string "强"))
  543.                                                                         ((= str "强")(setq string "弱"))
  544.                                                                         ((= str "立")(setq string "平"))
  545.                                                                         ((= str "平")(setq string "立"))
  546.                                                                         ((= str "暗")(setq string "明"))
  547.                                                                         ((= str "明")(setq string "暗"))
  548.                                                                         ((= str "乙")(setq string "甲"))
  549.                                                                         ((= str "丙")(setq string "乙"))
  550.                                                                         ((= str "丁")(setq string "丙"))
  551.                                                                         ((= str "戊")(setq string "丁"))
  552.                                                                         ((= str "窗")(setq string "门"))
  553.                                                                         ((= str "门")(setq string "窗"))
  554.                                                                         ((= str "关")(setq string "开"))
  555.                                                                         ((= str "开")(setq string "关"))
  556.                                                                         ((= str "排")(setq string "给"))
  557.                                                                         ((= str "给")(setq string "排"))
  558.                                                                         ((= str "反")(setq string "正"))
  559.                                                                         ((= str "正")(setq string "反"))
  560.                                                                         ((= str "次")(setq string "主"))
  561.                                                                         ((= str "主")(setq string "次"))
  562.                                                                         ((= str "污")(setq string "雨"))
  563.                                                                         ((= str "雨")(setq string "污"))
  564.                                                                         ((= str "短")(setq string "长"))
  565.                                                                         ((= str "长")(setq string "短"))
  566.                                                                         ((= str "低")(setq string "中"))
  567.                                                                         ((= str "中")(setq string "高"))
  568.                                                                         ((= str "高")(setq string "低"))
  569.                                                                         ((= str "重")(setq string "轻"))
  570.                                                                         ((= str "轻")(setq string "重"))
  571.                                                                         ((= str "软")(setq string "硬"))
  572.                                                                         ((= str "硬")(setq string "软"))
  573.                                                                         ((= str "贰")(setq string "壹"))
  574.                                                                         ((= str "叁")(setq string "贰"))
  575.                                                                         ((= str "肆")(setq string "叁"))
  576.                                                                         ((= str "伍")(setq string "肆"))
  577.                                                                         ((= str "陆")(setq string "伍"))
  578.                                                                         ((= str "柒")(setq string "陆"))
  579.                                                                         ((= str "捌")(setq string "柒"))
  580.                                                                         ((= str "玖")(setq string "捌"))
  581.                                                                         ((= str "拾")(setq string "玖"))
  582.                                                                         ((= str "佰")(setq string "拾"))
  583.                                                                         ((= str "仟")(setq string "佰"))
  584.                                                                         ((= str "萬")(setq string "仟"))
  585.                                                                         ((= str "億")(setq string "萬"))
  586.                                                                         ((= str "壹")(setq string "億"))
  587.                                                                         (t (princ "\n非数值或字母!")nil)
  588.                                                                 )
  589.                                                         )
  590.                                                         (progn
  591.                                                                 (setq ent (subst (cons 1 string) (assoc 1 ent) ent))
  592.                                                                 (entmod ent)                ;更新实体数据库
  593.                                                         )
  594.                                                 )
  595.                                                 (setq ss3(EF:PickSet-fromList lst1))
  596.                                                 (setq lst(wzhb ss2))
  597.                                                 (entdel (car lst))
  598.                                                 (setq ss nil ss2 nil ss3 nil)
  599.                                                 (setq elist(entget en))
  600.                                                 (entmod (subst (cons 1 (cadr lst)) (assoc 1 elist) elist))
  601.                                                 (entupd en)
  602.                                                 (redraw en 1);;redraw模式2隐藏图元
  603.                                         )                                       
  604.                                         (princ "\n错误提示--请选择 单行文字 或 属性块文字<<<<")
  605.                                 )                               
  606.                                 T;;继续循环                               
  607.                         )                       
  608.                 )
  609.         )
  610.         (setq ss nil ss2 nil ss3 nil)
  611.         (if right_change
  612.                 (setvar "SHORTCUTMENU" old_SHORTCUTMENU)
  613.         )
  614.         (princ)
  615. )

发表于 2023-7-7 18:28:22 | 显示全部楼层
强大的程序!!顶!
您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号 )  
©2000-2023 明经通道 版权所有 本站代码,在未取得本站及作者授权的情况下,不得用于商业用途

GMT+8, 2024-11-6 09:38 , Processed in 0.187862 second(s), 23 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

快速回复 返回顶部 返回列表