文字加减复制的lisp程序

szx025 · 发表于 2018-6-9 10:10

下面的程序是网上下载的一个文字加减复制的lisp程序，3.222这个数，加2.3运行后，结果是5.522，但如果是3.220这样后面有0的数，运行后的结果是05.52，如果是3.200，结果就会是005.5，我想要的结果是0放小数点后面，有高手能改改这个程序吗

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

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

szx025 · 发表于 2018-6-14 08:37

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

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

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

lostbalance · 发表于 2018-6-19 10:49

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加到后面

lostbalance · 发表于 2018-6-20 09:02

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
)
)

lostbalance · 发表于 2018-6-9 15:10

没细看，按下面改试试
(while (< (strlen d2) (strlen d1))
(setq d2 (strcat "0" d2))
)
中第二条改为
(setq d2 (strcat d2 "0"))

szx025 · 发表于 2018-6-9 16:56

lostbalance 发表于 2018-6-9 15:10
没细看，按下面改试试
(while (< (strlen d2) (strlen d1))
(setq d2 (strcat "0" d2))

谢谢，可以了

waly008 · 发表于 2018-6-9 21:12

@lostbalance 谢谢！我的也可以了。

szx025 · 发表于 2018-6-11 08:24

好像还有点问题，3.222这个数，加2.3运行后，结果是5.522，但3.200加2.3连续运行后,5.500 7.800都没有问题，但到了10.100出现问题了，变成了10.10.而不是我想要的10.100

lostbalance · 发表于 2018-6-12 09:16

szx025 发表于 2018-6-11 08:24
好像还有点问题，3.222这个数，加2.3运行后，结果是5.522，但3.200加2.3连续运行后,5.500 7.800都没有问题 ...

如果只是要保留和的三位小数的话，没必要整的台麻烦啊。。。。
上面的NEWTX用
(setq NEWTX (rtos (+ (atof E-1) BUCHANG1)) 2 3)
就可以
如果结果的小数长度有问题，可能是系统变量dimzin的关系，在前面加个(setvar "dimzin" 8)

szx025 · 发表于 2018-6-12 14:27

lostbalance 发表于 2018-6-12 09:16
如果只是要保留和的三位小数的话，没必要整的台麻烦啊。。。。
上面的NEWTX用
(setq NEWTX (rtos (+ (a ...

按你的改了，但小数点还是两位

lostbalance · 发表于 2018-6-13 08:57

szx025 发表于 2018-6-12 14:27
按你的改了，但小数点还是两位

上面提到dimzin参数搞错了，为0的时候才可以
用下面这段
(setq odimzin (getvar "dimzin")) ;;取得原来dimzin
(setvar "dimzin" 0) ;;设置dimzin为0
(setq NEWTX (rtos (+ (atof E-1) BUCHANG1)) 2 3)
(setvar "dimzin" odimzin) ;;恢复dimzin

szx025 · 发表于 2018-6-13 11:28

lostbalance 发表于 2018-6-13 08:57
上面提到dimzin参数搞错了，为0的时候才可以
用下面这段
(setq odimzin (getvar "dimzin")) ;;取得原来 ...

dimzin 为0，还是不行，问题依旧

lostbalance · 发表于 2018-6-13 19:41

szx025 发表于 2018-6-13 11:28
dimzin 为0，还是不行，问题依旧

你把程序再发一遍看看

账号		自动登录	找回密码
密码			注册

[源码] 文字加减复制的lisp程序