[编程申请]：[编程申请]：求lisp,实现修改数字文本

jiechuwang

要求选中要修改的数字文本,然后输入相应要在原基础上增加或减去的数值,实现全部选中数字文本的自动增减.如原数字为56 57 58,那么要求都减1,得到55,56,57

原地踏步

这是我过去编的一个修改高程表的程序。全局变量YB:CHGALT_DIGIT表示小数位数，整数为0。

2. 
   
3. ;;***************************** CHGALT.LSP *****************************
   
4. ;;
   
5. ;;  For AutoCAD R14
   
6. ;;
   
7. ;;  本程序修改高程表.
   
8. ;;  若实体位于锁定层上, 该层将被自动解锁.
   
9. ;;
   
10. ;;----------------------------------------------------------------------
    
11. ;;
    
12. ;; Set default
    
13. ;;
    
14.   (if (null YB:CHGALT_DIGIT) (setq YB:CHGALT_DIGIT 2))
    
15. ;;
    
16. ;;========================= The Main Function ==========================
    
17. ;;
    
18. (defun c:chgalt (/ cde blp dzn olderr ss n num att lay dig add alt)
    
19.   (setq cde (getvar "cmdecho")
    
20.         blp (getvar "blipmode")
    
21.         dzn (getvar "dimzin")
    
22.   )
    
23. ;;
    
24. ;; Internal error handler
    
25. ;;
    
26. (defun ca_err (s)
    
27.   (if (/= s "Function cancelled")
    
28.     (princ (strcat "\nError: " s))
    
29.   )
    
30.   (setq ss nil)
    
31.   (setvar "blipmode" blp)
    
32.   (setvar "dimzin" dzn)
    
33.   (command "_.UNDO" "_END")
    
34.   (setvar "cmdecho" cde)
    
35.   (setq *error* olderr)
    
36.   (princ)
    
37. )
    
38. ;;
    
39.   (setq olderr *error*  *error* ca_err)
    
40.   (setvar "cmdecho" 0)
    
41.   (command "_.UNDO" "_GROUP")
    
42.   (setvar "blipmode" 0)
    
43.   (setvar "dimzin" 0)
    
44.   (setq ss (ssget '((0 . "TEXT")))
    
45.         n 0
    
46.         num 0
    
47.   )
    
48.   (if ss (progn
    
49.     (initget 4)
    
50.     (setq dig (getint (strcat "\nDecimal digits <" (itoa YB:CHGALT_DIGIT) ">: ")))
    
51.     (if dig (setq YB:CHGALT_DIGIT dig))
    
52.     (setq add (getreal "\nAdded altitude <0>: "))
    
53.     (if (null add) (setq add 0))
    
54.     (repeat (sslength ss)
    
55.       (setq att (entget (ssname ss n))
    
56.             lay (ai_val 8 att)
    
57.             n (1+ n)
    
58.       )
    
59.       (if (ai_lck lay)
    
60.         (progn
    
61.           (command "_.-LAYER" "UNLOCK" lay "")
    
62.           (ca_dmf)
    
63.         )
    
64.         (ca_dmf)
    
65.       )
    
66.     )
    
67.   ))
    
68.   (print num)
    
69.   (princ "changed.")
    
70.   (setq ss nil)
    
71.   (setvar "blipmode" blp)
    
72.   (setvar "dimzin" dzn)
    
73.   (command "_.UNDO" "_END")
    
74.   (setvar "cmdecho" cde)
    
75.   (setq *error* olderr)
    
76.   (princ)
    
77. )
    
78. ;;
    
79. ;;======================= The Support Functions ========================
    
80. ;;
    
81. ;; ChgAlt_Do_Main_Function
    
82. ;;
    
83. (defun ca_dmf ()
    
84.   (setq alt (distof (cdr (assoc 1 att))))
    
85.   (if alt (progn
    
86.     (setq alt (rtos (+ alt add) 2 YB:CHGALT_DIGIT)
    
87.           num (1+ num)
    
88.     )
    
89.     (entmod (subst (cons 1 alt) (assoc 1 att) att))
    
90.   ))
    
91. )
    
92. ;;
    
93. (defun ai_val (v attr)
    
94.   (cdr (assoc v attr))
    
95. )
    
96. ;;
    
97. (defun ai_lck (lay)
    
98.   (if (= (logand (ai_val 70 (tblsearch "LAYER" lay)) 4) 4)
    
99.     T
    
100.     nil
     
101.   )
     
102. )
     
103. ;;======================================================================
     
104. (princ)

<br /> ;;***************************** CHGALT.LSP *****************************<br /> ;;<br /> ;;  For AutoCAD R14<br /> ;;<br /> ;;  本程序修改高程表.<br /> ;;  若实体位于锁定层上, 该层将被自动解锁.<br /> ;;<br /> ;;----------------------------------------------------------------------<br /> ;;<br /> ;; Set default<br /> ;;<br />   (if (null YB:CHGALT_DIGIT) (setq YB:CHGALT_DIGIT 2))<br /> ;;<br /> ;;========================= The Main Function ==========================<br /> ;;<br /> (defun c:chgalt (/ cde blp dzn olderr ss n num att lay dig add alt)<br />   (setq cde (getvar "cmdecho")<br />         blp (getvar "blipmode")<br />         dzn (getvar "dimzin")<br />   )<br /> ;;<br /> ;; Internal error handler<br /> ;;<br /> (defun ca_err (s)<br />   (if (/= s "Function cancelled")<br />     (princ (strcat "\nError: " s))<br />   )<br />   (setq ss nil)<br />   (setvar "blipmode" blp)<br />   (setvar "dimzin" dzn)<br />   (command "_.UNDO" "_END")<br />   (setvar "cmdecho" cde)<br />   (setq *error* olderr)<br />   (princ)<br /> )<br /> ;;<br />   (setq olderr *error*  *error* ca_err)<br />   (setvar "cmdecho" 0)<br />   (command "_.UNDO" "_GROUP")<br />   (setvar "blipmode" 0)<br />   (setvar "dimzin" 0)<br />   (setq ss (ssget '((0 . "TEXT")))<br />         n 0<br />         num 0<br />   )<br />   (if ss (progn<br />     (initget 4)<br />     (setq dig (getint (strcat "\nDecimal digits <" (itoa YB:CHGALT_DIGIT) ">: ")))<br />     (if dig (setq YB:CHGALT_DIGIT dig))<br />     (setq add (getreal "\nAdded altitude <0>: "))<br />     (if (null add) (setq add 0))<br />     (repeat (sslength ss)<br />       (setq att (entget (ssname ss n))<br />             lay (ai_val 8 att)<br />             n (1+ n)<br />       )<br />       (if (ai_lck lay)<br />         (progn<br />           (command "_.-LAYER" "UNLOCK" lay "")<br />           (ca_dmf)<br />         ) <br />         (ca_dmf)<br />       )<br />     )<br />   ))<br />   (print num)<br />   (princ "changed.")<br />   (setq ss nil)<br />   (setvar "blipmode" blp)<br />   (setvar "dimzin" dzn)<br />   (command "_.UNDO" "_END")<br />   (setvar "cmdecho" cde)<br />   (setq *error* olderr)<br />   (princ)<br /> )<br /> ;;<br /> ;;======================= The Support Functions ========================<br /> ;;<br /> ;; ChgAlt_Do_Main_Function<br /> ;;<br /> (defun ca_dmf ()<br />   (setq alt (distof (cdr (assoc 1 att))))<br />   (if alt (progn<br />     (setq alt (rtos (+ alt add) 2 YB:CHGALT_DIGIT)<br />           num (1+ num)<br />     )<br />     (entmod (subst (cons 1 alt) (assoc 1 att) att))<br />   ))<br /> )<br /> ;;<br /> (defun ai_val (v attr)<br />   (cdr (assoc v attr))<br /> )<br /> ;;<br /> (defun ai_lck (lay)<br />   (if (= (logand (ai_val 70 (tblsearch "LAYER" lay)) 4) 4)<br />     T<br />     nil<br />   )<br /> )<br /> ;;======================================================================<br /> (princ)

jiechuwang

能不能给个注释呢,谢谢

xyp1964

2. [FONT=courier new](load "xyp_lib.vlx")  ;版本 V.20051205 (1781)
   
3. ;|下载和加载通用函数(可在签名栏直接下载后放到搜索路径下)
   
4. 利用以下任何一种方式（首选第一种）即可加载和运行通用函数内的所有子程序：
   
5. ★1·在acad.lsp中增加(load"xyp_lib.vlx")
   
6. ■2·在每个程序内增加(load"xyp_lib.vlx")
   
7. ■3·在command下，输入(load"xyp_lib.vlx")
   
8. ■4·在菜单.mnl中增加(load"xyp_lib.vlx")
   
9. ■5·将xyp_lib.vlx文件直接拽到cad屏幕
   
10. [COLOR=red] ★通用函数下载地址：[/COLOR]
    
11. [url]http://www.xdcad.net/forum/attachment.php?s=&postid=1606661[/url]
    
12. |;
    
13. 
    
14. ;;修改数字文本
    
15. (defun c:test ()
    
16.   (CMDLA0)
    
17.   (if(null no)(setq no 1))
    
18.   (setq        no (UREAL 1 "" "\n增减数值" no)
    
19.         int (UINT 1 "" "\n小数点位数" INT)
    
20.         ss (ssget '((0 . "TEXT")))
    
21.         i  -1
    
22.   )
    
23.   (while (setq s1 (ssname ss (setq i (1+ i))))
    
24.     (setq txt (xyp-get-dxf 1 s1))
    
25.     (if        (setq txt1 (distof txt))
    
26.       (progn
    
27.         (setq txt (rtos (+ txt1 no) 2 int))
    
28.         (sub_upd s1 1 txt)
    
29.       )
    
30.     )
    
31.   )
    
32.   (CMDLA1)
    
33. )[/FONT]

[FONT=courier new](load "xyp_lib.vlx")  ;版本 V.20051205 (1781)<br /> ;|下载和加载通用函数(可在签名栏直接下载后放到搜索路径下)<br /> 利用以下任何一种方式（首选第一种）即可加载和运行通用函数内的所有子程序：<br /> ★1·在acad.lsp中增加(load"xyp_lib.vlx")<br /> ■2·在每个程序内增加(load"xyp_lib.vlx")<br /> ■3·在command下，输入(load"xyp_lib.vlx")<br /> ■4·在菜单.mnl中增加(load"xyp_lib.vlx")<br /> ■5·将xyp_lib.vlx文件直接拽到cad屏幕<br /> [COLOR=red] ★通用函数下载地址：[/COLOR]<br /> [url]http://www.xdcad.net/forum/attachment.php?s=&postid=1606661[/url]<br /> |;<br /> <br /> ;;修改数字文本<br /> (defun c:test ()<br />   (CMDLA0)<br />   (if(null no)(setq no 1))<br />   (setq        no (UREAL 1 "" "\n增减数值" no)<br />         int (UINT 1 "" "\n小数点位数" INT)<br />         ss (ssget '((0 . "TEXT")))<br />         i  -1<br />   )<br />   (while (setq s1 (ssname ss (setq i (1+ i))))<br />     (setq txt (xyp-get-dxf 1 s1))<br />     (if        (setq txt1 (distof txt))<br />       (progn<br />         (setq txt (rtos (+ txt1 no) 2 int))<br />         (sub_upd s1 1 txt)<br />       )<br />     )<br />   )<br />   (CMDLA1)<br /> )[/FONT]

542600

xx

jiechuwang

我自己也做了一个
(defun C:cht();改变数字，在原基础上增加或减去某个值
  (setq ss (ssget '((0 . "TEXT")))
        n 0
        num 0
  )
  (if ss (progn
    (setq add (getint "\nAdded number <0>: "))
    (if (null add) (setq add 0))
    (repeat (sslength ss)
      (setq att (entget (ssname ss n))
           
            n (1+ n)
      )
  (setq alt (distof (cdr (assoc 1 att))))
  (if alt (progn
    (setq alt (rtos (+ alt add) 2)
          num (1+ num)
    )
    (entmod (subst (cons 1 alt) (assoc 1 att) att))
  ))
))
)

)