文字末尾的数字递增复制-优化版

NetBee · 发表于 2013-4-4 18:05:23

本帖最后由 NetBee 于 2013-4-7 17:18 编辑

原帖见wowan1314的
http://bbs.mjtd.com/forum.php?mod=viewthread&tid=92879
优化了一下，但还是仅支持尾数。
见有些网友发布的支持中间数字递增，有些的能字母递增。
精力有限，也希望大家共同来优化完善。

;;; 拷贝数字数字自动增加程序
;;;原代码参 wowan1314
;;;1.1 修改 by netbee 2013.04.05
;;;1.2 修改 by netbee 2013.04.05
;;;可以包含其他对象，如圆中数字。
;;;1.3 修改 by netbee 2013.04.06
;;;修复DIMZIN变量影响。
;;;可再次优化为中间数字递增，字母递增等
;;
(defun c:NBTC_TXTCopyadd (/ fun_setini fun_close fun_error FUN_GETdigit old_error old_DIMZIN ureal last_ent
Plus1 String_To_Numbers buchang1 $buchang SS SS1 e0 ent
PT i loop ENTL E-1 NEWTX ENT_TMP
)
(defun fun_setini ()
(setq old_error *error*
old_DIMZIN(getvar "DIMZIN")
*error* fun_error
)
(or NBTV_TXT_CopyADD (setq NBTV_TXT_CopyADD 1.0))
(setvar "cmdecho" 0)
(setvar "DIMZIN" 0)
(vl-cmdf "_.undo" "be")
)
(defun fun_error (msg) (princ msg) (fun_close))
(defun fun_close () (vl-cmdf "_.undo" "e") (setvar "DIMZIN" old_DIMZIN)(setvar "cmdecho" 1) (setq *error* old_error))
(defun ureal (bit kwd msg def / inp)
(if def
(setq msg (strcat "\n" msg "<" (rtos def 2) ">: ")
bit (* 2 (fix (/ bit 2)))
)
(setq msg (strcat "\n" msg ": "))
)
(initget bit kwd)
(setq inp (getreal msg))
(if inp
inp
def
)
)
(defun String_To_Numbers (inStr
;;Input string
/ Flush_Buf Res
;;Result list
Buf
;;String buffer
Inx
;;Character location
CH
;;Character
) (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
)
(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 FUN_GETdigit (sNum)
(IF (vl-string-search "." sNum)
(STRLEN (substr sNum (+ 2 (vl-string-search "." sNum))))
0
)
)
(defun Plus1 (str buchang / d1 d2 h num1 num2)
(setq str (vl-string-translate "-" (chr 1) str))
(or (setq d1 (last (string_to_numbers str))) (setq d1 "0"))
(setq h (vl-string-right-trim d1 str))
(setq num1 (FUN_GETdigit d1))
(setq d2 (vl-string-right-trim "." (vl-string-right-trim "0" (RTOS (+ (read d1) buchang) 2 12))))
(setq num2 (FUN_GETdigit d2))
(if (and (= num2 0) (> num1 0))
(setq d2 (strcat d2 "."))
)
(repeat (- num1 num2) (setq d2 (strcat d2 "0")))
;;(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))
)
(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
)
;;-------------
(fun_setini)
(if (setq $buchang (ureal 1 "" "\n增减值(正为增,负为减)" NBTV_TXT_CopyADD))
(setq NBTV_TXT_CopyADD $buchang)
)
(setq ss (ssget ))
(setq e0 (entlast))
(setq pt (getpoint "指定基点:"))
(command "copy" ss "" pt pause)
(setq loop T)
(if (= 0 (distance (setq Point (getvar "LastPoint")) pt)) ;判断最后一点是不是pt点.
(progn (setq loop nil) ;Right Button
(setq ent_tmp (LAST_ENT e0)) ;ent_tmp 是e0后生成的物体.
(command "_.erase" ent_tmp "")
)
(setq pt Point)
)
(while loop
(SETQ SS1 (last_ent E0)
I 0
)
(repeat (sslength ss1)
(setq ent (ssname ss1 i)
i (1+ i)
entl (entget ent)
) ;图元资料
(if (wcmatch (cdr (assoc 0 entl)) "*TEXT")
(progn (setq e-1 (cdr (assoc 1 entl))
;;文字内容
NEWTX (Plus1 E-1 NBTV_TXT_CopyADD)
)
(entmod (subst (cons 1 NEWTX) (assoc 1 entl) entl)) ;更新文字
)
)
) ;end repeat
(setq e0 (entlast))
(command "copy" ss1 "" 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 "")
)
(progn (setq pt Point)
;;(setq ss (LAST_ENT e0))
)
)
)
(fun_close)
(princ)
)
(princ "复制文字增加数字 NBTC_TXTCopyadd")

