Increment value Lisp needed (with frames)

I have this old code that from Paul Mcz that also does real integers as well as alphabets, counting up or down. It's pretty neat.

numbering.lsp

VVA has exactly what I need to help me with a job. The only thing missing that would complete the code would be able to add a block around the number being set out. Is there a way this can be done?

This is my block. I need the middle attribute to do what VVA's "num" command does.

Point block.dwg

Analogue of a command "NUM" for work with the block look ASMI's "Apnum"

Other version Apnum with alignment (add 0 before number) of number

;;; Numbering of the block with unique attribute with alignment (add 0 before number) of number
(defun c:apnumA (/ oldStart oldPref oldSuf oldEcho
       oldSize oldBlock temBl *error* att)
;;ApnumAlign
 
 (defun *error* (msg) 
   (setvar "CMDECHO" oldEcho) 
(setvar "ATTDIA" att)
   (princ) 
   ); end *error* 
 (if(not apnum:Size)(setq apnum:Size 1.0)) 
 (if(not apnum:Num)(setq apnum:Num 1))
 (if(not apnum:Alig)(setq apnum:Alig "1"))
 (if(not apnum:Pref)(setq apnum:Pref "")) 
 (if(not apnum:Suf)(setq apnum:Suf "")) 
 (setq  oldStart apnum:Num 
  oldSize apnum:Size
  oldPref apnum:Pref 
  oldSuf apnum:Suf 
  oldEcho(getvar "CMDECHO") 
  att (getvar "ATTDIA")
  ); end setq 
 (setvar "ATTDIA" 0)(setvar "ATTREQ" 1)
 (setvar "CMDECHO" 0)
   (setq apnum:Pref 
   (getstring T
     (strcat "\nType prefix:(If you want to delete prefix type ' ' (press SPACE key on keyboard) <"apnum:Pref"> :")))
 (if(= "" apnum:Pref)(setq apnum:Pref oldPref)) 
 (if(= " " apnum:Pref)(setq apnum:Pref "")) 
 (setq apnum:Suf 
   (getstring T
      (strcat "\nType suffix:(If you want to delete prefix type ' ' (press SPACE key on keyboard) <"apnum:Suf"> :")))
 (if(= "" apnum:Suf)(setq apnum:Suf oldSuf)) 
 (if(= " " apnum:Suf)(setq apnum:Suf "")) 
 (setq apnum:Num 
   (getint 
     (strcat "\nSpecify start number <"(itoa apnum:Num)">: "))) 
 (if(null apnum:Num)(setq apnum:Num oldStart))
  (setq  oldStart apnum:Alig)
 (initget "1 10 100 1000 10000 100000")
 (setq apnum:Alig 
   (GETKWORD 
     (strcat "\nSpecify alignment of number [1/10/100/1000/10000/100000] <"apnum:Alig">: ")))
 (if(null apnum:Alig)(setq apnum:Alig oldStart))
   (setq apnum:Size 
   (getreal 
     (strcat "\nSpecify block scale <"(rtos apnum:Size)">: "))) 
 (if(null apnum:Size)(setq apnum:Size oldSize))
 (if apnum:Block(setq oldBlock apnum:Block))
 (setq temBl
    (entsel(strcat "\nSelect block <"
        (if apnum:Block apnum:Block "not difined") "> > "))); end setq
 (cond
   ((and apnum:Block(not temBl)(tblsearch "BLOCK" apnum:Block))
   (setq apnum:Block oldBlock)
    ); end condition #1
   ((= 1 (cdr(assoc 66(entget(car temBl)))))
   (setq apnum:Block(cdr(assoc 2(entget(car temBl)))))
   ); end condition #2
   (t
    (princ "\nBlock not contains attribute! ")
    (setq apnum:Block nil)
    ); end condition #3
   ); end cond
 (if apnum:Block
   (progn
     (princ "\n>>> Pick insertion point or press Esc to quit <<<\n ")
(while T
 (setq temBl (itoa apnum:Num))
 (while (< (strlen temBl)(1- (strlen apnum:Alig)))
   (setq temBl (strcat "0" temBl)))
 (command "_-insert" apnum:Block "_s" apnum:Size pause "0"
      (strcat apnum:Pref
       temBl
       apnum:Suf)); end command
   (setq apnum:Num (1+ apnum:Num)) 
 ); end while
); end progn
   ); end if
 (setvar "ATTDIA" att)
 (princ) 
 )

VVA, YOU ABSOLUTELY ROCK!!!! Thank you so much. This will definately help me make the boss happy. Again thank you.

The variant if the block has some attributes

