递增复制--多对象同时递增复制

czb203

很好用，谢谢

wu0er

太感谢楼主了。

雨的节奏

才发现这个帖子好几年了

注册

江南十笑 发表于 2019-12-16 21:52
确实 有这个BUG   有没有大神修复一下

;;; 拷贝数字 数字自动增加程序
;;;原代码参 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")

菜鸟初来乍到

感谢楼主分享