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

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 (strcatd2 "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 "")
      (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-15 15:09:02

呼叫 lostbalance

lostbalance 发表于 2018-6-16 23:43:28

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 发表于 2018-6-16 23:44:46

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

lostbalance 发表于 2018-6-16 23:48:51

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

szx025 发表于 2018-6-17 09:05:05

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

szx025 发表于 2018-6-19 09:35:00

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

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

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

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 (strcatd2 "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 发表于 2018-6-19 13:54:38

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

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

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

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
    )
)
页: 1 [2] 3
查看完整版本: 文字加减复制的lisp程序