;;; 拷贝数字 数字自动增加程序 
;;;原代码参 wowan1314 
;;;1.1 修改 by netbee 2013.04.05 
;;;1.2 修改 by netbee 2013.04.05 
;;;可以包含其他对象，如圆中数字。 
;;;1.3 修改 by netbee 2013.04.06 
;;;修复DIMZIN变量影响。 
 
;;;可再次优化为中间数字递增，字母递增等 
;; 
(defun c:NBTC_TXTCopyadd (/             fun_setini        fun_close  fun_error  FUN_GETdigit            old_error old_DIMZIN ureal          last_ent 
                          Plus1             String_To_Numbers           buchang1   $buchang         SS            SS1               e0          ent 
                          PT             i                loop           ENTL              E-1         NEWTX            ENT_TMP 
                         ) 
  (defun fun_setini () 
    (setq old_error *error* 
          old_DIMZIN(getvar "DIMZIN") 
          *error* fun_error 
    ) 
    (or NBTV_TXT_CopyADD (setq NBTV_TXT_CopyADD 1.0)) 
    (setvar "cmdecho" 0) 
    (setvar "DIMZIN" 0) 
    (vl-cmdf "_.undo" "be") 
  ) 
  (defun fun_error (msg) (princ msg) (fun_close)) 
  (defun fun_close () (vl-cmdf "_.undo" "e") (setvar "DIMZIN" old_DIMZIN)(setvar "cmdecho" 1) (setq *error* old_error)) 
  (defun ureal (bit kwd msg def / inp) 
    (if        def 
      (setq msg        (strcat "\n" msg "<" (rtos def 2) ">: ") 
            bit        (* 2 (fix (/ bit 2))) 
      ) 
      (setq msg (strcat "\n" msg ": ")) 
    ) 
    (initget bit kwd) 
    (setq inp (getreal msg)) 
    (if        inp 
      inp 
      def 
    ) 
  ) 
  (defun String_To_Numbers (inStr 
                            ;;Input string 
                            / Flush_Buf        Res 
                            ;;Result list 
                            Buf 
                            ;;String buffer 
                            Inx 
                            ;;Character location 
                            CH 
                            ;;Character 
)   (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 
    ) 
    (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 FUN_GETdigit (sNum) 
    (IF        (vl-string-search "." sNum) 
      (STRLEN (substr sNum (+ 2 (vl-string-search "." sNum)))) 
      0 
    ) 
  ) 
  (defun Plus1 (str buchang / d1 d2 h num1 num2) 
    (setq str (vl-string-translate "-" (chr 1) str)) 
    (or (setq d1 (last (string_to_numbers str))) (setq d1 "0")) 
    (setq h (vl-string-right-trim d1 str)) 
    (setq num1 (FUN_GETdigit d1)) 
    (setq d2 (vl-string-right-trim "." (vl-string-right-trim "0" (RTOS (+ (read d1) buchang) 2 12)))) 
    (setq num2 (FUN_GETdigit d2)) 
    (if        (and (= num2 0) (> num1 0)) 
      (setq d2 (strcat d2 ".")) 
    ) 
    (repeat (- num1 num2) (setq d2 (strcat d2 "0"))) 
    ;;(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)) 
  ) 
  (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 
  ) 
  ;;------------- 
  (fun_setini) 
  (if (setq $buchang (ureal 1 "" "\n增减值(正为增,负为减)" NBTV_TXT_CopyADD)) 
    (setq NBTV_TXT_CopyADD $buchang) 
  ) 
  (setq ss (ssget )) 
  (setq e0 (entlast)) 
  (setq pt (getpoint "指定基点:")) 
  (command "copy" ss "" pt pause) 
  (setq loop T) 
  (if (= 0 (distance (setq Point (getvar "LastPoint")) pt)) ;判断最后一点是不是pt点. 
    (progn (setq loop nil)                ;Right Button 
           (setq ent_tmp (LAST_ENT e0))        ;ent_tmp 是e0后生成的物体. 
           (command "_.erase" ent_tmp "") 
    ) 
    (setq pt Point) 
  ) 
  (while loop 
    (SETQ SS1 (last_ent E0) 
          I   0 
    ) 
    (repeat (sslength ss1) 
      (setq ent         (ssname ss1 i) 
            i         (1+ i) 
            entl (entget ent) 
      )                                        ;图元资料 
      (if (wcmatch (cdr (assoc 0 entl)) "*TEXT") 
        (progn (setq e-1   (cdr (assoc 1 entl)) 
                     ;;文字内容 
                     NEWTX (Plus1 E-1 NBTV_TXT_CopyADD) 
               ) 
               (entmod (subst (cons 1 NEWTX) (assoc 1 entl) entl)) ;更新文字 
        ) 
      ) 
    )                                        ;end repeat   
    (setq e0 (entlast)) 
    (command "copy" ss1 "" 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 "") 
      ) 
      (progn (setq pt Point) 
             ;;(setq ss (LAST_ENT e0)) 
      ) 
    ) 
  ) 
  (fun_close) 
  (princ) 
) 
 
