文字加减复制的lisp程序

szx025

lostbalance 发表于 2018-6-13 19:41
你把程序再发一遍看看

2. (defun C:T11 ( / buchang1 $buchang SS SS1 e0 ent PT i loop ENTL E-1 NEWTX ENT_TMP)
   
3. (setvar "dimzin" 0)
   
4.   (if (null $buchang) (setq $buchang 1))
   
5.   (setq $buchang (ureal 1 "" "\n增减值(正为增,负为减)" $buchang) buchang1 $buchang)
   
6.   (setq ss (ssget '((0 . "*TEXT"))))
   
7. (setq e0 (entlast))  
   
8.   (setq pt (getpoint "指定基点:"))   
   
9.   (command "copy" ss "" pt pause)  
   
10.   (setq loop T)
    
11.   (while loop   
    
12.   (SETQ SS1 (last_ent E0) I 0)
    
13.   (repeat (sslength ss1)
    
14.     (setq ent (ssname ss1 i)
    
15.           entl (entget ent);图元资料
    
16.           e-1 (cdr (assoc 1 entl));;文字内容
    
17.           i (1+ i)
    
18.           (setq NEWTX (rtos (+ (atof E-1) BUCHANG1)) 2 3)
    
19.     )
    
20.    (entmod (subst (cons 1 NEWTX) (assoc 1 entl) entl));更新文字
    
21.   );end repeat  
    
22. (setq e0 (entlast))
    
23. (setq buchang1 (+ buchang1 $buchang))
    
24.     (command "copy" ss "" pt pause)
    
25.     (setq Point (getvar "LastPoint"))
    
26.     (if (= 0 (distance Point pt)) ;判断最后一点是不是pt点.
    
27.         (progn
    
28.         (setq loop nil) ;Right Button
    
29.         (setq ent_tmp (LAST_ENT e0)) ;ent_tmp 是e0后生成的物体.
    
30.         (command "_.erase" ent_tmp "" )
    
31.         )      
    
32.         )   
    
33.   );end while
    
34. )   
    
35. (defun last_ent (en / ss)
    
36.    (if en
    
37.      (progn
    
38.        (setq ss (ssadd))
    
39.        (while (setq en (entnext en))
    
40.          (if (not (member (cdr (assoc 0 (entget en)))
    
41.                           '("ATTRIB" "VERTEX" "SEQEND")
    
42.                   )
    
43.              )
    
44.            (ssadd en ss)
    
45.          );if
    
46.        );while
    
47.        (if (zerop (sslength ss)) (setq ss nil))
    
48.        ss
    
49.      );progn
    
50.      (ssget "_x")
    
51.    );if
    
52. )
    
53. (defun Plus1 (str buchang / d1 d2 h)
    
54.   (setq str (vl-string-translate "-" (chr 1) str))
    
55.   (setq d1 (last (string_to_numbers str))
    
56.         h (vl-string-right-trim d1 str))
    
57.   (setq d2 (vl-princ-to-string (+ (read d1) buchang)))
    
58.   (while (< (strlen d2) (strlen d1))
    
59.   (setq d2 (strcat  d2 "0" ))
    
60.    ; (setq d2 (strcat "0" d2))
    
61.   )
    
62.   (vl-string-translate (chr 1) "-" (strcat h d2))
    
63. )
    
64. 
    
65. ;;; Bill Kramer
    
66. ;
    
67. (defun String_To_Numbers (
    
68.                           inStr  ;;Input string
    
69.                           /
    
70.                           Res    ;;Result list
    
71.                           Buf    ;;String buffer
    
72.                           Inx      ;;Character location
    
73.                           CH     ;;Character
    
74.                           )
    
75.   (setq Inx 1 ;start at the beginning of the string
    
76.         Buf "" ;init buffer to empty
    
77.         )
    
78.   ;
    
79.   ; Loop until the end of the string.
    
80.   ; (I indicates where we are in the string)
    
81.   ;
    
82.   (while (<= Inx (strlen inStr))
    
83.     ;
    
84.     ; Get the character at position Inx, increment position indicator
    
85.     (setq CH (substr inStr Inx 1)
    
86.           Inx (1+ Inx)
    
87.           )
    
88.     ;
    
89.     (cond
    
90.       ; Test to see if character is a digit.
    
91.       ((wcmatch CH "[0-9.]")
    
92.         (if (= CH ".") ;is it decimal?
    
93.           (if (not (wcmatch Buf "*`.*")) ;not already in there
    
94.             (setq Buf (strcat Buf CH))
    
95.             (Flush_Buf))
    
96.           ;
    
97.           (setq Buf (strcat Buf CH)))
    
98.       )
    
99.       ((= Buf "") ;is the buffer empty?
    
100.                ;Is CH minus
     
101.         (if (= CH "-")
     
102.           (setq Buf CH) ;Yes, save in Buf
     
103.         )
     
104.       )
     
105.       ('T ;else buffer is not empty
     
106.         (Flush_Buf)
     
107.         (if (= CH "-")
     
108.           (setq Buf CH))
     
109.       )
     
110.     ); End of COND
     
111.   ); End of WHILE
     
112.   ;
     
113.   (if (and (/= Buf "")
     
114.            (not (wcmatch Buf "[+-.]"))
     
115.            )
     
116.     (Flush_Buf))
     
117.   (reverse Res)
     
118. )
     
119. (defun Flush_Buf ()
     
120.   (if (not (wcmatch Buf "[+-.]")) ;is it not just +-.?
     
121.     (progn
     
122.       ;Clean it up first
     
123.       (if (= (substr Buf 1 1) ".")
     
124.         (setq Buf (strcat "0" Buf))) ;;add zero to front if .#
     
125.       (if (= (substr Buf (strlen Buf)) ".")
     
126.         (setq Buf (substr Buf 1 (1- (strlen Buf))))) ;;remove decimal if #.
     
127.       ;Add to RES list
     
128.       (setq RES (cons Buf RES))))
     
129.   (setq Buf "") ;;reset Buf
     
130. )

(defun C:T11 ( / buchang1 $buchang SS SS1 e0 ent PT i loop ENTL E-1 NEWTX ENT_TMP)<br /> (setvar "dimzin" 0)<br />   (if (null $buchang) (setq $buchang 1))<br />   (setq $buchang (ureal 1 "" "\n增减值(正为增,负为减)" $buchang) buchang1 $buchang) <br />   (setq ss (ssget '((0 . "*TEXT")))) <br /> (setq e0 (entlast))  <br />   (setq pt (getpoint "指定基点:"))    <br />   (command "copy" ss "" pt pause)  <br />   (setq loop T)<br />   (while loop    <br />   (SETQ SS1 (last_ent E0) I 0) <br />   (repeat (sslength ss1)<br />     (setq ent (ssname ss1 i)<br />           entl (entget ent);图元资料<br />           e-1 (cdr (assoc 1 entl));;文字内容<br />           i (1+ i)<br />           (setq NEWTX (rtos (+ (atof E-1) BUCHANG1)) 2 3)<br />     )<br />    (entmod (subst (cons 1 NEWTX) (assoc 1 entl) entl));更新文字<br />   );end repeat  <br /> (setq e0 (entlast))<br /> (setq buchang1 (+ buchang1 $buchang))<br />     (command "copy" ss "" pt pause)<br />     (setq Point (getvar "LastPoint"))<br />     (if (= 0 (distance Point pt)) ;判断最后一点是不是pt点.<br />         (progn<br />         (setq loop nil) ;Right Button<br />         (setq ent_tmp (LAST_ENT e0)) ;ent_tmp 是e0后生成的物体.<br />         (command "_.erase" ent_tmp "" )<br />         )       <br />         )   <br />   );end while<br /> )   <br /> (defun last_ent (en / ss)<br />    (if en<br />      (progn<br />        (setq ss (ssadd))<br />        (while (setq en (entnext en))<br />          (if (not (member (cdr (assoc 0 (entget en)))<br />                           '("ATTRIB" "VERTEX" "SEQEND")<br />                   )<br />              )<br />            (ssadd en ss)<br />          );if<br />        );while<br />        (if (zerop (sslength ss)) (setq ss nil))<br />        ss<br />      );progn<br />      (ssget "_x")<br />    );if<br /> )<br /> (defun Plus1 (str buchang / d1 d2 h)<br />   (setq str (vl-string-translate "-" (chr 1) str))<br />   (setq d1 (last (string_to_numbers str))<br />         h (vl-string-right-trim d1 str))<br />   (setq d2 (vl-princ-to-string (+ (read d1) buchang)))<br />   (while (< (strlen d2) (strlen d1))<br />   (setq d2 (strcat  d2 "0" ))<br />    ; (setq d2 (strcat "0" d2))<br />   )<br />   (vl-string-translate (chr 1) "-" (strcat h d2))<br /> )<br /> <br /> ;;; Bill Kramer<br /> ;<br /> (defun String_To_Numbers (<br />                           inStr  ;;Input string<br />                           /<br />                           Res    ;;Result list<br />                           Buf    ;;String buffer<br />                           Inx      ;;Character location<br />                           CH     ;;Character<br />                           )<br />   (setq Inx 1 ;start at the beginning of the string<br />         Buf "" ;init buffer to empty<br />         )<br />   ;<br />   ; Loop until the end of the string.<br />   ; (I indicates where we are in the string)<br />   ;<br />   (while (<= Inx (strlen inStr))<br />     ;<br />     ; Get the character at position Inx, increment position indicator<br />     (setq CH (substr inStr Inx 1)<br />           Inx (1+ Inx)<br />           )<br />     ;<br />     (cond<br />       ; Test to see if character is a digit.<br />       ((wcmatch CH "[0-9.]")<br />         (if (= CH ".") ;is it decimal?<br />           (if (not (wcmatch Buf "*`.*")) ;not already in there<br />             (setq Buf (strcat Buf CH))<br />             (Flush_Buf))<br />           ;<br />           (setq Buf (strcat Buf CH)))<br />       )<br />       ((= Buf "") ;is the buffer empty?<br />                ;Is CH minus<br />         (if (= CH "-")<br />           (setq Buf CH) ;Yes, save in Buf<br />         )<br />       )<br />       ('T ;else buffer is not empty<br />         (Flush_Buf)<br />         (if (= CH "-")<br />           (setq Buf CH))<br />       )<br />     ); End of COND<br />   ); End of WHILE<br />   ;<br />   (if (and (/= Buf "")<br />            (not (wcmatch Buf "[+-.]"))<br />            )<br />     (Flush_Buf))<br />   (reverse Res)<br /> )<br /> (defun Flush_Buf ()<br />   (if (not (wcmatch Buf "[+-.]")) ;is it not just +-.?<br />     (progn<br />       ;Clean it up first<br />       (if (= (substr Buf 1 1) ".")<br />         (setq Buf (strcat "0" Buf))) ;;add zero to front if .#<br />       (if (= (substr Buf (strlen Buf)) ".")<br />         (setq Buf (substr Buf 1 (1- (strlen Buf))))) ;;remove decimal if #.<br />       ;Add to RES list<br />       (setq RES (cons Buf RES))))<br />   (setq Buf "") ;;reset Buf<br /> )

szx025

呼叫 lostbalance

lostbalance

szx025 发表于 2018-6-15 15:09
呼叫 lostbalance

好像网络问题，前两天发的没成功啊……
手机上的，简单说下吧……
1. rtos那行，2 3两个值是rtos的参数，所以位置错了，要移到里面一个括号里。
2. 还是那行，前面的setq没结束，又setq了，格式不对。
3. dimzin设为0，个人感觉对于正常的绘图来说不合适，所以最好还是做恢复处理。
建议如下：
最开始的dimzin设置删掉，然后把setq newtx那行删掉，在下面的entmod前面把我上面的那4行代码复制过来，然后改一下2 3的位置，应该就可以了。

lostbalance

因为有dimzin的相关操作，新家的代码就不要和原来的setq放一起了。

lostbalance

另外，你这函数没有错误恢复处理，dimzin值在出错的时候可能会无法恢复，所以调整和恢复之间的其他代码越少越好，虽然效率低了点，但处理量不大的情况下，也没什么感觉。

szx025

谢谢 问题解决了，非常谢谢

szx025

lostbalance 发表于 2018-6-16 23:43
好像网络问题，前两天发的没成功啊……
手机上的，简单说下吧……
1. rtos那行，2 3两个值是rtos的参数 ...

这样改对纯数字没有问题，但带字母数字，比如"TB-1"这样的数字，运行后前面的字母就没有了，要想保留原程序的功能这个(defun Plus1 (str buchang / d1 d2 h)还是要保留，在这个基础上，怎么完善，还请指导

lostbalance

szx025 发表于 2018-6-19 09:35
这样改对纯数字没有问题，但带字母数字，比如"TB-1"这样的数字，运行后前面的字母就没有了，要想保留原程 ...

。。。。。。要求要说清楚啊。。。。
如果只是后面补零，在plus1里，对d2参照newtx进行修改
(setq d2 (vl-princ-to-string (+ (read d1) buchang)))
  (while (< (strlen d2) (strlen d1))
  (setq d2 (strcat  d2 "0" ))
   ; (setq d2 (strcat "0" d2))
  )
上面的删掉，改成
(setq odimzin (getvar "dimzin")) ;;取得原来dimzin
(setvar "dimzin" 0) ;;设置dimzin为0
(setq d2 (rtos (+ (read d1) buchang) 2 3))
(setvar "dimzin" odimzin) ;;恢复dimzin
如果前面要补零，那把原来的那个while加到后面

szx025

lostbalance 发表于 2018-6-19 10:49
。。。。。。要求要说清楚啊。。。。
如果只是后面补零，在plus1里，对d2参照newtx进行修改
(setq d2 ( ...

这里还有一个问题，按你这样改所有数字都是保留小数点3位。但我的要求是，如果原来的数是整数，没有小数点，程序运行后还是整数，如果原是小数，程序运行后保留小数点3位。

lostbalance

szx025 发表于 2018-6-19 13:54
这里还有一个问题，按你这样改所有数字都是保留小数点3位。但我的要求是，如果原来的数是整数，没有小数 ...

加一个判断啊
(setq d2 (+ (read d1) buchang))
(if (= d2 (fix d2)) ;;判断d2是不是整数
    (setq d2 (itoa d2)) ;;转字符串
    (progn
        (setq odimzin (getvar "dimzin")) ;;取得原来dimzin
        (setvar "dimzin" 0) ;;设置dimzin为0
        (setq d2 (rtos d2 2 3)) ;;转字符串
        (setvar "dimzin" odimzin) ;;恢复dimzin
    )
)