(defun c:binc (/ oldStart oldPref oldSuf oldEcho oldInc
       oldSize oldBlock temBl *error* att attr apnum:tag pt )

;==== Local functions ============
 (vl-load-com)
 (defun *error* (msg)(setvar "CMDECHO" oldEcho)(setvar "ATTDIA" att)(setvar "ATTREQ" attr)(princ)); end *error*
 (defun mydcl (zagl info-list / fl ret dcl_id)
   (if (null zagl)(setq zagl "Select")) ;_ end of if
   (setq fl (vl-filename-mktemp "mip" nil ".dcl"))
   (setq ret (open fl "w"))
   (mapcar '(lambda (x) (write-line x ret))
           (list "mip_msg : dialog { "
                 (strcat "label=\"" zagl "\";")
                 " :list_box {"
                 "alignment=top ;"
                 "width=51 ;"
                 (if (> (length info-list) 26)
                     "height= 26 ;"
                     (strcat "height= " (itoa (+ 3 (length info-list))) ";")
                 ) ;_ end of if
                 "is_tab_stop = false ;"
                 "key = \"info\";}"
                 "ok_cancel;}"
           ) ;_ end of list
   ) ;_ end of mapcar
   (setq ret (close ret))
   (if (and (not(minusp(setq dcl_id (load_dialog fl))))
     (new_dialog "mip_msg" dcl_id))
           (progn
               (start_list "info")(mapcar 'add_list info-list)
               (end_list)(set_tile "info" "0")
               (setq ret (car info-list))
               (action_tile "info" "(setq ret (nth (atoi $value) info-list))")
               (action_tile "cancel" "(progn(setq ret nil)(done_dialog 0))")
               (action_tile "accept" "(done_dialog 1)")(start_dialog)
           ) ;_ end of progn
   ) ;_ end of if
   (unload_dialog dcl_id)(vl-file-delete fl) ret) ;_ end of defun
 (defun mip-conv-to-str (dat)
 (cond ((= (type dat) 'INT)(setq dat (itoa dat)))
        ((= (type dat) 'REAL)(setq dat (rtos dat 2 12)))
       ((null dat)(setq dat ""))
       (t (setq dat (vl-princ-to-string dat)))))
;; obj - Ename or Vla object of block
;; att_list - list ((Tag_Name1 . Value1)(Tag_Name2 . Value2) ...)
;;                 Tag_Name - string
;;                    Value - string
(defun mip-block-setattr-bylist (obj att_list / txt lst)
(if (= (type obj) 'ENAME)(setq obj (vlax-ename->vla-object obj)))
(setq att_list (mapcar '(lambda(x)(cons (strcase (mip-conv-to-str(car x)))(mip-conv-to-str(cdr x)))) att_list))
 (if (and obj
          (not(vlax-erased-p obj))
          (= (vla-get-ObjectName obj) "AcDbBlockReference")
   (eq :vlax-true (vla-get-HasAttributes obj))
   (vlax-property-available-p obj 'Hasattributes)
   (vlax-write-enabled-p obj)
     )
   (vl-catch-all-apply
     (function
(lambda ()
         (foreach at (vlax-invoke obj 'Getattributes)
           (if (setq lst (assoc(strcase(vla-get-TagString at)) att_list))
             (vla-put-TextString at (cdr lst))
           )
           )
         )
       )
     )
   )
 )
 (defun get-all-atts (obj)
 (if (and obj
   (and (= (type obj) 'ENAME)
 (setq obj (vlax-ename->vla-object obj)))
          (vlax-property-available-p obj 'Hasattributes)
   (eq :vlax-true (vla-get-HasAttributes obj))
     )
   (vl-catch-all-apply
     (function
(lambda ()
  (mapcar (function (lambda (x)
        (cons (vla-get-TagString x)
       (vla-get-TextString x)
        )
      )
   )
   (append (vlax-invoke obj 'Getattributes)
    (vlax-invoke obj 'Getconstantattributes)
   )
  )
)
     )
   )
 )
)
(defun rec-pat (str temp)
 (cond
   ((= str "")(if (/= temp "")(list temp)))
   ((wcmatch (substr str 1 1) "[1234567890.]")
    (rec-pat (substr str 2) (strcat temp (substr str 1 1)))
   )
   (t (if (/= temp "")
       (cons temp (rec-pat str ""))
       (rec-pat (substr str 2) "")
      ) ;_ end of if
   )
 ) ;_ end of cond
) ;_ end of defun
 
;==== Local functions END ============
 
 (if(not apnum:Size)(setq apnum:Size 1.0))
 (if(not apnum:Num)(setq apnum:Num 1))
 (if(not apnum:Inc)(setq apnum:Inc 1))
 (if(not apnum:Pref)(setq apnum:Pref ""))
 (if(not apnum:Suf)(setq apnum:Suf ""))
 (setq  oldStart apnum:Num oldSize apnum:Size oldInc apnum:Inc
        oldPref apnum:Pref oldSuf apnum:Suf
        apnum:Block (mip-conv-to-str apnum:Block)
        apnum:tag (mip-conv-to-str apnum:tag)
        oldEcho (getvar "CMDECHO")
        att (getvar "ATTDIA") attr (getvar "ATTREQ")); end setq
 (setvar "ATTDIA" 0)(setvar "ATTREQ" 0)
 (setvar "CMDECHO" 0)
   (setq apnum:Pref
   (getstring T
     (strcat "\nType prefix:(If you want to delete prefix type ' ' (press SPACE key on keyboard) <"apnum:Pref"> :")))
 (if(= "" apnum:Pref)(setq apnum:Pref oldPref))
 (if(= " " apnum:Pref)(setq apnum:Pref ""))
 (setq apnum:Suf
   (getstring T
      (strcat "\nType suffix:(If you want to delete prefix type ' ' (press SPACE key on keyboard) <"apnum:Suf"> :")))
 (if(= "" apnum:Suf)(setq apnum:Suf oldSuf))
 (if(= " " apnum:Suf)(setq apnum:Suf ""))
 (if apnum:Block(setq oldBlock apnum:Block))
 (setq temBl
    (entsel(strcat "\nSelect block <"
        (if apnum:Block apnum:Block "not difined") "> > "))); end setq
 (cond
   ((or (and tembl (= 1 (cdr(assoc 66(entget(car temBl)))))
  (= "INSERT" (cdr(assoc 0(entget(car temBl)))))
  )
 (and apnum:Block (setq tembl (tblobjname "BLOCK" apnum:Block))
      (setq tembl (list tembl))
      )
 )
     (setq apnum:Block(cdr(assoc 2(entget(car temBl)))))
     ((lambda( / lst e1 ed ss i)
       (setq e1 (entnext (car temBl)))
       (while (AND e1
   (wcmatch (cdr (assoc 0 (setq ed (entget e1)))) "ATTRIB,ATTDEF")
     ) ;_ End of AND
  (setq lst (cons (cdr (assoc 2 ed)) lst))
  (setq e1 (entnext e1))
)
 (cond ((= 0 (length lst))(setq apnum:Block nil))
       ((= 1 (length lst))(setq apnum:tag (car lst)))
       (t (setq apnum:tag (mydcl "Select attribute" (acad_strlsort lst))))
       )
(terpri)(princ apnum:tag)
;;;Russian text
;;; Максимальный номер берется как максимальное число всех значений атрибутов
;;; Высчитыватся так (допустим значение атрибута   D3SE/0-008A18B3:
;;;        Значение префикса D3SE/0-
;;;        Значение суффикса B3 
;;;         1. Из значения атрибута удаляется префикс и суффикс
;;;                Значение атрибута - 008A18
;;;         2. В значении атрибута выбираются все цифры ("008" "18")
;;;         3. Из них за число атрибута берется число с максимальной последовательностью цифр
;;;                    т.е. 8, а не 18
 
 (and
   (setq ss nil ss (ssget "_X" (list
   '(0 . "INSERT")
   (cons 2  apnum:Block)
   (cons 410 (getvar "CTAB")))))
   (setq lst nil i '-1)
   (progn
     (repeat (sslength ss)
        (setq lst (cons (ssname ss (setq i (1+ i))) lst))
       )
     lst
     )
        (setq apnum:Num (1+
      (apply
 'max
        (mapcar 'atoi
               (mapcar 'mip-conv-to-str        
        (mapcar '(lambda(f / mst)
     (setq mst (apply 'max (mapcar 'strlen f)))
     (car(vl-remove-if-not '(lambda(f1)(= mst (strlen f1))) f))
     )
        (mapcar '(lambda(z)(rec-pat z ""))
 (mapcar '(lambda(y)
         (vl-string-right-trim (mip-conv-to-str apnum:Suf)
  (vl-string-left-trim apnum:pref y)))
  (vl-remove-if 'null (mapcar '(lambda(x)(cdr(assoc (strcase apnum:tag)(get-all-atts x)))) lst)))
 )))))))
   );_and
 );_lambda
);_lambda
   ); end condition #2
   ((null (tblsearch "BLOCK" apnum:Block))
    (alert (strcat "Block " apnum:Block " not found"))
    (setq apnum:Block nil)
    ); end condition #0
   ((and apnum:Block(not temBl)(tblsearch "BLOCK" apnum:Block))
   (setq apnum:Block oldBlock)
    ); end condition #1
   
   (t
    (princ "\nBlock not contains attribute! ")
    (setq apnum:Block nil)
    ); end condition #3
   ); end cond
 (setq apnum:Num
   (getint
     (strcat "\nSpecify start number <"(itoa apnum:Num)">: ")))
 (if(null apnum:Num)(setq apnum:Num oldStart))
 (setq apnum:Inc
   (getint
     (strcat "\nSpecify increment <"(itoa apnum:Inc)">: ")))
 (if(null apnum:Inc)(setq apnum:Inc oldInc))
 (setq apnum:Size
   (getreal
     (strcat "\nSpecify block scale <"(rtos apnum:Size)">: ")))
 (if(null apnum:Size)(setq apnum:Size oldSize))
 
(terpri)(princ apnum:tag)(princ  " ZZZ ")(princ apnum:Block)
 
 (if (and apnum:Block apnum:tag)
   (progn
(while T
 (princ "\n>>> Pick insertion point or press Esc to quit <<<\n")
 (command "_-insert" apnum:Block "_s" apnum:Size pause "0")
  (mip-block-setattr-bylist (entlast)
    (list(cons (strcase (mip-conv-to-str apnum:tag))
               (strcat apnum:Pref(itoa apnum:Num)apnum:Suf))))
   (setq apnum:Num (+ apnum:Num apnum:Inc))
 ); end while
); end progn
   ); end if
 (setvar "ATTDIA" att)(setvar "ATTREQ" attr)
 (princ)
 )

Hey VVA,

This last routine rocks my world!!!

the fact that you can have multiple attributes and select what you want to increment is awesome

It has saved me a lot of time.

Thank you so very much

~Greg

thanks troggarf. Variant Binc whith alignment number

(defun c:bincA (/ oldStart oldPref oldSuf oldEcho oldInc oldStart
       oldSize oldBlock temBl *error* att attr apnum:tag pt temBl )
;;;Новая версия Если в блоке несколько атрибутов, то выбирается какой нужно вставить
;;; Выравнивание значения атрибута (добавление 0 перед значением)
;;;http://forum.dwg.ru/showthread.php?t=46382

;==== Local functions ============
 (vl-load-com)
 (defun *error* (msg)(setvar "CMDECHO" oldEcho)(setvar "ATTDIA" att)(setvar "ATTREQ" attr)(princ)); end *error*
 (defun mydcl (zagl info-list / fl ret dcl_id)
   (if (null zagl)(setq zagl "Select")) ;_ end of if
   (setq fl (vl-filename-mktemp "mip" nil ".dcl"))
   (setq ret (open fl "w"))
   (mapcar '(lambda (x) (write-line x ret))
           (list "mip_msg : dialog { "
                 (strcat "label=\"" zagl "\";")
                 " :list_box {"
                 "alignment=top ;"
                 "width=51 ;"
                 (if (> (length info-list) 26)
                     "height= 26 ;"
                     (strcat "height= " (itoa (+ 3 (length info-list))) ";")
                 ) ;_ end of if
                 "is_tab_stop = false ;"
                 "key = \"info\";}"
                 "ok_cancel;}"
           ) ;_ end of list
   ) ;_ end of mapcar
   (setq ret (close ret))
   (if (and (not(minusp(setq dcl_id (load_dialog fl))))
     (new_dialog "mip_msg" dcl_id))
           (progn
               (start_list "info")(mapcar 'add_list info-list)
               (end_list)(set_tile "info" "0")
               (setq ret (car info-list))
               (action_tile "info" "(setq ret (nth (atoi $value) info-list))")
               (action_tile "cancel" "(progn(setq ret nil)(done_dialog 0))")
               (action_tile "accept" "(done_dialog 1)")(start_dialog)
           ) ;_ end of progn
   ) ;_ end of if
   (unload_dialog dcl_id)(vl-file-delete fl) ret) ;_ end of defun
 (defun mip-conv-to-str (dat)
 (cond ((= (type dat) 'INT)(setq dat (itoa dat)))
        ((= (type dat) 'REAL)(setq dat (rtos dat 2 12)))
       ((null dat)(setq dat ""))
       (t (setq dat (vl-princ-to-string dat)))))
;; obj - Ename or Vla object of block
;; att_list - list ((Tag_Name1 . Value1)(Tag_Name2 . Value2) ...)
;;                 Tag_Name - string
;;                    Value - string
(defun mip-block-setattr-bylist (obj att_list / txt lst)
(if (= (type obj) 'ENAME)(setq obj (vlax-ename->vla-object obj)))
(setq att_list (mapcar '(lambda(x)(cons (strcase (mip-conv-to-str(car x)))(mip-conv-to-str(cdr x)))) att_list))
 (if (and obj
          (not(vlax-erased-p obj))
          (= (vla-get-ObjectName obj) "AcDbBlockReference")
   (eq :vlax-true (vla-get-HasAttributes obj))
   (vlax-property-available-p obj 'Hasattributes)
   (vlax-write-enabled-p obj)
     )
   (vl-catch-all-apply
     (function
(lambda	()
         (foreach at (vlax-invoke obj 'Getattributes)
           (if (setq lst (assoc(strcase(vla-get-TagString at)) att_list))
             (vla-put-TextString at (cdr lst))
           )
           )
         )
       )
     )
   )
 )
 (defun get-all-atts (obj)
   ;;;Use (get-all-atts (car(entsel "\nSelect block:")))
   ;;;Returs list  (("TAG1" . "Value1")("TAG2" . "Value2") ...)
   (if (= (type obj) 'ENAME)
	(setq obj (vlax-ename->vla-object obj)))
 (if (and obj
          (vlax-property-available-p obj 'Hasattributes)
   (eq :vlax-true (vla-get-HasAttributes obj))
     )
   (vl-catch-all-apply
     (function
(lambda	()
  (mapcar (function (lambda (x)
		      (cons (vla-get-TagString x)
			    (vla-get-TextString x)
		      )
		    )
	  )
	  (append (vlax-invoke obj 'Getattributes)
		  (vlax-invoke obj 'Getconstantattributes)
	  )
  )
)
     )
   )
 )
)
(defun rec-pat (str temp)
 (cond
   ((= str "")(if (/= temp "")(list temp)))
   ((wcmatch (substr str 1 1) "[1234567890.]")
    (rec-pat (substr str 2) (strcat temp (substr str 1 1)))
   )
   (t (if (/= temp "")
       (cons temp (rec-pat str ""))
       (rec-pat (substr str 2) "")
      ) ;_ end of if
   )
 ) ;_ end of cond
) ;_ end of defun

 
;==== Local functions END ============
 
 (if(not apnum:Size)(setq apnum:Size 1.0))
 (if(not apnum:Num)(setq apnum:Num 1))
 (if(not apnum:Inc)(setq apnum:Inc 1))
 (if(not apnum:Pref)(setq apnum:Pref ""))
 (if(not apnum:Suf)(setq apnum:Suf ""))
 (if(not apnum:Alig)(setq apnum:Alig "1"))
 (setq  oldStart apnum:Num oldSize apnum:Size oldInc apnum:Inc
        oldPref apnum:Pref oldSuf apnum:Suf
        apnum:Block (mip-conv-to-str apnum:Block)
        apnum:tag (mip-conv-to-str apnum:tag)
        oldEcho (getvar "CMDECHO")
        att (getvar "ATTDIA") attr (getvar "ATTREQ")); end setq
 (setvar "ATTDIA" 0)(setvar "ATTREQ" 0)
 (setvar "CMDECHO" 0)
   (setq apnum:Pref
   (getstring T
     (strcat "\nType prefix:(If you want to delete prefix type ' ' (press SPACE key on keyboard) <"apnum:Pref"> :")))
 (if(= "" apnum:Pref)(setq apnum:Pref oldPref))
 (if(= " " apnum:Pref)(setq apnum:Pref ""))
 (setq apnum:Suf
   (getstring T
      (strcat "\nType suffix:(If you want to delete prefix type ' ' (press SPACE key on keyboard) <"apnum:Suf"> :")))
 (if(= "" apnum:Suf)(setq apnum:Suf oldSuf))
 (if(= " " apnum:Suf)(setq apnum:Suf ""))
 (if apnum:Block(setq oldBlock apnum:Block))
 (setq temBl
    (entsel(strcat "\nSelect block <"
        (if apnum:Block apnum:Block "not difined") "> > "))); end setq
 (cond
   ((or (and tembl (= 1 (cdr(assoc 66(entget(car temBl)))))
  (= "INSERT" (cdr(assoc 0(entget(car temBl)))))
  )
 (and apnum:Block (setq tembl (tblobjname "BLOCK" apnum:Block))
      (setq tembl (list tembl))
      )
 )
     (setq apnum:Block(cdr(assoc 2(entget(car temBl)))))
     ((lambda( / lst e1 ed ss i)
       (setq lst nil e1 (car temBl))
       (while e1
         (if (wcmatch (cdr (assoc 0 (setq ed (entget e1)))) "ATTRIB,ATTDEF")
     (setq lst (cons (cdr (assoc 2 ed)) lst))
           )
  (setq e1 (entnext e1))
)
 (cond ((= 0 (length lst))(setq apnum:Block nil))
       ((= 1 (length lst))(setq apnum:tag (car lst)))
       (t (setq apnum:tag (mydcl "Select attribute" (acad_strlsort lst))))
       )
;;; Максимальный номер берется как максимальное число всех значений атрибутов
;;; Высчитыватся так (допустим значение атрибута   D3SE/0-008A18B3:
;;;        Значение префикса D3SE/0-
;;;        Значение суффикса B3 
;;;         1. Из значения атрибута удаляется префикс и суффикс
;;;                Значение атрибута - 008A18
;;;         2. В значении атрибута выбираются все цифры ("008" "18")
;;;         3. Из них за число атрибута берется число с максимальной последовательностью цифр
;;;                    т.е. 8, а не 18
 (and apnum:Block
   (setq ss nil ss (ssget "_X" (list
			'(0 . "INSERT")
			(cons 2  apnum:Block)
			(cons 410 (getvar "CTAB")))))
   (setq lst nil i '-1)
   (progn
     (repeat (sslength ss)
        (setq lst (cons (ssname ss (setq i (1+ i))) lst))
       )
     lst
     )
        (setq apnum:Num (1+
      (apply
	'max
        (mapcar 'atoi
               (mapcar 'mip-conv-to-str        
        (mapcar '(lambda(f / mst)
		   (setq mst (apply 'max (mapcar 'strlen f)))
		   (car(vl-remove-if-not '(lambda(f1)(= mst (strlen f1))) f))
		   )
        (mapcar '(lambda(z)(rec-pat z ""))
	(mapcar '(lambda(y)
         (vl-string-right-trim (mip-conv-to-str apnum:Suf)
	 (vl-string-left-trim apnum:pref y)))
	 (vl-remove-if 'null (mapcar '(lambda(x)(cdr(assoc (strcase apnum:tag)(get-all-atts x)))) lst)))
	)))))))
   );_and
 );_lambda
);_lambda
   ); end condition #2
   ((null (tblsearch "BLOCK" apnum:Block))
    (alert (strcat "Block " apnum:Block " not found"))
    (setq apnum:Block nil)
    ); end condition #0
   ((and apnum:Block(not temBl)(tblsearch "BLOCK" apnum:Block))
   (setq apnum:Block oldBlock)
    ); end condition #1
   
   (t
    (princ "\nBlock not contains attribute! ")
    (setq apnum:Block nil)
    ); end condition #3
   ); end cond
 (setq oldStart apnum:Num)
 (setq apnum:Num
   (getint
     (strcat "\nSpecify start number <"(itoa apnum:Num)">: ")))
 (if(null apnum:Num)(setq apnum:Num oldStart))
 (setq apnum:Inc
   (getint
     (strcat "\nSpecify increment <"(itoa apnum:Inc)">: ")))
 (if(null apnum:Inc)(setq apnum:Inc oldInc))
    (setq  oldStart apnum:Alig)
 (initget "1 10 100 1000 10000 100000")
 (setq apnum:Alig 
   (GETKWORD 
     (strcat "\nSpecify the alignment of the initial number [1/10/100/1000/10000/100000] <"apnum:Alig">: ")))
 (if(null apnum:Alig)(setq apnum:Alig oldStart))

 (setq apnum:Size
   (getreal
     (strcat "\nSpecify block scale <"(rtos apnum:Size)">: ")))
 (if(null apnum:Size)(setq apnum:Size oldSize))

 (if (and apnum:Block apnum:tag)
   (progn
(while T
 (princ "\n>>> Pick insertion point or press Esc to quit <<<\n")
   (setq temBl (itoa apnum:Num))
 (while (< (strlen temBl)(1- (strlen apnum:Alig)))
   (setq temBl (strcat "0" temBl)))
 (command "_-insert" apnum:Block "_s" apnum:Size pause "0")
  (mip-block-setattr-bylist (entlast)
    (list(cons (strcase (mip-conv-to-str apnum:tag))
               (strcat apnum:Pref temBl apnum:Suf))))
   (setq apnum:Num (+ apnum:Num apnum:Inc))
 ); end while
); end progn
   ); end if
 (setvar "ATTDIA" att)(setvar "ATTREQ" attr)
 (princ)
 )

I was asked to remake a little binc, to insert blocks of the vertices of the polyline.

(defun c:bincP (/ oldStart oldPref oldSuf oldEcho oldInc
       oldSize oldBlock temBl *error* att attr apnum:tag pt )

;;; http://www.cadtutor.net/forum/showthread.php?11114/page3  
;==== Local functions ============
 (vl-load-com)
 (defun *error* (msg)(setvar "CMDECHO" oldEcho)(setvar "ATTDIA" att)(setvar "ATTREQ" attr)(princ)); end *error*
   (defun _get-polyline-coors ( pl / ent_data tmp_ent coors Z)
;;; pl - vla or ename polyline  
;;; Return lists coordinates polyline
 (if (= (type pl) 'VLA-OBJECT)(setq pl (vlax-vla-object->ename pl)))
 (if (= (cdr(assoc 0 (setq ent_data (entget pl))))  "LWPOLYLINE")
   (progn
     (setq Z (cdr(assoc 38 ent_data)))
     (setq coors
     (mapcar
       '(lambda(x)(append (cdr x) (list Z)))
         (vl-remove-if-not '(lambda(x)(= (car x) 10)) ent_data)
       )
     )
   )
   (progn
     (setq tmp_ent pl)
     (while (/= "SEQEND" (cdr(assoc 0 (setq ent_data (entget(setq tmp_ent (entnext tmp_ent)))))))
            (setq coors (cons (cdr (assoc 10 ent_data))  coors))
   );_while
     (setq coors (reverse coors))
     )
   )
 coors
 )
 (defun _get-object-byselect(message filter lock_enter / return)
 ((lambda(errnovar)
    (setvar "errno" 0)
    (while (not (setq return ((lambda(obj)
                                (if (not (vl-catch-all-error-p obj))
                                  (if obj
                                    (if filter
                                      (if (member (strcase (cdr (assoc 0 (entget (car obj))))) (mapcar 'strcase filter))
                                        (car obj)
                                        )
                                      (car obj)
                                      )
                                    (if (and (not lock_enter) (= (getvar "errno") 52))
                                      0
                                      )
                                    )
                                  1
                                  )
                                )
                               (vl-catch-all-apply 'entsel
                                                   (list (strcat "\n" message))
                                                   )
                               )
                      )
                )
      )
    (setvar "errno" errnovar)
    return
    )
   (getvar 'errno)
   )
 )

 (defun mydcl (zagl info-list / fl ret dcl_id)
   (if (null zagl)(setq zagl "Select")) ;_ end of if
   (setq fl (vl-filename-mktemp "mip" nil ".dcl"))
   (setq ret (open fl "w"))
   (mapcar '(lambda (x) (write-line x ret))
           (list "mip_msg : dialog { "
                 (strcat "label=\"" zagl "\";")
                 " :list_box {"
                 "alignment=top ;"
                 "width=51 ;"
                 (if (> (length info-list) 26)
                     "height= 26 ;"
                     (strcat "height= " (itoa (+ 3 (length info-list))) ";")
                 ) ;_ end of if
                 "is_tab_stop = false ;"
                 "key = \"info\";}"
                 "ok_cancel;}"
           ) ;_ end of list
   ) ;_ end of mapcar
   (setq ret (close ret))
   (if (and (not(minusp(setq dcl_id (load_dialog fl))))
     (new_dialog "mip_msg" dcl_id))
           (progn
               (start_list "info")(mapcar 'add_list info-list)
               (end_list)(set_tile "info" "0")
               (setq ret (car info-list))
               (action_tile "info" "(setq ret (nth (atoi $value) info-list))")
               (action_tile "cancel" "(progn(setq ret nil)(done_dialog 0))")
               (action_tile "accept" "(done_dialog 1)")(start_dialog)
           ) ;_ end of progn
   ) ;_ end of if
   (unload_dialog dcl_id)(vl-file-delete fl) ret) ;_ end of defun
 (defun mip-conv-to-str (dat)
 (cond ((= (type dat) 'INT)(setq dat (itoa dat)))
        ((= (type dat) 'REAL)(setq dat (rtos dat 2 12)))
       ((null dat)(setq dat ""))
       (t (setq dat (vl-princ-to-string dat)))))
;; obj - Ename or Vla object of block
;; att_list - list ((Tag_Name1 . Value1)(Tag_Name2 . Value2) ...)
;;                 Tag_Name - string
;;                    Value - string
(defun mip-block-setattr-bylist (obj att_list / txt lst)
(if (= (type obj) 'ENAME)(setq obj (vlax-ename->vla-object obj)))
(setq att_list (mapcar '(lambda(x)(cons (strcase (mip-conv-to-str(car x)))(mip-conv-to-str(cdr x)))) att_list))
 (if (and obj
          (not(vlax-erased-p obj))
          (= (vla-get-ObjectName obj) "AcDbBlockReference")
   (eq :vlax-true (vla-get-HasAttributes obj))
   (vlax-property-available-p obj 'Hasattributes)
   (vlax-write-enabled-p obj)
     )
   (vl-catch-all-apply
     (function
(lambda ()
         (foreach at (vlax-invoke obj 'Getattributes)
           (if (setq lst (assoc(strcase(vla-get-TagString at)) att_list))
             (vla-put-TextString at (cdr lst))
           )
           )
         )
       )
     )
   )
 )
 (defun get-all-atts (obj)
 (if (and obj
   (and (= (type obj) 'ENAME)
 (setq obj (vlax-ename->vla-object obj)))
          (vlax-property-available-p obj 'Hasattributes)
   (eq :vlax-true (vla-get-HasAttributes obj))
     )
   (vl-catch-all-apply
     (function
(lambda ()
  (mapcar (function (lambda (x)
        (cons (vla-get-TagString x)
       (vla-get-TextString x)
        )
      )
   )
   (append (vlax-invoke obj 'Getattributes)
    (vlax-invoke obj 'Getconstantattributes)
   )
  )
)
     )
   )
 )
)
(defun rec-pat (str temp)
 (cond
   ((= str "")(if (/= temp "")(list temp)))
   ((wcmatch (substr str 1 1) "[1234567890.]")
    (rec-pat (substr str 2) (strcat temp (substr str 1 1)))
   )
   (t (if (/= temp "")
       (cons temp (rec-pat str ""))
       (rec-pat (substr str 2) "")
      ) ;_ end of if
   )
 ) ;_ end of cond
) ;_ end of defun
 
;==== Local functions END ============
 
 (if(not apnum:Size)(setq apnum:Size 1.0))
 (if(not apnum:Num)(setq apnum:Num 1))
 (if(not apnum:Inc)(setq apnum:Inc 1))
 (if(not apnum:Pref)(setq apnum:Pref ""))
 (if(not apnum:Suf)(setq apnum:Suf ""))
 (setq  oldStart apnum:Num oldSize apnum:Size oldInc apnum:Inc
        oldPref apnum:Pref oldSuf apnum:Suf
        apnum:Block (mip-conv-to-str apnum:Block)
        apnum:tag (mip-conv-to-str apnum:tag)
        oldEcho (getvar "CMDECHO")
        att (getvar "ATTDIA") attr (getvar "ATTREQ")); end setq
 (setvar "ATTDIA" 0)(setvar "ATTREQ" 0)
 (setvar "CMDECHO" 0)
   (setq apnum:Pref
   (getstring T
     (strcat "\nType prefix:(If you want to delete prefix type ' ' (press SPACE key on keyboard) <"apnum:Pref"> :")))
 (if(= "" apnum:Pref)(setq apnum:Pref oldPref))
 (if(= " " apnum:Pref)(setq apnum:Pref ""))
 (setq apnum:Suf
   (getstring T
      (strcat "\nType suffix:(If you want to delete prefix type ' ' (press SPACE key on keyboard) <"apnum:Suf"> :")))
 (if(= "" apnum:Suf)(setq apnum:Suf oldSuf))
 (if(= " " apnum:Suf)(setq apnum:Suf ""))
 (if apnum:Block(setq oldBlock apnum:Block))
 (setq temBl
    (entsel(strcat "\nSelect block <"
        (if apnum:Block apnum:Block "not difined") "> > "))); end setq
 (cond
   ((or (and tembl (= 1 (cdr(assoc 66(entget(car temBl)))))
  (= "INSERT" (cdr(assoc 0(entget(car temBl)))))
  )
 (and apnum:Block (setq tembl (tblobjname "BLOCK" apnum:Block))
      (setq tembl (list tembl))
      )
 )
     (setq apnum:Block(cdr(assoc 2(entget(car temBl)))))
     ((lambda( / lst e1 ed ss i)
       (setq e1 (entnext (car temBl)))
       (while (AND e1
   (wcmatch (cdr (assoc 0 (setq ed (entget e1)))) "ATTRIB,ATTDEF")
     ) ;_ End of AND
  (setq lst (cons (cdr (assoc 2 ed)) lst))
  (setq e1 (entnext e1))
)
 (cond ((= 0 (length lst))(setq apnum:Block nil))
       ((= 1 (length lst))(setq apnum:tag (car lst)))
       (t (setq apnum:tag (mydcl "Select attribute" (acad_strlsort lst))))
       )
;;;Russian text
;;; Максимальный номер берется как максимальное число всех значений атрибутов
;;; Высчитыватся так (допустим значение атрибута   D3SE/0-008A18B3:
;;;        Значение префикса D3SE/0-
;;;        Значение суффикса B3 
;;;         1. Из значения атрибута удаляется префикс и суффикс
;;;                Значение атрибута - 008A18
;;;         2. В значении атрибута выбираются все цифры ("008" "18")
;;;         3. Из них за число атрибута берется число с максимальной последовательностью цифр
;;;                    т.е. 8, а не 18

;;; EN
;;; The maximum number is taken as the maximum number of attribute values
;;; Algorithm (assuming the attribute D3SE/0-008A18B3):
;;; Value prefix D3SE/0-
;;; Value suffix B3
;;; 1. Attribute value is removed from the prefix and suffix
;;; Attribute value - 008A18
;; 2. In the attribute value selected by all the digits ("008", "18")
;; 3. Of these, the number of attributes taken from the maximum number of a sequence of digits
;;, So choose 008 ie 8, not 18  
 
 (and
   (setq ss nil ss (ssget "_X" (list
   '(0 . "INSERT")
   (cons 2  apnum:Block)
   (cons 410 (getvar "CTAB")))))
   (setq lst nil i '-1)
   (progn
     (repeat (sslength ss)
        (setq lst (cons (ssname ss (setq i (1+ i))) lst))
       )
     lst
     )
        (setq apnum:Num (1+
      (apply
 'max
        (mapcar 'atoi
               (mapcar 'mip-conv-to-str        
        (mapcar '(lambda(f / mst)
     (setq mst (apply 'max (mapcar 'strlen f)))
     (car(vl-remove-if-not '(lambda(f1)(= mst (strlen f1))) f))
     )
        (mapcar '(lambda(z)(rec-pat z ""))
 (mapcar '(lambda(y)
         (vl-string-right-trim (mip-conv-to-str apnum:Suf)
  (vl-string-left-trim apnum:pref y)))
  (vl-remove-if 'null (mapcar '(lambda(x)(cdr(assoc (strcase apnum:tag)(get-all-atts x)))) lst)))
 )))))))
   );_and
 );_lambda
);_lambda
   ); end condition #2
   ((null (tblsearch "BLOCK" apnum:Block))
    (alert (strcat "Block " apnum:Block " not found"))
    (setq apnum:Block nil)
    ); end condition #0
   ((and apnum:Block(not temBl)(tblsearch "BLOCK" apnum:Block))
   (setq apnum:Block oldBlock)
    ); end condition #1
   
   (t
    (princ "\nBlock not contains attribute! ")
    (setq apnum:Block nil)
    ); end condition #3
   ); end cond
 (setq apnum:Num
   (getint
     (strcat "\nSpecify start number <"(itoa apnum:Num)">: ")))
 (if(null apnum:Num)(setq apnum:Num oldStart))
 (setq apnum:Inc
   (getint
     (strcat "\nSpecify increment <"(itoa apnum:Inc)">: ")))
 (if(null apnum:Inc)(setq apnum:Inc oldInc))
 (setq apnum:Size
   (getreal
     (strcat "\nSpecify block scale <"(rtos apnum:Size)">: ")))
 (if(null apnum:Size)(setq apnum:Size oldSize))
 (if (and apnum:Block apnum:tag)
   (progn
(while (and (setq pl (_get-object-byselect "\nSelect polyline <exit>: " '("POLYLINE" "LWPOLYLINE") nil))
           (/= pl 0)
           )
 (foreach pt (_get-polyline-coors pl)

 ;;;     (command "_-insert" apnum:Block "_s" apnum:Size "_none" pt "0")
   (vla-insertblock
    (if
             (and
               (zerop (vla-get-activespace
                        (vla-get-activedocument (vlax-get-acad-object))
                      ) ;_ end of vla-get-activespace
               ) ;_ end of zerop
               (= :vlax-false
                  (vla-get-mspace
                    (vla-get-activedocument (vlax-get-acad-object))
                  ) ;_ end of vla-get-mspace
               ) ;_ end of =
             ) ;_ end of and 
              (vla-get-paperspace
                (vla-get-activedocument (vlax-get-acad-object))
              ) ;_ end of vla-get-paperspace
              (vla-get-modelspace
                (vla-get-activedocument (vlax-get-acad-object))
              ) ;_ end of vla-get-modelspace
           ) ;_ end of if
    (vlax-3d-point pt)	
    apnum:Block 
    apnum:Size
    apnum:Size
    apnum:Size
    0 ;_rotation
    ) ;_ end of vla-InsertBlock
  (mip-block-setattr-bylist (entlast)
    (list(cons (strcase (mip-conv-to-str apnum:tag))
               (strcat apnum:Pref(itoa apnum:Num)apnum:Suf))))
   (setq apnum:Num (+ apnum:Num apnum:Inc))
   )
 ); end while
); end progn
   ); end if
 (setvar "ATTDIA" att)(setvar "ATTREQ" attr)
 (princ)
 )

brilliant !! thanks