(princ "复制文字增加数字 NBTC_TXTCopyadd")

该贴已经同步到 NetBee的微博

没有昵称呀 · 发表于 2022-10-5 18:44:25

本帖最后由没有昵称呀于 2022-10-5 18:49 编辑

NetBee 发表于 2013-4-7 17:20
已经修复，原来是dimzin搞的鬼。说明：不支持负数的，“-”是看成字符横杠的。

我也遇到这样的问题了

ph1123 · 发表于 2022-3-25 11:32:20

很好的插件，已下载，试了论坛了很多数字递增的这个是最靠谱的

没有昵称呀 · 发表于 2022-10-5 20:28:20

如果能支持阵列递增就好了

kwok · 发表于 2013-4-4 19:28:04

本帖最后由 kwok 于 2013-4-4 19:28 编辑

支持楼主,连字母也优化上吧,一般很少有增中间的吧.

NetBee · 发表于 2013-4-5 23:34:41

这次应该能用很长时间了吧。

wowan1314 · 发表于 2013-4-6 00:14:11

呵呵！论坛有个程序…好像叫点哪个加哪个吧！如果不确定要递增的是什么位置！可用那个程序！具体没测试！应该是不错的！有兴趣的可以找找看看

长风（尚品） · 发表于 2013-4-6 16:42:38

递增末尾数字会出错，如p29，p30这里p30会变为p03，诸如此类，望楼主修改下

CTC · 发表于 2013-4-6 23:12:14

试了，也是上楼说的情况

NetBee · 发表于 2013-4-6 23:37:14

什么情况，怎么我的没有
cad是哪个版本？

love12314 · 发表于 2013-4-7 08:53:46

试下了，1-1.递增到10的话就又变回1-1了。负数的话，-0.-1.--0.--1.---0.---1就这情况

NetBee · 发表于 2013-4-7 17:20:24

本帖最后由 NetBee 于 2013-4-7 17:34 编辑

已经修复，原来是dimzin搞的鬼。说明：不支持负数的，“-”是看成字符横杠的。

yx5277 · 发表于 2013-4-14 15:51:04

楼主程序如有中文字符就会出现“警告: 忽略展开未知异常”，

请问能否改为支持中文字符，如“房间L1”“房间L2”等？

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

文字末尾的数字递增复制-优化版

本帖子中包含更多资源

评分

本帖被以下淘专辑推荐:

相关帖子