copy block increase the number inside the text

[Anonymous]

Hi, I want to copy block and increase the number inside, ex : DB-LP-B4/L1 to DB-LP-B4/L2, DB-LP-B4/L3....I  tried lisp cpi but it didn't work.

Please help me write a lisp.

[Kent1Cooper]

A Search will probably lead to something already available.  I'm not sure it's exactly what you want, but look at, for example, this.

[Anonymous]

Thanks for sharing but it didn't work with me.
I also found the right one & share it to whom be needed.

orginial code type oca to copy but I change it to cc for my convenience.

;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/topic/34029-can-lisp-danh-so-thu-tu-theo-dang-block-att/
;; free lisp from cadviet.com

;;;**********************************************
;;;CHUONG TRINH DANH SO THU TU VA COPY TANG DAN
;;;1. Lenh OD: danh so thu tu, tuy chon so bat dau (begin) va so gia (increment) tuy y
;;;2. Lenh OC: copy tang dan tu mot so thu tu co san
;;;3. Lenh oCA: copy tang dan voi doi tuong Attribute Block
;;;Chuong trinh chap nhan cac dinh dang bang so, chu, so va chu ket hop:
;;;1, 2... A, B..., A1, A2..., AB-01, AB-02..., AB-01-C1, AB-01-C2...
;;;Cac chu gioi han trong khoang tu A den Z. Cac so khong han che
;;;Copyright by ssg - www.cadviet.com - December 2008
;;;**********************************************


;;;-------------------------------------------------
(defun etype (e) ;;;Entity Type
(cdr (assoc 0 (entget e)))
)
;;;-------------------------------------------------
(defun wtxt (txt p / sty d h) ;;;Write txt on graphic screen, defaul setting
(setq
    sty (getvar "textstyle")
    d (tblsearch "style" sty)
    h (cdr (assoc 40 d))
)
(if (= h 0) (setq h (cdr (assoc 42 d))))
(entmake
    (list (cons 0 "TEXT") (cons 7 sty) (cons 1 txt) (cons 10 p) (cons 40 h) (assoc 41 d))
)
)
;;;-------------------------------------------------
(defun incN (n dn / n2 i n1) ;;;Increase number n
(setq
    n2 (itoa (+ dn (atoi n)))
    i (- (strlen n) (strlen n2))
)
(if (> i 0) (setq n1 (substr n 1 i)) (setq n1 ""))
(strcat n1 n2)
)
;;;-------------------------------------------------
(defun incC (c / i c1 c2) ;;;Increase character c
(setq
    i (strlen c)
    c1 (substr c 1 (- i 1))
    c2 (chr (1+ (ascii (substr c i 1))))
)
(if (or (= c2 "{") (= c2 "["))
    (progn (command "erase" (entlast) "") (alert "Over character!") (exit))
    (strcat c1 c2)
)
)
;;;============================
(defun C:OD( / cn dn c n p) ;;;Make OrDinal number with any format
(setq
    cn (getstring "\nBegin at <1>: " T)
    dn (getint "\nIncrement <1>: ")
)
(if (not dn) (setq dn 1))
(if (= cn "") (setq cn "1"))
(setq c (vl-string-right-trim "0 1 2 3 4 5 6 7 8 9" cn))
(setq n (vl-string-subst "" c cn))
(if (/= n "") (setq mode 1) (setq mode 0))
(while (setq p (getpoint "\nBase point <exit>: "))
    (wtxt cn p)
    (if (= n "") 
        (setq cn (incC cn))
        (setq cn (strcat c (incN (vl-string-subst "" c cn) dn)))        
    )
)
(princ)
)
;;;============================
(defun C:OC( / e dn p1 cn c n p2 dat) ;;;Make Ordinal number. Copy from template
(setq
    e (car (entsel "\nSelect template text:"))
    dn (getint "\nIncrement <1>: ")
    p1 (getpoint "\nBase point:")
    cn (cdr (assoc 1 (entget e)))
)
(if (not dn) (setq dn 1))
(if (= cn "") (setq cn "1"))
(setq
    c (vl-string-right-trim "0 1 2 3 4 5 6 7 8 9" cn)
    n (vl-string-subst "" c cn)
)
(while (setq p2 (getpoint p1 "\nNew point <exit>: "))
    (command "copy" e "" p1 p2)
    (if (= n "") 
        (setq cn (incC cn))
        (setq cn (strcat c (incN (vl-string-subst "" c cn) dn)))        
    )
    (setq
        dat (entget (entlast))
        dat (subst (cons 1 cn) (assoc 1 dat) dat)
    )
    (entmod dat)    
)
(princ)
)
;;;============================
(defun C:cc( / e e0 dn p1 cn c n p2 dat) ;;;Make Ordinal number. Copy from Atttribute block
(setq
    e0 (car (entsel "\nSelect attribute block:"))
    e (entnext e0)
)
(if (/= (etype e) "ATTRIB") (progn (alert "Object is not a Attribute Block!") (exit)))
(setq
    dn (getint "\nIncrement <1>: ")
    p1 (getpoint "\nBase point:")
    cn (cdr (assoc 1 (entget e)))
)
(if (not dn) (setq dn 1))
(if (= cn "") (setq cn "1"))
(setq
    c (vl-string-right-trim "0 1 2 3 4 5 6 7 8 9" cn)
    n (vl-string-subst "" c cn)
)
(while (setq p2 (getpoint p1 "\nNew point <exit>: "))
    (command "copy" e0 "" p1 p2)
    (if (= n "") 
        (setq cn (incC cn))
        (setq cn (strcat c (incN (vl-string-subst "" c cn) dn)))        
    )
    (setq
        dat (entget (entnext (entlast)))
        dat (subst (cons 1 cn) (assoc 1 dat) dat)
    )
    (entmod dat)
    (command "regen")
)
(princ)
)
;;;============================

