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

雨的节奏

1. (defun C:GGDZFZ (/ en pt1 ptnext eny ss ssx eno)
   
2.   (princ "\n选择要复制的文字")
   
3.   (setq ss (ssget '((0 . "*TEXT"))))
   
4.   (setq pt1 (getpoint "\n指定复制角点"))
   
5.   (setq ptnext (getpoint pt1 "\n指定插入点"))
   
6.   (while ptnext
   
7.             (setq eno (entlast) ssx (ssadd))
   
8.             (command ".copy" ss "" "m" pt1 ptnext "")
   
9.             (while (setq en (entnext eno)) (setq ssx (ssadd en ssx) eno en))
   
10.             (setq n 0)
    
11.             (repeat (sslength ssx)
    
12.                     (setq en (ssname ssx n))
    
13.                     (setq eny (ttg (vla-get-textstring (Vlax-Ename->Vla-Object en))))
    
14.                     (Vlax-Put-Property (Vlax-Ename->Vla-Object en) 'TextString eny)
    
15.                     (setq n (1+ n))
    
16.             );end repeat
    
17.             (setq ss ssx)
    
18.             (setq pt1 ptnext)
    
19.             (setq ptnext (getpoint pt1  "\n指定插入点"))
    
20.   )
    
21. (princ "\n**********完成操作************")
    
22. (prin1)
    
23. );end
    
24. (prin1)
    
25. 
    
26. 
    
27.                   
    
28. (defun ttg (txd / tth tthh )
    
29. (setq tth (ttm txd) tthh (rtos (1+ tth) 2 0))
    
30. (setq regex (vlax-create-object "Vbscript.RegExp")) ;引用正则表达式控件
    
31. (vlax-put-property regex "IgnoreCase" 0) ;不忽略大小写
    
32. (vlax-put-property regex "Global" 1) ;匹配方式，全文字匹配
    
33. (vlax-put-property regex "Multiline" 1) ;多行模式
    
34. txd
    
35.   (vlax-put-property regex "Pattern" "[0-9]+(?=[^0-9]*$)")
    
36.   (setq enX (vlax-invoke-method  regex "Replace" txd tthh))
    
37. (vlax-release-object regex)
    
38. enx
    
39. )
    
40. (prin1)
    
41. 
    
42. 
    
43. ;取得文字
    
44. (defun ttq (x / )
    
45. (setq xs (vla-get-TextString (vlax-ename->vla-object x)))
    
46. )
    
47. (prin1)
    
48. 
    
49. ;提取出字符串中的数字，是直接从字串里面得到数值
    
50. (defun ttm (en / regex S tmp str1)
    
51. (setq regex (vlax-create-object "Vbscript.RegExp")) ;引用正则表达式控件
    
52. (vlax-put-property regex "IgnoreCase" 0) ;不忽略大小写
    
53. (vlax-put-property regex "Global" 1) ;匹配方式，全文字匹配
    
54. (vlax-put-property regex "Multiline" 1) ;多行模式
    
55. (vlax-put-property regex "Pattern" "[0-9]+(?=[^0-9]*$)")
    
56. (setq s (vlax-invoke-method regex "Execute" en))
    
57.   ;;将规则运用到STR字符，得到提取出的文字内容
    
58.   (setq ent (VLAX-FOR tmp s (vlax-get-property tmp "value")))
    
59.   (vlax-release-object regex)
    
60.   (setq ent (atoi ent))
    
61.   ent
    
62. )
    
63. (prin1)
    

(defun C:GGDZFZ (/ en pt1 ptnext eny ss ssx eno)<br />   (princ "\n选择要复制的文字")<br />   (setq ss (ssget '((0 . "*TEXT"))))<br />   (setq pt1 (getpoint "\n指定复制角点"))<br />   (setq ptnext (getpoint pt1 "\n指定插入点"))<br />   (while ptnext<br />             (setq eno (entlast) ssx (ssadd))<br />             (command ".copy" ss "" "m" pt1 ptnext "")<br />             (while (setq en (entnext eno)) (setq ssx (ssadd en ssx) eno en))<br />             (setq n 0)<br />             (repeat (sslength ssx)<br />                     (setq en (ssname ssx n))<br />                     (setq eny (ttg (vla-get-textstring (Vlax-Ename->Vla-Object en))))<br />                     (Vlax-Put-Property (Vlax-Ename->Vla-Object en) 'TextString eny)<br />                     (setq n (1+ n))<br />             );end repeat<br />             (setq ss ssx)<br />             (setq pt1 ptnext)<br />             (setq ptnext (getpoint pt1  "\n指定插入点"))<br />   )<br /> (princ "\n**********完成操作************")<br /> (prin1)<br /> );end<br /> (prin1)<br /> <br /> <br />                    <br /> (defun ttg (txd / tth tthh )<br /> (setq tth (ttm txd) tthh (rtos (1+ tth) 2 0))<br /> (setq regex (vlax-create-object "Vbscript.RegExp")) ;引用正则表达式控件<br /> (vlax-put-property regex "IgnoreCase" 0) ;不忽略大小写<br /> (vlax-put-property regex "Global" 1) ;匹配方式，全文字匹配<br /> (vlax-put-property regex "Multiline" 1) ;多行模式<br /> txd<br />   (vlax-put-property regex "Pattern" "[0-9]+(?=[^0-9]*$)")<br />   (setq enX (vlax-invoke-method  regex "Replace" txd tthh))<br /> (vlax-release-object regex)<br /> enx<br /> )<br /> (prin1)<br /> <br /> <br /> ;取得文字<br /> (defun ttq (x / )<br /> (setq xs (vla-get-TextString (vlax-ename->vla-object x)))<br /> )<br /> (prin1)<br /> <br /> ;提取出字符串中的数字，是直接从字串里面得到数值<br /> (defun ttm (en / regex S tmp str1)<br /> (setq regex (vlax-create-object "Vbscript.RegExp")) ;引用正则表达式控件<br /> (vlax-put-property regex "IgnoreCase" 0) ;不忽略大小写<br /> (vlax-put-property regex "Global" 1) ;匹配方式，全文字匹配<br /> (vlax-put-property regex "Multiline" 1) ;多行模式<br /> (vlax-put-property regex "Pattern" "[0-9]+(?=[^0-9]*$)")<br /> (setq s (vlax-invoke-method regex "Execute" en))<br />   ;;将规则运用到STR字符，得到提取出的文字内容<br />   (setq ent (VLAX-FOR tmp s (vlax-get-property tmp "value")))<br />   (vlax-release-object regex)<br />   (setq ent (atoi ent))<br />   ent<br /> )<br /> (prin1)<br />

愿意赞助一下的话就用币买
没有币的就直接复制吧

sunny_8848

谢谢楼主分享，要是能直接指定间距复制多少个就更好了

注册

江南十笑 发表于 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")

江南十笑

注册 发表于 2019-10-8 14:13
感谢，存在小bug，若数字带0，比如js-01，递增后变成js-2
，非js-02

确实 有这个BUG   有没有大神修复一下

xfjiamy

这个很有用   谢谢分享

evayleung

谢谢分享，支持源码，

sdbaijiao

谢谢楼主的分享。。

依然小小鸟

能支持字母和罗马数字就更好了

注册

感谢，存在小bug，若数字带0，比如js-01，递增后变成js-2
，非js-02

mikewolf2k

建议让用户选择递增数值，默认为元素个数或者1。检查3.9的后一个是4.0还是3.10。以及楼上提到的前后缀0的问题。

海盗曹

MARK一下，学习一下

mpk023

这个很适用，谢谢分享~~~~