鼠标左右键加减文字修改的源码

springwillow

偶然一个机会在群里看到了烈火大哥的一段关于用鼠标左右键实现对数字进行加减的代码，但是感觉和我的使用习惯不大一样。所以进行了一下修改，来给大家看看，水平不高，第一次在坛子里发这种技术贴。

2. (defun c:plusminus ( / pt en ent str ptt)
   
3.   (while
   
4.     (cond ((and  (setq pt (grread t 4 2)) ;获取grread值
   
5.     (equal (car pt) 5)
   
6.      )
   
7.      (progn
   
8.        (setq ptt (cadr pt)
   
9.        en  (car (nentselp ptt))
   
10.        )
    
11.        t
    
12.      )
    
13.     )
    
14.     ((equal (car pt) 3) ;_Mouse Left button  如果=3为左键
    
15.      (if
    
16.        (and  (setq ent (entget en)) ;获取图元
    
17.       (setq str (cdr (assoc 1 ent))) ;读取数值
    
18.       (numberp (eval (read str)))
    
19.       (equal (atoi str) (atof str))
    
20.        )
    
21.         (progn
    
22.     (setq str (rtos (1+ (atoi str)) 2 0)) ;将数值加1
    
23.     (setq ent (subst (cons 1 str) (assoc 1 ent) ent))
    
24.     (entmod ent)    ;更新实体数据库
    
25.         )
    
26.      )
    
27.     )
    
28.     ((or (equal (car pt) 3) (equal (car pt) 25)) ;_Mouse Right button  如果=11为右键
    
29.      (if
    
30.        (and
    
31.          (setq ent (entget en))  ;获取图元
    
32.          (setq str (cdr (assoc 1 ent))) ;读取数值
    
33.          (numberp (eval (read str)))
    
34.          (equal (atoi str) (atof str))
    
35.        )
    
36.         (progn
    
37.     (setq str (rtos (1- (atoi str)) 2 0)) ;将数值减1
    
38.     (setq ent (subst (cons 1 str) (assoc 1 ent) ent))
    
39.     (entmod ent)    ;更新实体数据库
    
40.         )
    
41.      )
    
42.     )
    
43.     )
    
44. 
    
45.   )
    
46.   (princ)
    
47. )
    

(defun c:plusminus ( / pt en ent str ptt)<br />   (while<br />     (cond ((and  (setq pt (grread t 4 2)) ;获取grread值<br />     (equal (car pt) 5)<br />      )<br />      (progn<br />        (setq ptt (cadr pt)<br />        en  (car (nentselp ptt))<br />        )<br />        t<br />      )<br />     )<br />     ((equal (car pt) 3) ;_Mouse Left button  如果=3为左键<br />      (if<br />        (and  (setq ent (entget en)) ;获取图元<br />       (setq str (cdr (assoc 1 ent))) ;读取数值<br />       (numberp (eval (read str))) <br />       (equal (atoi str) (atof str)) <br />        )<br />         (progn<br />     (setq str (rtos (1+ (atoi str)) 2 0)) ;将数值加1<br />     (setq ent (subst (cons 1 str) (assoc 1 ent) ent))<br />     (entmod ent)    ;更新实体数据库<br />         )<br />      )<br />     )<br />     ((or (equal (car pt) 3) (equal (car pt) 25)) ;_Mouse Right button  如果=11为右键<br />      (if<br />        (and<br />          (setq ent (entget en))  ;获取图元<br />          (setq str (cdr (assoc 1 ent))) ;读取数值<br />          (numberp (eval (read str))) <br />          (equal (atoi str) (atof str)) <br />        )<br />         (progn<br />     (setq str (rtos (1- (atoi str)) 2 0)) ;将数值减1<br />     (setq ent (subst (cons 1 str) (assoc 1 ent) ent))<br />     (entmod ent)    ;更新实体数据库<br />         )<br />      )<br />     )<br />     )<br /> <br />   )<br />   (princ)<br /> )<br />

小毛草

这个更好用，原程序为其它网友提供！版权属于它的！

2. (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)
   