[Anonymous]

Hi HeroSy,

Here is something quick and dirty, hope this is what you are looking for:

(defun c:cpinc (/ atrib	    blname    block	i	  inspt
		  newblock  numb      rotation	xscale	  yscale
		  zscale
		 )

  
  (setq block (vlax-ename->vla-object (car (entsel))))
  (setq blname(vla-get-effectivename block)
	xscale (vla-get-XScaleFactor block)
	yscale (vla-get-yScaleFactor block)
	zscale (vla-get-zScaleFactor block)
	rotation (vla-get-rotation block)
	)

  (setq atrib (LM:vl-getattributevalue block "NAMEPLATE"))

  
  (setq numb (atoi(substr atrib 11)));change this if attribute length is different
  
  (setq i 1)
  (while
    (setq inspt (getpoint "\nBlock insertion point:"))
    (setq newblock
	   (vla-insertblock ((if (eq (getvar "cvport") 1)
			       vla-get-paperspace
			       vla-get-modelspace
			       ) 
			      (vla-get-ActiveDocument (vlax-get-acad-object))
			      )
	     (vlax-3d-point inspt)
	     blname
	     xscale
	     yscale
	     zscale
	     rotation
	     )
	  )
    (LM:vl-setattributevalue newblock "NAMEPLATE" 
                      (strcat (substr atrib 1 10);change if attribute length is different
                      (rtos (+ i numb) 2 0)))

    (setq i (1+ i))
    
    );end while

  )



;; Get Attribute Value  -  Lee Mac
;; Returns the value held by the specified tag within the supplied block, if present.
;; blk - [vla] VLA Block Reference Object
;; tag - [str] Attribute TagString
;; Returns: [str] Attribute value, else nil if tag is not found.

(defun LM:vl-getattributevalue ( blk tag )
    (setq tag (strcase tag))
    (vl-some '(lambda ( att ) (if (= tag (strcase (vla-get-tagstring att))) (vla-get-textstring att)))
        (vlax-invoke blk 'getattributes)
    )
)

;; Set Attribute Value  -  Lee Mac
;; Sets the value of the first attribute with the given tag found within the block, if present.
;; blk - [vla] VLA Block Reference Object
;; tag - [str] Attribute TagString
;; val - [str] Attribute Value
;; Returns: [str] Attribute value if successful, else nil.

(defun LM:vl-setattributevalue ( blk tag val )
    (setq tag (strcase tag))
    (vl-some
       '(lambda ( att )
            (if (= tag (strcase (vla-get-tagstring att)))
                (progn (vla-put-textstring att val) val)
            )
        )
        (vlax-invoke blk 'getattributes)
    )
)

 Note that this is going to work only if attribute value is as you described :DB-LP-B4/L1.

dicra