3.   ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   
4.   (defun *error* (msg)
   
5.     (and id (unload_dialog id))
   
6.     (and exprt (setvar 'expert exprt))
   
7.     (and file (vl-file-delete file))
   
8.     (if (not (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*"))
   
9.       (princ (strcat "\程序函数被取消: " msg))
   
10.     )
    
11.     (princ)
    
12.   )
    
13.   (defun wzhb(ss /  i ename dl ell x text e1 e2)
    
14.     ;(setq ss ss2)
    
15.     (setq
    
16.       i  0
    
17.       dl nil
    
18.       minx nil
    
19.     );setq
    
20.     (if ss (progn(sssetfirst nil ss)))
    
21.     (if (setq ss(ssget "P" '((0 . "TEXT"))))
    
22.       (progn
    
23.         (if (/= (sslength ss) 1)
    
24.           (progn
    
25.             (repeat (sslength ss)
    
26.               (setq ename (ssname ss i)
    
27.                 ell    (entget ename)
    
28.                 x      (cadr (assoc 10 ell))
    
29.                 text   (cdr (assoc 1 ell))
    
30.                 i      (1+ i)
    
31.               );setq
    
32.               (setq dl (append dl (list (list x text ename))))
    
33.             );repeat
    
34.             (setq dl    (vl-sort dl (function (lambda (e1 e2) (< (car e1) (car e2)))))
    
35.               i     1
    
36.               text  (cadr (nth 0 dl))
    
37.               ename (caddr (nth 0 dl))
    
38.               ell   (entget ename)
    
39.             );setq
    
40.             (repeat (- (length dl) 1)
    
41.               (setq text (strcat text (cadr (nth i dl))))
    
42.               (entdel (caddr (nth i dl)))
    
43.               (setq i (1+ i))
    
44.             );repeat
    
45.             (setq ell (subst (cons 1 text) (assoc 1 ell) ell))
    
46.             (entmod ell)
    
47.             (entupd ename)
    
48.           );progn
    
49.           (progn
    
50.             (setq ename(ssname ss 0))
    
51.             (setq text (cdr(assoc 1 (entget ename))))
    
52.           )
    
53.         )
    
54.       )
    
55.     );if
    
56.     ;(princ)
    
57.     (list ename text)
    
58.   )
    
59.   ;=====================================================
    
60.   ;=================    文字打断     ===================
    
61.   ;=====================================================
    
62.   ;打断所有文字
    
63.   (defun wzcf (ss /  i n )
    
64.     (if ss
    
65.       (progn
    
66.         (setvar "CMDECHO" 0)
    
67.         (if (= 0 (boole 1 8 (getvar 'undoctl))) (command "_.undo" "_group"))
    
68.         (setq i -1
    
69.           n (sslength ss)
    
70.         )
    
71.         (while (< (setq i (1+ i)) n)
    
72.           (if (and (setq ss2 (EF_Text:BreakAll (ssname ss i)) )
    
73.                 (>= (sslength ss2) 1)
    
74.               )            
    
75.             (EF:PickSet-Group ss2 "文字炸开")
    
76.           )
    
77.         )
    
78.         (if (= 8 (boole 1 8 (getvar 'undoctl))) (command "_.undo" "_end"))
    
79.       )
    
80.     )
    
81.   )
    
82.   ;将ss成组
    
83.   (defun EF:PickSet-Group (ss sName / )
    
84.     (command "Group" "C" "*" sName ss "")
    
85.   )
    
86.   ;文字打断所有
    
87.   (defun EF_Text:BreakAll (eText  ;待炸开的文字
    
88.                             /
    
89.                             ss
    
90.                             edata
    
91.                             str_Text
    
92.                             str_lst_Text
    
93.                             ang_Text
    
94.                             pt
    
95.                           )
    
96.     (setq ss (ssadd))
    
97.     (setq edata (entget eText))
    
98.     (setq str_Text (cdr (assoc 1 edata)))
    
99.     (setq str_lst_Text (EF_Text:StringExplode str_Text)
    
100.     ) ;将字符串拆解成单字列表
     
101.     (if (or (= (assoc 72 edata) 3)  ;对齐方式对齐
     
102.           (= (assoc 72 edata) 5)  ;对齐方式拟合
     
103.         )
     
104.       (setq ang_Text (angle (cdr (assoc 10 edata)) (cdr (assoc 11 edata))))
     
105.       (setq ang_Text (cdr (assoc 50 edata)))
     
106.     )
     
107.     (setq pt (cdr (assoc 10 edata)))
     
108.     (setq edata (list '(0 . "TEXT")
     
109.                   (assoc 8 edata)  ;图层
     
110.                   (assoc 40 edata)  ;高度
     
111.                   (assoc 41 edata)  ;宽度
     
112.                   (assoc 7 edata)  ;样式
     
113.                   (assoc 71 edata)  ;文字镜像
     
114.                   (cons 50 ang_Text)  ;转角
     
115.                   (assoc 51 edata)  ;倾角
     
116.                 )
     
117.     )
     
118.     (while str_lst_Text
     
119.       (setq str_Current (car str_lst_Text))
     
120.       (setq f_Width (EF_Text:getTextWidth str_Current edata))
     
121.       ;(EF-Text-PointWrite str_Current pt edata) ;按实际插入点填写文字
     
122.       ;;;    (if (and (/= str_Current " ") (/= str_Current "　"))
     
123.       ;;;      (progn
     
124.       (entmake (EF:List-SubstAssoc (list (cons 1 str_Current) (cons 10 pt)) edata T))
     
125.       (setq ss (ssadd (entlast) ss))
     
126.       ;;;  )
     
127.       ;;;      )
     
128.       (if (= (boole 1 (cdr (assoc 71 edata)) 2) 2)
     
129.         (setq pt (polar pt ang_Text (- 0 f_Width)))
     
130.         (setq pt (polar pt ang_Text f_Width))
     
131.       )
     
132.       (setq str_lst_Text (cdr str_lst_Text))
     
133.     )
     
134.     ;(entdel eText);;;;修改
     
135.     ss
     
136.   )
     
137.   ;=============================================================;
     
138.   ;拆分字符串                                                   ;
     
139.   ;EF_Text:StringExplode                                        ;
     
140.   ;=============================================================;
     
141.   ;取得 空格 宽度
     
142.   (defun EF_Text:getTextWidth (str  ;需要检测的字符串,如果为nil则取 edata
     
143.                                 edata  ;需要检测的文字样式图元表
     
144.                                 /
     
145.                                 box1 bo2
     
146.                               )
     
147.     (if (not str) (setq str (cdr (assoc 1 edata))))
     
148.     (setq box1 (textbox (EF:List-SubstAssoc (list (cons 1 (strcat "m" str "m"))) edata T)))
     
149.     (setq box2 (textbox (EF:List-SubstAssoc (list (cons 1 "mm")) edata T)))
     
150.     (- (- (caadr box1) (caar box1))
     
151.       (- (caadr box2) (caar box2))
     
152.     )
     
153.   )
     
154.   ;获取打断排除列表(单字符)
     
155.   (defun EF_Text:getBreakDefined ( / )
     
156.     (EF:String->List "%%130||%%131||%%132||%%133||%%134||%%135||%%136||%%p||%%P||%%c||%%C" "||")
     
157.   )
     
158.   ;获取打断排除列表(成对字符)
     
159.   (defun EF_Text:getBreakDefined2 ( / )
     
160.     (mapcar '(lambda (e)
     
161.                (EF:String->List e "*")
     
162.              )
     
163.       (EF:String->List "%%140*%%141||%%142*%%143||%%200*%%201||%%202*%%203||%%204*%%205" "||")
     
164.     )
     
165.   )
     
166.   ;字符串拆分
     
167.   (defun EF_Text:StringExplode (str_Given    ;需要转换的字符串
     
168.                                  /
     
169.                                  strlst_Defined  ;单定义字符  例：'("%%130" "%%131" "%%132" "%%p" ...)
     
170.                                  strlst_Defined2  ;成对定义字符 例 '((%%200 %%201) (%%202 %%203))
     
171.                                  b_Find    ;是否找到特殊字符串
     
172.                                  str_Defined  ;特殊字符串
     
173.                                  i_Length    ;特殊字符串 长度
     
174.                                  str_lst_Return  ;返回字符串列表
     
175.                                  e
     
176.                                )
     
177.     (setq strlst_Defined (EF_Text:getBreakDefined))
     
178.     (setq strlst_Defined2 (EF_Text:getBreakDefined2))
     
179.     ;检查字符串首是否在特殊字符串列表中
     
180.     (while (> (strlen str_Given) 0)
     
181.       (setq b_Find nil)
     
182.       ;检查 单定义字符
     
183.       (setq str_lst_Temp strlst_Defined)
     
184.       (while (and str_lst_Temp (not b_Find))
     
185.         (setq str_Defined (car str_lst_Temp ))
     
186.         (setq i_Length (strlen str_Defined))
     
187.         (if (= (substr str_Given 1 i_Length) str_Defined)
     
188.           (setq b_Find T)
     
189.         )
     
190.         (setq str_lst_Temp (cdr str_lst_Temp))
     
191.       )
     
192.       ;检查 成对定义字符
     
193.       (setq str_lst_Temp strlst_Defined2)
     
194.       (while (and str_lst_Temp (not b_Find))
     
195.         (setq str_Defined (caar str_lst_Temp ))
     
196.         (setq i_Length (strlen str_Defined))
     
197.         (if (= (substr str_Given 1 i_Length) str_Defined)
     
198.           (progn
     
199.             (setq b_Find T)
     
200.             (setq str_Defined (car str_lst_Temp))
     
201.           )
     
202.         )
     
203.         (setq str_lst_Temp (cdr str_lst_Temp))
     
204.       )
     
205.       (cond (b_Find  ;特殊字符串
     
206.               (progn
     
207.                 (if (equal (type str_Defined) 'STR)
     
208.                   (progn
     
209.                     (setq str_lst_Return (cons str_Defined str_lst_Return))
     
210.                     (setq str_Given (substr str_Given (1+ i_Length)))
     
211.                   )
     
212.                   (progn
     
213.                     (if (setq i (vl-string-search (cadr str_Defined) str_Given))
     
214.                       (progn
     
215.                         (setq e (substr str_Given 1 (+ i (strlen (cadr str_Defined)))))
     
216.                         (setq str_lst_Return (cons e str_lst_Return))
     
217.                         (setq str_Given (substr str_Given (+ 1 i (strlen (cadr str_Defined)))))
     
218.                       )
     
219.                       (progn
     
220.                         (setq str_lst_Return (cons (car str_Defined) str_lst_Return))
     
221.                         (setq str_Given (substr str_Given (1+ i_Length)))
     
222.                       )
     
223.                     )
     
224.                   )
     
225.                 )
     
226.               )
     
227.             )
     
228.         ((> (ascii (substr str_Given 1 1)) 128)  ;大于128为汉字
     
229.           (if (>= (atof (getvar "acadver")) 24)
     
230.             (progn
     
231.               (setq str_lst_Return (cons (substr str_Given 1 1) str_lst_Return))
     
232.               (setq str_Given (substr str_Given 2))
     
233.             )
     
234.             (progn
     
235.               (setq str_lst_Return (cons (substr str_Given 1 2) str_lst_Return))
     
236.               (setq str_Given (substr str_Given 3))
     
237.             )            
     
238.           )         
     
239.         )
     
240.         (T
     
241.           (setq str_lst_Return (cons (substr str_Given 1 1) str_lst_Return))
     
242.           (setq str_Given (substr str_Given 2))
     
243.         )
     
244.       )
     
245.     )
     
246.     (reverse str_lst_Return)
     
247.   )
     
248.   ;将字符串字符串以 给定 Key 分解成
     
249.   ;例：(EF:String->list "a,b,c" ",") →("a" "b" "c")
     
250.   (defun EF:String->list (sSource sDelimiter / lenSource lenDelimiter iPos lstResult)
     
251.     (if (= sDelimiter "") (progn (princ "EF:String->list 分割参数不能为空字符""") (exit)))
     
252.     (setq
     
253.       lenSource (strlen sSource)
     
254.       lenDelimiter (strlen sDelimiter)
     
255.     )
     
256.     (while (setq iPos (vl-string-search sDelimiter sSource))
     
257.       (setq
     
258.         lstResult (cons (substr sSource 1 iPos) lstResult)
     
259.         sSource (substr sSource (+ 1 iPos lenDelimiter))
     
260.       )
     
261.     )
     
262.     (reverse (cons sSource lstResult))
     
263.   ) ;_ end EF:String->list
     
264.   ;根据 lstSub 子表中的首元素 替换 lstSource 中对应表元
     
265.   (defun EF:List-SubstAssoc (lstSub  ;需要替换的列表
     
266.                               lstSource  ;源列表
     
267.                               bAdd    ;是否向源列表中追加 原本没有的元素
     
268.                               /
     
269.                               e1
     
270.                             )
     
271.     (foreach e lstSub
     
272.       (if (setq e1 (assoc (car e) lstSource))
     
273.         (setq lstSource (subst e (assoc (car e) lstSource) lstSource))
     
274.         (if bAdd (setq lstSource (append lstSource (list e))))
     
275.       )
     
276.     )
     
277.     lstSource
     
278.   )
     
279.   ;删除选择集
     
280.   (defun EF:PickSet-Erase (ss  / e )
     
281.     (while (> (sslength ss) 0)
     
282.       (setq e (ssname ss 0))
     
283.       (setq ss (ssdel e ss))
     
284.       (entdel e)
     
285.     )
     
286.   )
     
287.   ;选择集并集
     
288.   (defun EF:PickSet-Join (ss1  ;第一选择集
     
289.                            ss2  ;第二选择集
     
290.                            / i n ename)
     
291.     (setq i -1)
     
292.     (setq n (sslength ss1))
     
293.     (while (< (setq i (1+ i)) n)
     
294.       (setq ss2 (ssadd (ssname ss1 i) ss2))
     
295.     )
     
296.     ss2
     
297.   )
     
298.   ;选择集→元素列表
     
299.   (defun EF:PickSet-toList ( ss  / i eList)
     
300.     (setq i 0)
     
301.     (if (equal (type ss) 'PICKSET)
     
302.       (while (< i (sslength ss))
     
303.         (setq eList (cons (ssname ss i) eList))
     
304.         (setq i (1+ i))
     
305.       )
     
306.     )
     
307.     eList
     
308.   )
     
309.   ;元素列表→选择集
     
310.   (defun EF:PickSet-fromList ( eList / ss )
     
311.     (setq ss (ssadd))
     
312.     (while eList
     
313.       (if (equal (type (car eList)) 'ENAME)
     
314.         (setq ss (ssadd (car eList) ss))
     
315.       )
     
316.       (setq eList (cdr elist))
     
317.     )
     
318.     ss
     
319.   )
     
320.   (defun *error*(msg)
     
321.     (if right_change
     
322.       (setvar "SHORTCUTMENU" old_SHORTCUTMENU)
     
323.     )
     
324.   )
     
325.   (princ "\n请点选要修改的字符:(左键+1右键-1)")
     
326.   (setq right_change nil)
     
327.   (if (/=(getvar "SHORTCUTMENU") 11)
     
328.     (progn
     
329.       (setq old_SHORTCUTMENU (getvar "SHORTCUTMENU"))
     
330.       (setvar "SHORTCUTMENU" 11)
     
331.       (setq right_change T);;标记右键变量有更改过
     
332.     )
     
333.   )
     
334.   (while
     
335.     (cond
     
336.       ((and  (setq pt (grread t 4 2)) ;获取grread值
     
337.          (equal (car pt) 5);;移动鼠标
     
338.        )
     
339.         (progn
     
340.           (setq ptt (cadr pt))
     
341.           (setq ent_temp (nentselp ptt))
     
342.           (setq en (car ent_temp))
     
343.           (if (or
     
344.                 (and (=(length ent_temp)2)(= (cdr(assoc 0 (entget en))) "ATTRIB"))
     
345.                 (and (=(length ent_temp)2)(= (cdr(assoc 0 (entget en))) "TEXT"))
     
346.               )
     
347.             (setq enable_change T)
     
348.             (setq enable_change nil)
     
349.           )  
     
350.           t
     
351.         )
     
352.       )
     
353.       ((and (equal (car pt) 3) en);_Mouse Left button  如果=3为左键;;;上次选择的en
     
354.         (if enable_change
     
355.           (progn         
     
356.             (setq ss (ssadd en))
     
357.             (wzcf ss)
     
358.             (redraw en 2);;redraw模式2隐藏图元
     
359.             (setq lst1(EF:PickSet-toList ss2))
     
360.             (setq newe(car(nentselp ptt)))
     
361.             (if
     
362.               (and (setq ent (entget newe)) ;获取图元
     
363.                 (setq str (cdr (assoc 1 ent))) ;读取数值
     
364.                 (cond
     
365.                   ((< 47 (setq strascii (ascii str)) 58)
     
366.                     (if (> (1+ strascii) 57)
     
367.                       (setq string (chr 48))
     
368.                       (setq string (chr (1+ strascii)))
     
369.                     )
     
370.                   )
     
371.                   ((< 64 strascii 91)
     
372.                     (if (> (1+ strascii) 90)
     
373.                       (setq string (chr 65))
     
374.                       (setq string (chr (1+ strascii)))
     
375.                     )
     
376.                   )
     
377.                   ((< 96 strascii 123)
     
378.                     (if (> (1+ strascii) 122)
     
379.                       (setq string (chr 97))
     
380.                       (setq string (chr (1+ strascii)))
     
381.                     )
     
382.                   )
     
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.                   (t (princ "\n非数值或字母!")nil)
     
447.                 )
     
448.               )
     
449.               (progn
     
450.                 (setq ent (subst (cons 1 string) (assoc 1 ent) ent))
     
451.                 (entmod ent)    ;更新实体数据库
     
452.               )
     
453.             )
     
454.             (setq ss3(EF:PickSet-fromList lst1))
     
455.             (setq lst(wzhb ss2))
     
456.             (entdel (car lst))
     
457.             (setq ss nil ss2 nil ss3 nil)            
     
458.             (setq elist(entget en))
     
459.             (entmod (subst (cons 1 (cadr lst)) (assoc 1 elist) elist))
     
460.             (entupd en)
     
461.             (redraw en 1);;redraw模式2隐藏图元            
     
462.           )         
     
463.           (princ "\n错误提示--请选择 单行文字 或 属性块文字<<<<")
     
464.         )        
     
465.         T;;继续循环        
     
466.       )
     
467.       ((and (or (equal (car pt) 11) (equal (car pt) 25)) en);_Mouse Right button  如果=11为右键   
     
468.         (if enable_change
     
469.           (progn      
     
470.             (setq ss (ssadd en))
     
471.             (wzcf ss)
     
472.             (redraw en 2);;redraw模式2隐藏图元
     
473.             (setq lst1(EF:PickSet-toList ss2))
     
474.             (setq newe(car(nentselp ptt)))
     
475.             (if
     
476.               (and (setq ent (entget newe)) ;获取图元
     
477.                 (setq str (cdr (assoc 1 ent))) ;读取数值
     
478.                 (cond
     
479.                   ((< 47 (setq strascii (ascii str)) 58)
     
480.                     (if (< (1- strascii) 48)
     
481.                       (setq string (chr 57))
     
482.                       (setq string (chr (1- strascii)))
     
483.                     )
     
484.                   )
     
485.                   ((< 64 strascii 91)
     
486.                     (if (< (1- strascii) 65)
     
487.                       (setq string (chr 90))
     
488.                       (setq string (chr (1- strascii)))
     
489.                     )
     
490.                   )
     
491.                   ((< 96 strascii 123)
     
492.                     (if (< (1- strascii) 97)
     
493.                       (setq string (chr 122))
     
494.                       (setq string (chr (1- strascii)))
     
495.                     )
     
496.                   )
     
497.                   ((= str "零")(setq string "十"))
     
498.                   ((= str "首")(setq string "零"))
     
499.                   ((= str "一")(setq string "首"))
     
500.                   ((= str "二")(setq string "一"))
     
501.                   ((= str "三")(setq string "二"))
     
502.                   ((= str "四")(setq string "三"))
     
503.                   ((= str "五")(setq string "四"))
     
504.                   ((= str "六")(setq string "五"))
     
505.                   ((= str "七")(setq string "六"))
     
506.                   ((= str "八")(setq string "七"))
     
507.                   ((= str "九")(setq string "八"))
     
508.                   ((= str "十")(setq string "九"))
     
509.                   ((= str "左")(setq string "右"))
     
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.                   (t (princ "\n非数值或字母!")nil)
     
561.                 )
     
562.               )
     
563.               (progn
     
564.                 (setq ent (subst (cons 1 string) (assoc 1 ent) ent))
     
565.                 (entmod ent)    ;更新实体数据库
     
566.               )
     
567.             )
     
568.             (setq ss3(EF:PickSet-fromList lst1))
     
569.             (setq lst(wzhb ss2))
     
570.             (entdel (car lst))
     
571.             (setq ss nil ss2 nil ss3 nil)
     
572.             (setq elist(entget en))
     
573.             (entmod (subst (cons 1 (cadr lst)) (assoc 1 elist) elist))
     
574.             (entupd en)
     
575.             (redraw en 1);;redraw模式2隐藏图元
     
576.           )         
     
577.           (princ "\n错误提示--请选择 单行文字 或 属性块文字<<<<")
     
578.         )        
     
579.         T;;继续循环        
     
580.       )      
     
581.     )
     
582.   )
     
583.   (setq ss nil ss2 nil ss3 nil)
     
584.   (if right_change
     
585.     (setvar "SHORTCUTMENU" old_SHORTCUTMENU)
     
586.   )
     
587.   (princ)
     
588. )
     

(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)<br />   ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;<br />   (defun *error* (msg)<br />     (and id (unload_dialog id))<br />     (and exprt (setvar 'expert exprt))<br />     (and file (vl-file-delete file))<br />     (if (not (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*"))<br />       (princ (strcat "\程序函数被取消: " msg))<br />     )<br />     (princ)<br />   )<br />   (defun wzhb(ss /  i ename dl ell x text e1 e2)<br />     ;(setq ss ss2)<br />     (setq<br />       i  0<br />       dl nil<br />       minx nil<br />     );setq<br />     (if ss (progn(sssetfirst nil ss)))<br />     (if (setq ss(ssget "P" '((0 . "TEXT"))))<br />       (progn<br />         (if (/= (sslength ss) 1)<br />           (progn<br />             (repeat (sslength ss)<br />               (setq ename (ssname ss i)<br />                 ell    (entget ename)<br />                 x      (cadr (assoc 10 ell))<br />                 text   (cdr (assoc 1 ell))<br />                 i      (1+ i)<br />               );setq<br />               (setq dl (append dl (list (list x text ename))))<br />             );repeat<br />             (setq dl    (vl-sort dl (function (lambda (e1 e2) (< (car e1) (car e2)))))<br />               i     1<br />               text  (cadr (nth 0 dl))<br />               ename (caddr (nth 0 dl))<br />               ell   (entget ename)<br />             );setq<br />             (repeat (- (length dl) 1)<br />               (setq text (strcat text (cadr (nth i dl))))<br />               (entdel (caddr (nth i dl)))<br />               (setq i (1+ i))<br />             );repeat<br />             (setq ell (subst (cons 1 text) (assoc 1 ell) ell))<br />             (entmod ell)<br />             (entupd ename)<br />           );progn<br />           (progn<br />             (setq ename(ssname ss 0))<br />             (setq text (cdr(assoc 1 (entget ename))))<br />           )<br />         )<br />       )<br />     );if<br />     ;(princ)<br />     (list ename text)<br />   )<br />   ;=====================================================<br />   ;=================    文字打断     ===================<br />   ;=====================================================<br />   ;打断所有文字<br />   (defun wzcf (ss /  i n )<br />     (if ss<br />       (progn<br />         (setvar "CMDECHO" 0)<br />         (if (= 0 (boole 1 8 (getvar 'undoctl))) (command "_.undo" "_group"))<br />         (setq i -1<br />           n (sslength ss)<br />         )<br />         (while (< (setq i (1+ i)) n)<br />           (if (and (setq ss2 (EF_Text:BreakAll (ssname ss i)) )<br />                 (>= (sslength ss2) 1)<br />               )            <br />             (EF:PickSet-Group ss2 "文字炸开")<br />           )<br />         )<br />         (if (= 8 (boole 1 8 (getvar 'undoctl))) (command "_.undo" "_end"))<br />       )<br />     )<br />   )<br />   ;将ss成组<br />   (defun EF:PickSet-Group (ss sName / )<br />     (command "Group" "C" "*" sName ss "")<br />   )<br />   ;文字打断所有<br />   (defun EF_Text:BreakAll (eText  ;待炸开的文字<br />                             /<br />                             ss<br />                             edata<br />                             str_Text<br />                             str_lst_Text<br />                             ang_Text<br />                             pt<br />                           )<br />     (setq ss (ssadd))<br />     (setq edata (entget eText))<br />     (setq str_Text (cdr (assoc 1 edata)))<br />     (setq str_lst_Text (EF_Text:StringExplode str_Text)<br />     ) ;将字符串拆解成单字列表<br />     (if (or (= (assoc 72 edata) 3)  ;对齐方式对齐<br />           (= (assoc 72 edata) 5)  ;对齐方式拟合<br />         )<br />       (setq ang_Text (angle (cdr (assoc 10 edata)) (cdr (assoc 11 edata))))<br />       (setq ang_Text (cdr (assoc 50 edata)))<br />     )<br />     (setq pt (cdr (assoc 10 edata)))<br />     (setq edata (list '(0 . "TEXT")<br />                   (assoc 8 edata)  ;图层<br />                   (assoc 40 edata)  ;高度<br />                   (assoc 41 edata)  ;宽度<br />                   (assoc 7 edata)  ;样式<br />                   (assoc 71 edata)  ;文字镜像<br />                   (cons 50 ang_Text)  ;转角<br />                   (assoc 51 edata)  ;倾角<br />                 )<br />     )<br />     (while str_lst_Text<br />       (setq str_Current (car str_lst_Text))<br />       (setq f_Width (EF_Text:getTextWidth str_Current edata))<br />       ;(EF-Text-PointWrite str_Current pt edata) ;按实际插入点填写文字<br />       ;;;    (if (and (/= str_Current " ") (/= str_Current "　"))<br />       ;;;      (progn<br />       (entmake (EF:List-SubstAssoc (list (cons 1 str_Current) (cons 10 pt)) edata T))<br />       (setq ss (ssadd (entlast) ss))<br />       ;;;  )<br />       ;;;      )<br />       (if (= (boole 1 (cdr (assoc 71 edata)) 2) 2)<br />         (setq pt (polar pt ang_Text (- 0 f_Width)))<br />         (setq pt (polar pt ang_Text f_Width))<br />       )<br />       (setq str_lst_Text (cdr str_lst_Text))<br />     )<br />     ;(entdel eText);;;;修改<br />     ss<br />   )<br />   ;=============================================================;<br />   ;拆分字符串                                                   ;<br />   ;EF_Text:StringExplode                                        ;<br />   ;=============================================================;<br />   ;取得 空格 宽度<br />   (defun EF_Text:getTextWidth (str  ;需要检测的字符串,如果为nil则取 edata<br />                                 edata  ;需要检测的文字样式图元表<br />                                 /<br />                                 box1 bo2<br />                               )<br />     (if (not str) (setq str (cdr (assoc 1 edata))))<br />     (setq box1 (textbox (EF:List-SubstAssoc (list (cons 1 (strcat "m" str "m"))) edata T)))<br />     (setq box2 (textbox (EF:List-SubstAssoc (list (cons 1 "mm")) edata T)))<br />     (- (- (caadr box1) (caar box1))<br />       (- (caadr box2) (caar box2))<br />     )<br />   )<br />   ;获取打断排除列表(单字符)<br />   (defun EF_Text:getBreakDefined ( / )<br />     (EF:String->List "%%130||%%131||%%132||%%133||%%134||%%135||%%136||%%p||%%P||%%c||%%C" "||")<br />   )<br />   ;获取打断排除列表(成对字符)<br />   (defun EF_Text:getBreakDefined2 ( / )<br />     (mapcar '(lambda (e)<br />                (EF:String->List e "*")<br />              )<br />       (EF:String->List "%%140*%%141||%%142*%%143||%%200*%%201||%%202*%%203||%%204*%%205" "||")<br />     )<br />   )<br />   ;字符串拆分<br />   (defun EF_Text:StringExplode (str_Given    ;需要转换的字符串<br />                                  /<br />                                  strlst_Defined  ;单定义字符  例：'("%%130" "%%131" "%%132" "%%p" ...)<br />                                  strlst_Defined2  ;成对定义字符 例 '((%%200 %%201) (%%202 %%203))<br />                                  b_Find    ;是否找到特殊字符串<br />                                  str_Defined  ;特殊字符串<br />                                  i_Length    ;特殊字符串 长度<br />                                  str_lst_Return  ;返回字符串列表<br />                                  e<br />                                )<br />     (setq strlst_Defined (EF_Text:getBreakDefined))<br />     (setq strlst_Defined2 (EF_Text:getBreakDefined2))<br />     ;检查字符串首是否在特殊字符串列表中<br />     (while (> (strlen str_Given) 0)<br />       (setq b_Find nil)<br />       ;检查 单定义字符<br />       (setq str_lst_Temp strlst_Defined)<br />       (while (and str_lst_Temp (not b_Find))<br />         (setq str_Defined (car str_lst_Temp ))<br />         (setq i_Length (strlen str_Defined))<br />         (if (= (substr str_Given 1 i_Length) str_Defined)<br />           (setq b_Find T)<br />         )<br />         (setq str_lst_Temp (cdr str_lst_Temp))<br />       )<br />       ;检查 成对定义字符<br />       (setq str_lst_Temp strlst_Defined2)<br />       (while (and str_lst_Temp (not b_Find))<br />         (setq str_Defined (caar str_lst_Temp ))<br />         (setq i_Length (strlen str_Defined))<br />         (if (= (substr str_Given 1 i_Length) str_Defined)<br />           (progn<br />             (setq b_Find T)<br />             (setq str_Defined (car str_lst_Temp))<br />           )<br />         )<br />         (setq str_lst_Temp (cdr str_lst_Temp))<br />       )<br />       (cond (b_Find  ;特殊字符串<br />               (progn<br />                 (if (equal (type str_Defined) 'STR)<br />                   (progn<br />                     (setq str_lst_Return (cons str_Defined str_lst_Return))<br />                     (setq str_Given (substr str_Given (1+ i_Length)))<br />                   )<br />                   (progn<br />                     (if (setq i (vl-string-search (cadr str_Defined) str_Given))<br />                       (progn<br />                         (setq e (substr str_Given 1 (+ i (strlen (cadr str_Defined)))))<br />                         (setq str_lst_Return (cons e str_lst_Return))<br />                         (setq str_Given (substr str_Given (+ 1 i (strlen (cadr str_Defined)))))<br />                       )<br />                       (progn<br />                         (setq str_lst_Return (cons (car str_Defined) str_lst_Return))<br />                         (setq str_Given (substr str_Given (1+ i_Length)))<br />                       )<br />                     )<br />                   )<br />                 )<br />               )<br />             )<br />         ((> (ascii (substr str_Given 1 1)) 128)  ;大于128为汉字<br />           (if (>= (atof (getvar "acadver")) 24)<br />             (progn <br />               (setq str_lst_Return (cons (substr str_Given 1 1) str_lst_Return))<br />               (setq str_Given (substr str_Given 2))<br />             )<br />             (progn <br />               (setq str_lst_Return (cons (substr str_Given 1 2) str_lst_Return))<br />               (setq str_Given (substr str_Given 3))<br />             )            <br />           )          <br />         )<br />         (T<br />           (setq str_lst_Return (cons (substr str_Given 1 1) str_lst_Return))<br />           (setq str_Given (substr str_Given 2))<br />         )<br />       )<br />     )<br />     (reverse str_lst_Return)<br />   )<br />   ;将字符串字符串以 给定 Key 分解成<br />   ;例：(EF:String->list "a,b,c" ",") →("a" "b" "c")<br />   (defun EF:String->list (sSource sDelimiter / lenSource lenDelimiter iPos lstResult)<br />     (if (= sDelimiter "") (progn (princ "EF:String->list 分割参数不能为空字符""") (exit)))<br />     (setq<br />       lenSource (strlen sSource)<br />       lenDelimiter (strlen sDelimiter)<br />     )<br />     (while (setq iPos (vl-string-search sDelimiter sSource))<br />       (setq<br />         lstResult (cons (substr sSource 1 iPos) lstResult)<br />         sSource (substr sSource (+ 1 iPos lenDelimiter))<br />       )<br />     )<br />     (reverse (cons sSource lstResult))<br />   ) ;_ end EF:String->list<br />   ;根据 lstSub 子表中的首元素 替换 lstSource 中对应表元<br />   (defun EF:List-SubstAssoc (lstSub  ;需要替换的列表<br />                               lstSource  ;源列表<br />                               bAdd    ;是否向源列表中追加 原本没有的元素<br />                               /<br />                               e1<br />                             )<br />     (foreach e lstSub<br />       (if (setq e1 (assoc (car e) lstSource))<br />         (setq lstSource (subst e (assoc (car e) lstSource) lstSource))<br />         (if bAdd (setq lstSource (append lstSource (list e))))<br />       )<br />     )<br />     lstSource<br />   )<br />   ;删除选择集<br />   (defun EF:PickSet-Erase (ss  / e )<br />     (while (> (sslength ss) 0)<br />       (setq e (ssname ss 0))<br />       (setq ss (ssdel e ss))<br />       (entdel e)<br />     )<br />   )<br />   ;选择集并集<br />   (defun EF:PickSet-Join (ss1  ;第一选择集<br />                            ss2  ;第二选择集<br />                            / i n ename)<br />     (setq i -1)<br />     (setq n (sslength ss1))<br />     (while (< (setq i (1+ i)) n)<br />       (setq ss2 (ssadd (ssname ss1 i) ss2))<br />     )<br />     ss2<br />   )<br />   ;选择集→元素列表<br />   (defun EF:PickSet-toList ( ss  / i eList)<br />     (setq i 0)<br />     (if (equal (type ss) 'PICKSET)<br />       (while (< i (sslength ss))<br />         (setq eList (cons (ssname ss i) eList))<br />         (setq i (1+ i))<br />       )<br />     )<br />     eList<br />   )<br />   ;元素列表→选择集<br />   (defun EF:PickSet-fromList ( eList / ss )<br />     (setq ss (ssadd))<br />     (while eList<br />       (if (equal (type (car eList)) 'ENAME)<br />         (setq ss (ssadd (car eList) ss))<br />       )<br />       (setq eList (cdr elist))<br />     )<br />     ss<br />   )<br />   (defun *error*(msg)<br />     (if right_change<br />       (setvar "SHORTCUTMENU" old_SHORTCUTMENU)<br />     )<br />   )<br />   (princ "\n请点选要修改的字符:(左键+1右键-1)")<br />   (setq right_change nil)<br />   (if (/=(getvar "SHORTCUTMENU") 11)<br />     (progn<br />       (setq old_SHORTCUTMENU (getvar "SHORTCUTMENU"))<br />       (setvar "SHORTCUTMENU" 11)<br />       (setq right_change T);;标记右键变量有更改过<br />     )<br />   )<br />   (while<br />     (cond<br />       ((and  (setq pt (grread t 4 2)) ;获取grread值<br />          (equal (car pt) 5);;移动鼠标<br />        )<br />         (progn<br />           (setq ptt (cadr pt))<br />           (setq ent_temp (nentselp ptt))<br />           (setq en (car ent_temp))<br />           (if (or<br />                 (and (=(length ent_temp)2)(= (cdr(assoc 0 (entget en))) "ATTRIB"))<br />                 (and (=(length ent_temp)2)(= (cdr(assoc 0 (entget en))) "TEXT"))<br />               )<br />             (setq enable_change T)<br />             (setq enable_change nil)<br />           )  <br />           t<br />         )<br />       )<br />       ((and (equal (car pt) 3) en);_Mouse Left button  如果=3为左键;;;上次选择的en<br />         (if enable_change<br />           (progn          <br />             (setq ss (ssadd en))<br />             (wzcf ss)<br />             (redraw en 2);;redraw模式2隐藏图元<br />             (setq lst1(EF:PickSet-toList ss2))<br />             (setq newe(car(nentselp ptt)))<br />             (if<br />               (and (setq ent (entget newe)) ;获取图元<br />                 (setq str (cdr (assoc 1 ent))) ;读取数值<br />                 (cond<br />                   ((< 47 (setq strascii (ascii str)) 58)<br />                     (if (> (1+ strascii) 57)<br />                       (setq string (chr 48))<br />                       (setq string (chr (1+ strascii)))<br />                     )<br />                   )<br />                   ((< 64 strascii 91)<br />                     (if (> (1+ strascii) 90)<br />                       (setq string (chr 65))<br />                       (setq string (chr (1+ strascii)))<br />                     )<br />                   )<br />                   ((< 96 strascii 123)<br />                     (if (> (1+ strascii) 122)<br />                       (setq string (chr 97))<br />                       (setq string (chr (1+ strascii)))<br />                     )<br />                   )<br />                   ((= str "零")(setq string "首"))<br />                   ((= str "首")(setq string "一"))<br />                   ((= str "一")(setq string "二"))<br />                   ((= str "二")(setq string "三"))<br />                   ((= str "三")(setq string "四"))<br />                   ((= str "四")(setq string "五"))<br />                   ((= str "五")(setq string "六"))<br />                   ((= str "六")(setq string "七"))<br />                   ((= str "七")(setq string "八"))<br />                   ((= str "八")(setq string "九"))<br />                   ((= str "九")(setq string "十"))<br />                   ((= str "十")(setq string "零"))<br />                   ((= str "左")(setq string "右"))<br />                   ((= str "右")(setq string "左"))<br />                   ((= str "上")(setq string "下"))<br />                   ((= str "下")(setq string "上"))<br />                   ((= str "东")(setq string "南"))<br />                   ((= str "南")(setq string "西"))<br />                   ((= str "西")(setq string "北"))<br />                   ((= str "北")(setq string "东"))<br />                   ((= str "男")(setq string "女"))<br />                   ((= str "女")(setq string "男"))<br />                   ((= str "前")(setq string "后"))<br />                   ((= str "后")(setq string "前"))<br />                   ((= str "内")(setq string "外"))<br />                   ((= str "外")(setq string "内"))<br />                   ((= str "大")(setq string "小"))<br />                   ((= str "小")(setq string "大"))<br />                   ((= str "梁")(setq string "板"))<br />                   ((= str "板")(setq string "梁"))<br />                   ((= str "水")(setq string "电"))<br />                   ((= str "电")(setq string "水"))<br />                   ((= str "强")(setq string "弱"))<br />                   ((= str "弱")(setq string "强"))<br />                   ((= str "平")(setq string "立"))<br />                   ((= str "立")(setq string "平"))<br />                   ((= str "明")(setq string "暗"))<br />                   ((= str "暗")(setq string "明"))<br />                   ((= str "甲")(setq string "乙"))<br />                   ((= str "乙")(setq string "丙"))<br />                   ((= str "丙")(setq string "丁"))<br />                   ((= str "丁")(setq string "戊"))<br />                   ((= str "门")(setq string "窗"))<br />                   ((= str "窗")(setq string "门"))<br />                   ((= str "开")(setq string "关"))<br />                   ((= str "关")(setq string "开"))<br />                   ((= str "给")(setq string "排"))<br />                   ((= str "排")(setq string "给"))<br />                   ((= str "正")(setq string "反"))<br />                   ((= str "反")(setq string "正"))<br />                   ((= str "主")(setq string "次"))<br />                   ((= str "次")(setq string "主"))<br />                   ((= str "雨")(setq string "污"))<br />                   ((= str "污")(setq string "雨"))<br />                   ((= str "长")(setq string "短"))<br />                   ((= str "短")(setq string "长"))<br />                   ((= str "高")(setq string "中"))<br />                   ((= str "中")(setq string "低"))<br />                   ((= str "低")(setq string "高"))<br />                   ((= str "轻")(setq string "重"))<br />                   ((= str "重")(setq string "轻"))                  <br />                   ((= str "硬")(setq string "软"))<br />                   ((= str "软")(setq string "硬"))<br />                   (t (princ "\n非数值或字母!")nil)<br />                 )<br />               )<br />               (progn<br />                 (setq ent (subst (cons 1 string) (assoc 1 ent) ent))<br />                 (entmod ent)    ;更新实体数据库<br />               )<br />             )<br />             (setq ss3(EF:PickSet-fromList lst1))<br />             (setq lst(wzhb ss2))<br />             (entdel (car lst))<br />             (setq ss nil ss2 nil ss3 nil)            <br />             (setq elist(entget en))<br />             (entmod (subst (cons 1 (cadr lst)) (assoc 1 elist) elist))<br />             (entupd en)<br />             (redraw en 1);;redraw模式2隐藏图元            <br />           )          <br />           (princ "\n错误提示--请选择 单行文字 或 属性块文字<<<<")<br />         )        <br />         T;;继续循环        <br />       )<br />       ((and (or (equal (car pt) 11) (equal (car pt) 25)) en);_Mouse Right button  如果=11为右键    <br />         (if enable_change<br />           (progn      <br />             (setq ss (ssadd en))<br />             (wzcf ss)<br />             (redraw en 2);;redraw模式2隐藏图元<br />             (setq lst1(EF:PickSet-toList ss2))<br />             (setq newe(car(nentselp ptt)))<br />             (if<br />               (and (setq ent (entget newe)) ;获取图元<br />                 (setq str (cdr (assoc 1 ent))) ;读取数值<br />                 (cond<br />                   ((< 47 (setq strascii (ascii str)) 58)<br />                     (if (< (1- strascii) 48)<br />                       (setq string (chr 57))<br />                       (setq string (chr (1- strascii)))<br />                     )<br />                   )<br />                   ((< 64 strascii 91)<br />                     (if (< (1- strascii) 65)<br />                       (setq string (chr 90))<br />                       (setq string (chr (1- strascii)))<br />                     )<br />                   )<br />                   ((< 96 strascii 123)<br />                     (if (< (1- strascii) 97)<br />                       (setq string (chr 122))<br />                       (setq string (chr (1- strascii)))<br />                     )<br />                   )<br />                   ((= str "零")(setq string "十"))<br />                   ((= str "首")(setq string "零"))<br />                   ((= str "一")(setq string "首"))<br />                   ((= str "二")(setq string "一"))<br />                   ((= str "三")(setq string "二"))<br />                   ((= str "四")(setq string "三"))<br />                   ((= str "五")(setq string "四"))<br />                   ((= str "六")(setq string "五"))<br />                   ((= str "七")(setq string "六"))<br />                   ((= str "八")(setq string "七"))<br />                   ((= str "九")(setq string "八"))<br />                   ((= str "十")(setq string "九"))<br />                   ((= str "左")(setq string "右"))<br />                   ((= str "右")(setq string "左"))<br />                   ((= str "上")(setq string "下"))<br />                   ((= str "下")(setq string "上"))<br />                   ((= str "东")(setq string "北"))<br />                   ((= str "南")(setq string "东"))<br />                   ((= str "西")(setq string "南"))<br />                   ((= str "北")(setq string "西"))<br />                   ((= str "女")(setq string "男"))<br />                   ((= str "男")(setq string "女"))<br />                   ((= str "后")(setq string "前"))<br />                   ((= str "前")(setq string "后"))<br />                   ((= str "外")(setq string "内"))<br />                   ((= str "内")(setq string "外"))<br />                   ((= str "小")(setq string "大"))<br />                   ((= str "大")(setq string "小"))<br />                   ((= str "板")(setq string "梁"))<br />                   ((= str "梁")(setq string "板"))<br />                   ((= str "电")(setq string "水"))<br />                   ((= str "水")(setq string "电"))<br />                   ((= str "弱")(setq string "强"))<br />                   ((= str "强")(setq string "弱"))<br />                   ((= str "立")(setq string "平"))<br />                   ((= str "平")(setq string "立"))<br />                   ((= str "暗")(setq string "明"))<br />                   ((= str "明")(setq string "暗"))<br />                   ((= str "乙")(setq string "甲"))<br />                   ((= str "丙")(setq string "乙"))<br />                   ((= str "丁")(setq string "丙"))<br />                   ((= str "戊")(setq string "丁"))<br />                   ((= str "窗")(setq string "门"))<br />                   ((= str "门")(setq string "窗"))<br />                   ((= str "关")(setq string "开"))<br />                   ((= str "开")(setq string "关"))<br />                   ((= str "排")(setq string "给"))<br />                   ((= str "给")(setq string "排"))<br />                   ((= str "反")(setq string "正"))<br />                   ((= str "正")(setq string "反"))<br />                   ((= str "次")(setq string "主"))<br />                   ((= str "主")(setq string "次"))<br />                   ((= str "污")(setq string "雨"))<br />                   ((= str "雨")(setq string "污"))<br />                   ((= str "短")(setq string "长"))<br />                   ((= str "长")(setq string "短"))<br />                   ((= str "低")(setq string "中"))<br />                   ((= str "中")(setq string "高"))<br />                   ((= str "高")(setq string "低"))<br />                   ((= str "重")(setq string "轻"))<br />                   ((= str "轻")(setq string "重"))<br />                   ((= str "软")(setq string "硬"))<br />                   ((= str "硬")(setq string "软"))<br />                   (t (princ "\n非数值或字母!")nil)<br />                 )<br />               )<br />               (progn<br />                 (setq ent (subst (cons 1 string) (assoc 1 ent) ent))<br />                 (entmod ent)    ;更新实体数据库<br />               )<br />             )<br />             (setq ss3(EF:PickSet-fromList lst1))<br />             (setq lst(wzhb ss2))<br />             (entdel (car lst))<br />             (setq ss nil ss2 nil ss3 nil)<br />             (setq elist(entget en))<br />             (entmod (subst (cons 1 (cadr lst)) (assoc 1 elist) elist))<br />             (entupd en)<br />             (redraw en 1);;redraw模式2隐藏图元<br />           )          <br />           (princ "\n错误提示--请选择 单行文字 或 属性块文字<<<<")<br />         )        <br />         T;;继续循环        <br />       )      <br />     )<br />   )<br />   (setq ss nil ss2 nil ss3 nil)<br />   (if right_change<br />     (setvar "SHORTCUTMENU" old_SHORTCUTMENU)<br />   )<br />   (princ)<br /> )<br />

yz_bs_jj

plusminus命令，不错。保存为txt ，改名lsp，加载后很好用，对序号很好

dfdfsdfsvnnk

你改过之后是个什么效果呢，能不能说一下？

669423907

有意思，要是能支持多行文字就更好啦！

springwillow

dfdfsdfsvnnk 发表于 2012-2-21 20:11
你改过之后是个什么效果呢，能不能说一下？

原来是需要先选中对象，然后点鼠标左右键才能实现加减，改完之后可以直接在对象上点击左右键。试试就知道了。

xzqk132

不知springwillow大侠是否可以分享烈火兄的代码？谢谢
想学习一下

hpy

程序不错，这样的程序用在什么地方比较实用呢？

springwillow

xzqk132 发表于 2012-2-22 11:30
不知springwillow大侠是否可以分享烈火兄的代码？谢谢
想学习一下

2. ;;;Writed by chlh_jd ;左键加1，右键减
   
3. 1
   
4. (defun c:tt (/ en ent str pt)
   
5.   (if (and (setq en (car (entsel "Select Integer Number Text :")))
   
6.            (setq ent (entget en))        ;获取图元
   
7.            (setq str (cdr (assoc 1 ent))) ;读取数值
   
8.            (numberp (eval (read str)))       
   
9.            (equal (atoi str) (atof str))
   
10.       )
    
11.     (while (and        (setq pt (grread t 4 2)) ;获取grread值
    
12.                 (not (and (= 2 (car pt)) ;排除回车和空格往下进行
    
13.                           (or (= 13 (cadr pt)) (= 32 (cadr pt)))
    
14.                      )
    
15.                 ) ;_Enter Space
    
16.            )
    
17.       (cond ((= (car pt) 3) ;_Mouse Left button  如果=3为左键
    
18.              (setq str (rtos (1+ (atoi str)) 2 0)) ;将数值加1
    
19.              (setq ent (subst (cons 1 str) (assoc 1 ent) ent))
    
20.              (entmod ent)                ;更新实体数据库
    
21.             )
    
22.             ((or (= (car pt) 11) (= (car pt) 25)) ;_Mouse Right button  如果=11为右键
    
23.              (setq str (rtos (1- (atoi str)) 2 0)) ;将数值减1
    
24.              (setq ent (subst (cons 1 str) (assoc 1 ent) ent))
    
25.              (entmod ent)                ;更新实体数据库
    
26.             )
    
27.       )
    
28.     )
    
29.     (princ)
    
30.   )
    
31.   (princ)
    
32. )

;;;Writed by chlh_jd ;左键加1，右键减<br /> 1<br /> (defun c:tt (/ en ent str pt)<br />   (if (and (setq en (car (entsel "Select Integer Number Text :")))<br />            (setq ent (entget en))        ;获取图元<br />            (setq str (cdr (assoc 1 ent))) ;读取数值<br />            (numberp (eval (read str)))        <br />            (equal (atoi str) (atof str)) <br />       )<br />     (while (and        (setq pt (grread t 4 2)) ;获取grread值<br />                 (not (and (= 2 (car pt)) ;排除回车和空格往下进行<br />                           (or (= 13 (cadr pt)) (= 32 (cadr pt)))<br />                      )<br />                 ) ;_Enter Space<br />            )<br />       (cond ((= (car pt) 3) ;_Mouse Left button  如果=3为左键<br />              (setq str (rtos (1+ (atoi str)) 2 0)) ;将数值加1<br />              (setq ent (subst (cons 1 str) (assoc 1 ent) ent))<br />              (entmod ent)                ;更新实体数据库<br />             )<br />             ((or (= (car pt) 11) (= (car pt) 25)) ;_Mouse Right button  如果=11为右键<br />              (setq str (rtos (1- (atoi str)) 2 0)) ;将数值减1<br />              (setq ent (subst (cons 1 str) (assoc 1 ent) ent))<br />              (entmod ent)                ;更新实体数据库<br />             )<br />       )<br />     )<br />     (princ)<br />   )<br />   (princ)<br /> )

ㄘ丶转裑ㄧ灬

现在只支持纯数字，带小数点的也不行，要是能支持就好了，用处更大。。。不过还是非常感谢、、、

AMTONNY

思路不错,支持一下

xzqk132

springwillow 发表于 2012-2-22 12:46

非常感谢springwillow兄！