Jump to content

numbering routine help...

leonucadomi

By leonucadomi
in AutoLISP, Visual LISP & DCL

 Share

Recommended Posts

leonucadomi Proficient

leonucadomi

Posted
Posted

hello all:

I use this code to number texts in groups

I would like to be able to modify it to select text one by one and number them.

can someone help me

thanks

here code 

(defun c:NU ( / ss cant nent pos txt lent lst)

   (setq ss (ssget '((0 . "TEXT")))
         i 0
   )
 (setq cant (sslength ss))
   (repeat (sslength ss)
      (setq nent (ssname ss i)
            pos (assoc 10 (entget nent))
            lst (cons (list (cadr pos) (caddr pos) nent) lst)
            i (1+ i)
      )
   )
   (setq i 1
)
   (foreach sub lst
      (setq lent (entget (last sub))
            txt (strcat (if (< i 10) "00" (if (< i 100) "0" "")) (itoa i))
            i (1+ i)
      )
      (entmod (subst (cons 1 txt)(assoc 1 lent) lent))
   )

(princ "\nTotal de textos numerados = ")
(princ cant)
  (princ)
); defun

 

  • Replies 22
  • Created
  • Last Reply

Top Posters In This Topic

  • leonucadomi

    11

  • GLAVCVS

    4

  • BIGAL

    2

  • PGia

    2

Popular Days

Top Posters In This Topic

Popular Days

Popular Posts

GLAVCVS
GLAVCVS

A couple of loose ends to tie up the all-too-fast V.2 release: -Multiple renumbering is currently done based on the order of the objects in the database: this looks ugly if the dispersion is too ran

GLAVCVS
GLAVCVS

@leonucadomi @PGia I'm attaching a new version V.3 that can also renumber block attributes. It also includes some other new features. However, I'm letting you know that <Something different>

GLAVCVS
GLAVCVS

Looks like you're still working on the same thing. So I've given 'Something Different' a bit of a makeover to fit your needs. Substitutes for 'getpoint', 'entsel', and 'ssget', all in one at the s

Posted Images

GLAVCVS Proficient

GLAVCVS

Posted
Posted

Do you want to number them in ascending and consecutive order?

  • Thanks 1
leonucadomi Proficient

leonucadomi

Posted
  • Author
Posted
30 minutes ago, GLAVCVS said:

Do you want to number them in ascending and consecutive order?

Yes, only sometimes I need to number them one by one , 001 ,002 ,003 ....

Saxlle Collaborator

Saxlle

Posted
Posted

Did you try with Auto Number function from Express Tools in Autocad? 

 

Try with this Auto Numbering Text. 

  • Thanks 1
leonucadomi Proficient

leonucadomi

Posted
  • Author
Posted

thanks, But I need to select and assign the number, so I need to modify this routine.

BIGAL Grand Master

BIGAL

Posted
Posted

You dont need to make a list the selection set is your list. If you say window select then the text will be in creation order or as I found out in reverse, if you pick pick pick it will be in pick order, 

 

In its simplest form 

(prompt "\nPick text in order ")
(setq ss (ssget))
(setq num (getint "\nEnter start number "))
(setq i -1)
(repeat (sslength ss)
(setq ent (entget (ssname ss (setq i (1+ i)))))
(entmod (subst (cons 1 (rtos num 2 0)) (assoc 1 ent) ent))
(setq num (1+ num))
)

 

  • Thanks 1
GLAVCVS Proficient

GLAVCVS

Posted
Posted (edited)

Looks like you're still working on the same thing.
So I've given 'Something Different' a bit of a makeover to fit your needs.
Substitutes for 'getpoint', 'entsel', and 'ssget', all in one at the same time. 

;******** <<S o m e t h i n g   d i f f e r e n t  V.2>> ********
;*******************  p o r d e s í a r g o  ********************
;************************ G L A V C V S *************************
;************************** F E C I T ***************************
(defun c:txtIncrem  (/ tam    capa   ind    para   a	  c	 cl
		       txsel  le     l	    s	   dameTexto	 uconfig
		       obtcad ent    loc    tipC   nC	  ps	 add
		       errores	     error0 v	   actTX  ventanea
		       pv     n	     cj	    iniUM  acdoc  md
		      )
  (defun errores (mens)
    (setq *error* error0)
    (while (>= (boole 1 (getvar "UNDOCTL") 8) 8)
      (vla-endundomark acdoc)
    )
    (prin1)
  )

  (defun dameTexto (cad / v r l daleVuelta)
    ;;; WRITE HERE THE CODE YOU NEED TO CUSTOMIZE THE TEXT YOU WANT TO ENTER OR CREATE
    (defun daleVuelta (a)
      (cond
        ((and (> a 64) (< a 91)) (if (> (setq a (+ a 1)) 90) (setq a -65) a))
        ((and (> a 96) (< a 123)) (if (> (setq a (+ a 1)) 122) (setq a -97) a))
        ((and (> a 47) (< a 58)) (if (> (setq a (+ a 1)) 57) (setq a -48) a))
      )
    )
    (foreach v (reverse (vl-string->list cad))
      (if (or (not r) (minusp r))
        (setq l (cons (abs (setq r (daleVuelta v))) l))
        (setq l (cons v l))
      )
    )
    (vl-list->string (if (minusp r) (cons (if (= r -48) 49 (car l)) l) l))
  )
  
  (defun ventanea (/ p no se)
    (if (listp (setq p (cadr l)))
      (progn
	(redraw)
        (grvecs (list 7 pv (setq no (list (car pv) (cadr p)))))
	(grvecs (list 7 pv (setq se (list (car p) (cadr pv)))))
	(grvecs (list 7 no p))
	(grvecs (list 7 se p))
      )
    )
  )

  (defun actTX (e / le)
    (entmod (subst (cons 1 tx) (assoc 1 (setq le (entget e))) le))
    (setq tx (dameTexto tx))
    nil
  )
    
  (setq	error0	*error*
	*error*	errores
  )
  (setq acdoc (vla-get-activedocument (vlax-get-acad-object)))
  (while (>= (boole 1 (getvar "UNDOCTL") 8) 8)
    (vla-endundomark acdoc)
  )
  (princ (setq s "Select PREVIOUS number text or type it... "))
  (while (not para)
    (setq l (grread T 13 2))
    (if (not (listp (cadr l)))
      (if (member (car l) '(2 3 11 25))
	(cond
	  ((or (= (cadr l) 13) (= (car l) 25) (= (car l) 11))
	    (if (and c (not (wcmatch c "*.*")))
	      (setq ind c para T)
	      (if (not c) (setq para T))
	    )
	  )
	  ((> (cadr l) 31)
            (setq c (if c (strcat c (chr (cadr l))) (chr (cadr l))))
	    (prompt (strcat "\r" s c))
	  )
	  ((= (cadr l) 8)
            (if (setq c (if c (substr c 1 (- (strlen c) 1))))
	      (prompt (strcat "\r" s c))
	    )
	  )
	  (T (princ) )
	)
      )
      (if (= (car l) 3)
	(if (and (setq e (nentselp (cadr l))) (= (cdr (assoc 0 (setq le (entget (setq e (car e)))))) "TEXT"))
	  (if (not (wcmatch (setq ind (cdr (assoc 1 le))) "*.*"))
	    (setq capa (cdr (assoc 8 le)) a (cdr (assoc 40 le)) cl (cdr (assoc 62 le)) para T)
	    (princ "\n*** The selected object is not valid. Please, try again... ***")
	  )
	)
      )
    )
  )
  (setq para nil)
  (if (not capa)
    (while (not para)
      (if (and (setq e (car (entsel "\nLAYER/HEIGHT: Select a sample text object (ENTER or RIGHT CLICK to type it)... ")))
	       (setq l (entget e))
	  )
	(if (= (cdr (assoc 0 l)) "TEXT")
	  (setq	capa (cdr (assoc 8 l)) a (cdr (assoc 40 l)) para T)
	  (princ "\n*** The selected object is not a TEXT. Please, try again... ***")
	)
	(if (not capa)
	  (if (setq capa (getstring "\nType Layer name: "))
	    (if (tblsearch "layer" capa)  
	      (if (not (setq a (getreal "\nType Height: ")))
		(setq capa (princ "\n*** A valid height has not been specified. Please, type it again... ***") capa nil)
		(setq para T)
	      )	      
	      (setq capa (princ "\n*** Specified layer does not exist. Please, type it again... ***") capa nil)
	    )
	  )
	)	  
      )
    )
  )
  (setq tx (dameTexto ind) s nil)
  (while ;(and (setq l (grread T (if s 4 13) (if s 2 0))) (member (car l) '(5 3 2)))
    (and (setq l (grread T (cond (s 4) (v 4) (T 13)) (cond (s 2) ((and pv v) 1) (v 2) (T 0)))) (member (car l) '(5 3 2)))
    (prompt (strcat "\rSelect text to modify or insert new text \"" tx "\" (<V> for ON/OFF multiple selection or <RIGHT CLICK> for exit)"))
    (setq tam (* (getvar "pickbox") (/ (GETVAR "VIEWSIZE") (CADR (GETVAR "SCREENSIZE")))) para nil n nil)
    (if (= (car l) 2)
      (cond
	((member (cadr l) '(86 118))
	 (setq v (not v))
	)
;;;	HERE MORE CASES ?...(ascii "V")
      )
      (if (or v
	      (setq s (ssget "_C" (list (- (car (setq p (cadr l))) tam) (- (cadr p) tam))
			      (list (+ (car p) tam) (+ (cadr p) tam))
		              (list (cons 0 "TEXT"))
		      )
	      )
	  )
        (cond
	  ((= (car l) 3)
	   (if s
	     (setq md (vla-startundomark acdoc) s (actTX (ssname s 0)))
	     (if pv
	       (if (setq cj (ssget "_C" pv (cadr l) (list (cons 0 "TEXT"))) pv (if cj (vla-startundomark acdoc)) v (redraw) cj cj)
		 (while (setq e (ssname cj (setq n (if n (1+ n) 0))))
		   (actTX e)
		 )
	       )
	       (setq pv (cadr l))
	     )
	   )
	  )
	      
	  ((and pv (= (car l) 5) (not s))
	    (ventanea)
	  )
	  (T (princ) )
;;;	HERE MORE CASES ?...
        )
        (cond
	  ((= (car l) 3)
	   (entmake (list	'(0 . "TEXT")
			  (cons 8 capa)
			  (cons 62 (if cl cl 256))
			  (cons 40 a)
			  (cons 1 tx)
			  (cons 10 (list (car p) (cadr p) 0.0))
		    )
	   )
	   (setq tx (dameTexto tx))
	  )
	  (T
	   (if (/= (car l) 5) (princ) )
	  )
;;;	HERE MORE CASES ?...
        )
      )
    )
  )
  (while (>= (boole 1 (getvar "UNDOCTL") 8) 8)
    (vla-endundomark acdoc)
  )
  (princ)
)

 

P.S.: Not for those who hate alternative 'medicine'  🙂

Edited by GLAVCVS
  • Like 1
  • Thanks 1
PGia Contributor

PGia

Posted
Posted (edited)

Hi @GLAVCVS 

I've tried your Lisp but I'm not sure how to use it.

Edited by PGia
leonucadomi Proficient

leonucadomi

Posted
  • Author
Posted
On 5/1/2025 at 4:40 AM, GLAVCVS said:

Looks like you're still working on the same thing.
So I've given 'Something Different' a bit of a makeover to fit your needs.
Substitutes for 'getpoint', 'entsel', and 'ssget', all in one at the same time. 

;******** <<S o m e t h i n g   d i f f e r e n t  V.2>> ********
;*******************  p o r d e s í a r g o  ********************
;************************ G L A V C V S *************************
;************************** F E C I T ***************************
(defun c:txtIncrem  (/ tam    capa   ind    para   a	  c	 cl
		       txsel  le     l	    s	   dameTexto	 uconfig
		       obtcad ent    loc    tipC   nC	  ps	 add
		       errores	     error0 v	   actTX  ventanea
		       pv     n	     cj	    iniUM  acdoc  md
		      )
  (defun errores (mens)
    (setq *error* error0)
    (while (>= (boole 1 (getvar "UNDOCTL") 8) 8)
      (vla-endundomark acdoc)
    )
    (prin1)
  )

  (defun dameTexto (cad / v r l daleVuelta)
    ;;; WRITE HERE THE CODE YOU NEED TO CUSTOMIZE THE TEXT YOU WANT TO ENTER OR CREATE
    (defun daleVuelta (a)
      (cond
        ((and (> a 64) (< a 91)) (if (> (setq a (+ a 1)) 90) (setq a -65) a))
        ((and (> a 96) (< a 123)) (if (> (setq a (+ a 1)) 122) (setq a -97) a))
        ((and (> a 47) (< a 58)) (if (> (setq a (+ a 1)) 57) (setq a -48) a))
      )
    )
    (foreach v (reverse (vl-string->list cad))
      (if (or (not r) (minusp r))
        (setq l (cons (abs (setq r (daleVuelta v))) l))
        (setq l (cons v l))
      )
    )
    (vl-list->string (if (minusp r) (cons (if (= r -48) 49 (car l)) l) l))
  )
  
  (defun ventanea (/ p no se)
    (if (listp (setq p (cadr l)))
      (progn
	(redraw)
        (grvecs (list 7 pv (setq no (list (car pv) (cadr p)))))
	(grvecs (list 7 pv (setq se (list (car p) (cadr pv)))))
	(grvecs (list 7 no p))
	(grvecs (list 7 se p))
      )
    )
  )

  (defun actTX (e / le)
    (entmod (subst (cons 1 tx) (assoc 1 (setq le (entget e))) le))
    (setq tx (dameTexto tx))
    nil
  )
    
  (setq	error0	*error*
	*error*	errores
  )
  (setq acdoc (vla-get-activedocument (vlax-get-acad-object)))
  (while (>= (boole 1 (getvar "UNDOCTL") 8) 8)
    (vla-endundomark acdoc)
  )
  (princ (setq s "Select PREVIOUS number text or type it... "))
  (while (not para)
    (setq l (grread T 13 2))
    (if (not (listp (cadr l)))
      (if (member (car l) '(2 3 11 25))
	(cond
	  ((or (= (cadr l) 13) (= (car l) 25) (= (car l) 11))
	    (if (and c (not (wcmatch c "*.*")))
	      (setq ind c para T)
	      (if (not c) (setq para T))
	    )
	  )
	  ((> (cadr l) 31)
            (setq c (if c (strcat c (chr (cadr l))) (chr (cadr l))))
	    (prompt (strcat "\r" s c))
	  )
	  ((= (cadr l) 8)
            (if (setq c (if c (substr c 1 (- (strlen c) 1))))
	      (prompt (strcat "\r" s c))
	    )
	  )
	  (T (princ) )
	)
      )
      (if (= (car l) 3)
	(if (and (setq e (nentselp (cadr l))) (= (cdr (assoc 0 (setq le (entget (setq e (car e)))))) "TEXT"))
	  (if (not (wcmatch (setq ind (cdr (assoc 1 le))) "*.*"))
	    (setq capa (cdr (assoc 8 le)) a (cdr (assoc 40 le)) cl (cdr (assoc 62 le)) para T)
	    (princ "\n*** The selected object is not valid. Please, try again... ***")
	  )
	)
      )
    )
  )
  (setq para nil)
  (if (not capa)
    (while (not para)
      (if (and (setq e (car (entsel "\nLAYER/HEIGHT: Select a sample text object (ENTER or RIGHT CLICK to type it)... ")))
	       (setq l (entget e))
	  )
	(if (= (cdr (assoc 0 l)) "TEXT")
	  (setq	capa (cdr (assoc 8 l)) a (cdr (assoc 40 l)) para T)
	  (princ "\n*** The selected object is not a TEXT. Please, try again... ***")
	)
	(if (not capa)
	  (if (setq capa (getstring "\nType Layer name: "))
	    (if (tblsearch "layer" capa)  
	      (if (not (setq a (getreal "\nType Height: ")))
		(setq capa (princ "\n*** A valid height has not been specified. Please, type it again... ***") capa nil)
		(setq para T)
	      )	      
	      (setq capa (princ "\n*** Specified layer does not exist. Please, type it again... ***") capa nil)
	    )
	  )
	)	  
      )
    )
  )
  (setq tx (dameTexto ind) s nil)
  (while ;(and (setq l (grread T (if s 4 13) (if s 2 0))) (member (car l) '(5 3 2)))
    (and (setq l (grread T (cond (s 4) (v 4) (T 13)) (cond (s 2) ((and pv v) 1) (v 2) (T 0)))) (member (car l) '(5 3 2)))
    (prompt (strcat "\rSelect text to modify or insert new text \"" tx "\" (<V> for ON/OFF multiple selection or <RIGHT CLICK> for exit)"))
    (setq tam (* (getvar "pickbox") (/ (GETVAR "VIEWSIZE") (CADR (GETVAR "SCREENSIZE")))) para nil n nil)
    (if (= (car l) 2)
      (cond
	((member (cadr l) '(86 118))
	 (setq v (not v))
	)
;;;	HERE MORE CASES ?...(ascii "V")
      )
      (if (or v
	      (setq s (ssget "_C" (list (- (car (setq p (cadr l))) tam) (- (cadr p) tam))
			      (list (+ (car p) tam) (+ (cadr p) tam))
		              (list (cons 0 "TEXT"))
		      )
	      )
	  )
        (cond
	  ((= (car l) 3)
	   (if s
	     (setq md (vla-startundomark acdoc) s (actTX (ssname s 0)))
	     (if pv
	       (if (setq cj (ssget "_C" pv (cadr l) (list (cons 0 "TEXT"))) pv (if cj (vla-startundomark acdoc)) v (redraw) cj cj)
		 (while (setq e (ssname cj (setq n (if n (1+ n) 0))))
		   (actTX e)
		 )
	       )
	       (setq pv (cadr l))
	     )
	   )
	  )
	      
	  ((and pv (= (car l) 5) (not s))
	    (ventanea)
	  )
	  (T (princ) )
;;;	HERE MORE CASES ?...
        )
        (cond
	  ((= (car l) 3)
	   (entmake (list	'(0 . "TEXT")
			  (cons 8 capa)
			  (cons 62 (if cl cl 256))
			  (cons 40 a)
			  (cons 1 tx)
			  (cons 10 (list (car p) (cadr p) 0.0))
		    )
	   )
	   (setq tx (dameTexto tx))
	  )
	  (T
	   (if (/= (car l) 5) (princ) )
	  )
;;;	HERE MORE CASES ?...
        )
      )
    )
  )
  (while (>= (boole 1 (getvar "UNDOCTL") 8) 8)
    (vla-endundomark acdoc)
  )
  (princ)
)

 

P.S.: Not for those who hate alternative 'medicine'  🙂

YES, THANK YOU VERY MUCH, IT'S THAT MANY VARIANTS ARE GENERATED IN MY WORK

leonucadomi Proficient

leonucadomi

Posted
  • Author
Posted
On 5/1/2025 at 4:40 AM, GLAVCVS said:

Looks like you're still working on the same thing.
So I've given 'Something Different' a bit of a makeover to fit your needs.
Substitutes for 'getpoint', 'entsel', and 'ssget', all in one at the same time. 

;******** <<S o m e t h i n g   d i f f e r e n t  V.2>> ********
;*******************  p o r d e s í a r g o  ********************
;************************ G L A V C V S *************************
;************************** F E C I T ***************************
(defun c:txtIncrem  (/ tam    capa   ind    para   a	  c	 cl
		       txsel  le     l	    s	   dameTexto	 uconfig
		       obtcad ent    loc    tipC   nC	  ps	 add
		       errores	     error0 v	   actTX  ventanea
		       pv     n	     cj	    iniUM  acdoc  md
		      )
  (defun errores (mens)
    (setq *error* error0)
    (while (>= (boole 1 (getvar "UNDOCTL") 8) 8)
      (vla-endundomark acdoc)
    )
    (prin1)
  )

  (defun dameTexto (cad / v r l daleVuelta)
    ;;; WRITE HERE THE CODE YOU NEED TO CUSTOMIZE THE TEXT YOU WANT TO ENTER OR CREATE
    (defun daleVuelta (a)
      (cond
        ((and (> a 64) (< a 91)) (if (> (setq a (+ a 1)) 90) (setq a -65) a))
        ((and (> a 96) (< a 123)) (if (> (setq a (+ a 1)) 122) (setq a -97) a))
        ((and (> a 47) (< a 58)) (if (> (setq a (+ a 1)) 57) (setq a -48) a))
      )
    )
    (foreach v (reverse (vl-string->list cad))
      (if (or (not r) (minusp r))
        (setq l (cons (abs (setq r (daleVuelta v))) l))
        (setq l (cons v l))
      )
    )
    (vl-list->string (if (minusp r) (cons (if (= r -48) 49 (car l)) l) l))
  )
  
  (defun ventanea (/ p no se)
    (if (listp (setq p (cadr l)))
      (progn
	(redraw)
        (grvecs (list 7 pv (setq no (list (car pv) (cadr p)))))
	(grvecs (list 7 pv (setq se (list (car p) (cadr pv)))))
	(grvecs (list 7 no p))
	(grvecs (list 7 se p))
      )
    )
  )

  (defun actTX (e / le)
    (entmod (subst (cons 1 tx) (assoc 1 (setq le (entget e))) le))
    (setq tx (dameTexto tx))
    nil
  )
    
  (setq	error0	*error*
	*error*	errores
  )
  (setq acdoc (vla-get-activedocument (vlax-get-acad-object)))
  (while (>= (boole 1 (getvar "UNDOCTL") 8) 8)
    (vla-endundomark acdoc)
  )
  (princ (setq s "Select PREVIOUS number text or type it... "))
  (while (not para)
    (setq l (grread T 13 2))
    (if (not (listp (cadr l)))
      (if (member (car l) '(2 3 11 25))
	(cond
	  ((or (= (cadr l) 13) (= (car l) 25) (= (car l) 11))
	    (if (and c (not (wcmatch c "*.*")))
	      (setq ind c para T)
	      (if (not c) (setq para T))
	    )
	  )
	  ((> (cadr l) 31)
            (setq c (if c (strcat c (chr (cadr l))) (chr (cadr l))))
	    (prompt (strcat "\r" s c))
	  )
	  ((= (cadr l) 8)
            (if (setq c (if c (substr c 1 (- (strlen c) 1))))
	      (prompt (strcat "\r" s c))
	    )
	  )
	  (T (princ) )
	)
      )
      (if (= (car l) 3)
	(if (and (setq e (nentselp (cadr l))) (= (cdr (assoc 0 (setq le (entget (setq e (car e)))))) "TEXT"))
	  (if (not (wcmatch (setq ind (cdr (assoc 1 le))) "*.*"))
	    (setq capa (cdr (assoc 8 le)) a (cdr (assoc 40 le)) cl (cdr (assoc 62 le)) para T)
	    (princ "\n*** The selected object is not valid. Please, try again... ***")
	  )
	)
      )
    )
  )
  (setq para nil)
  (if (not capa)
    (while (not para)
      (if (and (setq e (car (entsel "\nLAYER/HEIGHT: Select a sample text object (ENTER or RIGHT CLICK to type it)... ")))
	       (setq l (entget e))
	  )
	(if (= (cdr (assoc 0 l)) "TEXT")
	  (setq	capa (cdr (assoc 8 l)) a (cdr (assoc 40 l)) para T)
	  (princ "\n*** The selected object is not a TEXT. Please, try again... ***")
	)
	(if (not capa)
	  (if (setq capa (getstring "\nType Layer name: "))
	    (if (tblsearch "layer" capa)  
	      (if (not (setq a (getreal "\nType Height: ")))
		(setq capa (princ "\n*** A valid height has not been specified. Please, type it again... ***") capa nil)
		(setq para T)
	      )	      
	      (setq capa (princ "\n*** Specified layer does not exist. Please, type it again... ***") capa nil)
	    )
	  )
	)	  
      )
    )
  )
  (setq tx (dameTexto ind) s nil)
  (while ;(and (setq l (grread T (if s 4 13) (if s 2 0))) (member (car l) '(5 3 2)))
    (and (setq l (grread T (cond (s 4) (v 4) (T 13)) (cond (s 2) ((and pv v) 1) (v 2) (T 0)))) (member (car l) '(5 3 2)))
    (prompt (strcat "\rSelect text to modify or insert new text \"" tx "\" (<V> for ON/OFF multiple selection or <RIGHT CLICK> for exit)"))
    (setq tam (* (getvar "pickbox") (/ (GETVAR "VIEWSIZE") (CADR (GETVAR "SCREENSIZE")))) para nil n nil)
    (if (= (car l) 2)
      (cond
	((member (cadr l) '(86 118))
	 (setq v (not v))
	)
;;;	HERE MORE CASES ?...(ascii "V")
      )
      (if (or v
	      (setq s (ssget "_C" (list (- (car (setq p (cadr l))) tam) (- (cadr p) tam))
			      (list (+ (car p) tam) (+ (cadr p) tam))
		              (list (cons 0 "TEXT"))
		      )
	      )
	  )
        (cond
	  ((= (car l) 3)
	   (if s
	     (setq md (vla-startundomark acdoc) s (actTX (ssname s 0)))
	     (if pv
	       (if (setq cj (ssget "_C" pv (cadr l) (list (cons 0 "TEXT"))) pv (if cj (vla-startundomark acdoc)) v (redraw) cj cj)
		 (while (setq e (ssname cj (setq n (if n (1+ n) 0))))
		   (actTX e)
		 )
	       )
	       (setq pv (cadr l))
	     )
	   )
	  )
	      
	  ((and pv (= (car l) 5) (not s))
	    (ventanea)
	  )
	  (T (princ) )
;;;	HERE MORE CASES ?...
        )
        (cond
	  ((= (car l) 3)
	   (entmake (list	'(0 . "TEXT")
			  (cons 8 capa)
			  (cons 62 (if cl cl 256))
			  (cons 40 a)
			  (cons 1 tx)
			  (cons 10 (list (car p) (cadr p) 0.0))
		    )
	   )
	   (setq tx (dameTexto tx))
	  )
	  (T
	   (if (/= (car l) 5) (princ) )
	  )
;;;	HERE MORE CASES ?...
        )
      )
    )
  )
  (while (>= (boole 1 (getvar "UNDOCTL") 8) 8)
    (vla-endundomark acdoc)
  )
  (princ)
)

 

P.S.: Not for those who hate alternative 'medicine'  🙂

I am sure that the tools provided here are useful for many people.

leonucadomi Proficient

leonucadomi

Posted
  • Author
Posted
On 4/30/2025 at 7:05 PM, BIGAL said:

You dont need to make a list the selection set is your list. If you say window select then the text will be in creation order or as I found out in reverse, if you pick pick pick it will be in pick order, 

 

In its simplest form 

(prompt "\nPick text in order ")
(setq ss (ssget))
(setq num (getint "\nEnter start number "))
(setq i -1)
(repeat (sslength ss)
(setq ent (entget (ssname ss (setq i (1+ i)))))
(entmod (subst (cons 1 (rtos num 2 0)) (assoc 1 ent) ent))
(setq num (1+ num))
)

 

 

On 5/1/2025 at 4:40 AM, GLAVCVS said:

Looks like you're still working on the same thing.
So I've given 'Something Different' a bit of a makeover to fit your needs.
Substitutes for 'getpoint', 'entsel', and 'ssget', all in one at the same time. 

;******** <<S o m e t h i n g   d i f f e r e n t  V.2>> ********
;*******************  p o r d e s í a r g o  ********************
;************************ G L A V C V S *************************
;************************** F E C I T ***************************
(defun c:txtIncrem  (/ tam    capa   ind    para   a	  c	 cl
		       txsel  le     l	    s	   dameTexto	 uconfig
		       obtcad ent    loc    tipC   nC	  ps	 add
		       errores	     error0 v	   actTX  ventanea
		       pv     n	     cj	    iniUM  acdoc  md
		      )
  (defun errores (mens)
    (setq *error* error0)
    (while (>= (boole 1 (getvar "UNDOCTL") 8) 8)
      (vla-endundomark acdoc)
    )
    (prin1)
  )

  (defun dameTexto (cad / v r l daleVuelta)
    ;;; WRITE HERE THE CODE YOU NEED TO CUSTOMIZE THE TEXT YOU WANT TO ENTER OR CREATE
    (defun daleVuelta (a)
      (cond
        ((and (> a 64) (< a 91)) (if (> (setq a (+ a 1)) 90) (setq a -65) a))
        ((and (> a 96) (< a 123)) (if (> (setq a (+ a 1)) 122) (setq a -97) a))
        ((and (> a 47) (< a 58)) (if (> (setq a (+ a 1)) 57) (setq a -48) a))
      )
    )
    (foreach v (reverse (vl-string->list cad))
      (if (or (not r) (minusp r))
        (setq l (cons (abs (setq r (daleVuelta v))) l))
        (setq l (cons v l))
      )
    )
    (vl-list->string (if (minusp r) (cons (if (= r -48) 49 (car l)) l) l))
  )
  
  (defun ventanea (/ p no se)
    (if (listp (setq p (cadr l)))
      (progn
	(redraw)
        (grvecs (list 7 pv (setq no (list (car pv) (cadr p)))))
	(grvecs (list 7 pv (setq se (list (car p) (cadr pv)))))
	(grvecs (list 7 no p))
	(grvecs (list 7 se p))
      )
    )
  )

  (defun actTX (e / le)
    (entmod (subst (cons 1 tx) (assoc 1 (setq le (entget e))) le))
    (setq tx (dameTexto tx))
    nil
  )
    
  (setq	error0	*error*
	*error*	errores
  )
  (setq acdoc (vla-get-activedocument (vlax-get-acad-object)))
  (while (>= (boole 1 (getvar "UNDOCTL") 8) 8)
    (vla-endundomark acdoc)
  )
  (princ (setq s "Select PREVIOUS number text or type it... "))
  (while (not para)
    (setq l (grread T 13 2))
    (if (not (listp (cadr l)))
      (if (member (car l) '(2 3 11 25))
	(cond
	  ((or (= (cadr l) 13) (= (car l) 25) (= (car l) 11))
	    (if (and c (not (wcmatch c "*.*")))
	      (setq ind c para T)
	      (if (not c) (setq para T))
	    )
	  )
	  ((> (cadr l) 31)
            (setq c (if c (strcat c (chr (cadr l))) (chr (cadr l))))
	    (prompt (strcat "\r" s c))
	  )
	  ((= (cadr l) 8)
            (if (setq c (if c (substr c 1 (- (strlen c) 1))))
	      (prompt (strcat "\r" s c))
	    )
	  )
	  (T (princ) )
	)
      )
      (if (= (car l) 3)
	(if (and (setq e (nentselp (cadr l))) (= (cdr (assoc 0 (setq le (entget (setq e (car e)))))) "TEXT"))
	  (if (not (wcmatch (setq ind (cdr (assoc 1 le))) "*.*"))
	    (setq capa (cdr (assoc 8 le)) a (cdr (assoc 40 le)) cl (cdr (assoc 62 le)) para T)
	    (princ "\n*** The selected object is not valid. Please, try again... ***")
	  )
	)
      )
    )
  )
  (setq para nil)
  (if (not capa)
    (while (not para)
      (if (and (setq e (car (entsel "\nLAYER/HEIGHT: Select a sample text object (ENTER or RIGHT CLICK to type it)... ")))
	       (setq l (entget e))
	  )
	(if (= (cdr (assoc 0 l)) "TEXT")
	  (setq	capa (cdr (assoc 8 l)) a (cdr (assoc 40 l)) para T)
	  (princ "\n*** The selected object is not a TEXT. Please, try again... ***")
	)
	(if (not capa)
	  (if (setq capa (getstring "\nType Layer name: "))
	    (if (tblsearch "layer" capa)  
	      (if (not (setq a (getreal "\nType Height: ")))
		(setq capa (princ "\n*** A valid height has not been specified. Please, type it again... ***") capa nil)
		(setq para T)
	      )	      
	      (setq capa (princ "\n*** Specified layer does not exist. Please, type it again... ***") capa nil)
	    )
	  )
	)	  
      )
    )
  )
  (setq tx (dameTexto ind) s nil)
  (while ;(and (setq l (grread T (if s 4 13) (if s 2 0))) (member (car l) '(5 3 2)))
    (and (setq l (grread T (cond (s 4) (v 4) (T 13)) (cond (s 2) ((and pv v) 1) (v 2) (T 0)))) (member (car l) '(5 3 2)))
    (prompt (strcat "\rSelect text to modify or insert new text \"" tx "\" (<V> for ON/OFF multiple selection or <RIGHT CLICK> for exit)"))
    (setq tam (* (getvar "pickbox") (/ (GETVAR "VIEWSIZE") (CADR (GETVAR "SCREENSIZE")))) para nil n nil)
    (if (= (car l) 2)
      (cond
	((member (cadr l) '(86 118))
	 (setq v (not v))
	)
;;;	HERE MORE CASES ?...(ascii "V")
      )
      (if (or v
	      (setq s (ssget "_C" (list (- (car (setq p (cadr l))) tam) (- (cadr p) tam))
			      (list (+ (car p) tam) (+ (cadr p) tam))
		              (list (cons 0 "TEXT"))
		      )
	      )
	  )
        (cond
	  ((= (car l) 3)
	   (if s
	     (setq md (vla-startundomark acdoc) s (actTX (ssname s 0)))
	     (if pv
	       (if (setq cj (ssget "_C" pv (cadr l) (list (cons 0 "TEXT"))) pv (if cj (vla-startundomark acdoc)) v (redraw) cj cj)
		 (while (setq e (ssname cj (setq n (if n (1+ n) 0))))
		   (actTX e)
		 )
	       )
	       (setq pv (cadr l))
	     )
	   )
	  )
	      
	  ((and pv (= (car l) 5) (not s))
	    (ventanea)
	  )
	  (T (princ) )
;;;	HERE MORE CASES ?...
        )
        (cond
	  ((= (car l) 3)
	   (entmake (list	'(0 . "TEXT")
			  (cons 8 capa)
			  (cons 62 (if cl cl 256))
			  (cons 40 a)
			  (cons 1 tx)
			  (cons 10 (list (car p) (cadr p) 0.0))
		    )
	   )
	   (setq tx (dameTexto tx))
	  )
	  (T
	   (if (/= (car l) 5) (princ) )
	  )
;;;	HERE MORE CASES ?...
        )
      )
    )
  )
  (while (>= (boole 1 (getvar "UNDOCTL") 8) 8)
    (vla-endundomark acdoc)
  )
  (princ)
)

 

P.S.: Not for those who hate alternative 'medicine'  🙂

wow this routine is wonderful thank you

  • Like 1
leonucadomi Proficient

leonucadomi

Posted
  • Author
Posted

thanks very much

PGia Contributor

PGia

Posted
Posted
4 hours ago, PGia said:

Hi @GLAVCVS 

I've tried your Lisp but I'm not sure how to use it.

I think I understand how it works.

I've had to change my mental patterns, hahaha.

It's fantastic!!

👏👏👏

  • Like 1
leonucadomi Proficient

leonucadomi

Posted
  • Author
Posted
On 4/30/2025 at 7:05 PM, BIGAL said:

You dont need to make a list the selection set is your list. If you say window select then the text will be in creation order or as I found out in reverse, if you pick pick pick it will be in pick order, 

 

In its simplest form 

(prompt "\nPick text in order ")
(setq ss (ssget))
(setq num (getint "\nEnter start number "))
(setq i -1)
(repeat (sslength ss)
(setq ent (entget (ssname ss (setq i (1+ i)))))
(entmod (subst (cons 1 (rtos num 2 0)) (assoc 1 ent) ent))
(setq num (1+ num))
)

 

Thanks for the code master. I'm learning from all this. I just need the numbers to be entered immediately, not at the end of the routine. I also need them to be entered in the format 001, 002, 003. That's why I posted the example of the code I use.

SLW210 Grand Master

SLW210

Posted
Posted

Do you have a before and after drawing?

  • Thanks 1
leonucadomi Proficient

leonucadomi

Posted
  • Author
Posted
4 minutes ago, SLW210 said:

Do you have a before and after drawing?

 

would show like this

image.thumb.png.bcfa82edd9a30a76062230ea5bf5b02d.png

This is already done by the master's routine GLAVCVS , and it's fantastic because it does more things.

and I have one that does what I need but selecting the numbers in groups. (ssget)

I would like to see the code modified but in a simple way so I can learn. 

txt (strcat (if (< i 10) "00" (if (< i 100) "0" "")) (itoa i))

especially this part.

 

it would be something like this 

(prompt "\nPick text in order ")
(setq ss (ssget))
(setq num (getint "\nEnter start number "))
(setq i -1)
(repeat (sslength ss)
(setq ent (entget (ssname ss (setq i (1+ i)))))
(entmod (subst (cons 1 (rtos num 2 0)) (assoc 1 ent) ent))
(setq num (1+ num))
)

 

but mark with this format 001, 002 ,003, 004.....

and also that the change is reflected one by one and not at the end of the routine

 

 

 

 

 

 

GLAVCVS Proficient

GLAVCVS

Posted
Posted

A couple of loose ends to tie up the all-too-fast V.2 release:
-Multiple renumbering is currently done based on the order of the objects in the database: this looks ugly if the dispersion is too random.
-As PGia has suggested, perhaps I should leave a brief explanation of the code's functionality.

So, let's get to it:
 

I've added a couple of improvements to the code that makes up the new version of <<Something different>>, which I've attached below.

 

What's New in Version 2.1
The philosophy of this command is to concentrate the greatest number of functions in the fewest user actions.

In addition to the previous capabilities:
- individual creation/renumbering of texts based on the cursor position
- multiple renumbering of texts using a selection window, thanks to the momentary activation of the 'V' key...

The following has been added:
- readjustment of the renumbering criteria for multiple texts ('V' key option): from now on, renumbering will be done based on proximity to the first corner indicated on the screen of the selection window.

That is, if the selection window is from Northwest to Southwest, the renumbering increment will be in order from least to greatest distance from the Northwest corner.

- In addition, the definition of the real-time selection window is discontinuous to differentiate it from others.

  

;******* <<S o m e t h i n g   d i f f e r e n t  V.2.1>> *******
;*******************  p o r d e s í a r g o  ********************
;************************ G L A V C V S *************************
;************************** F E C I T ***************************
(defun c:txtIncrem  (/ tam    capa   ind    para   a	  c	 cl
		       txsel  le     l	    s	   dameTexto	 uconfig
		       obtcad ent    loc    tipC   nC	  ps	 add
		       errores	     error0 v	   actTX  ventanea
		       pv     n	     cj	    acdoc  md	  listOrda
		       pr     lt     f
		      )
  (defun errores (mens)
    (setq *error* error0)
    (while (>= (boole 1 (getvar "UNDOCTL") 8) 8)
      (vla-endundomark acdoc)
    )
    (prin1)
  )

  (defun dameTexto (cad / v r l daleVuelta)
    ;;; WRITE HERE THE CODE YOU NEED TO CUSTOMIZE THE TEXT YOU WANT TO ENTER OR CREATE
    (defun daleVuelta (a)
      (cond
        ((and (> a 64) (< a 91)) (if (> (setq a (+ a 1)) 90) (setq a -65) a))
        ((and (> a 96) (< a 123)) (if (> (setq a (+ a 1)) 122) (setq a -97) a))
        ((and (> a 47) (< a 58)) (if (> (setq a (+ a 1)) 57) (setq a -48) a))
      )
    )
    (foreach v (reverse (vl-string->list cad))
      (if (or (not r) (minusp r))
        (setq l (cons (abs (setq r (daleVuelta v))) l))
        (setq l (cons v l))
      )
    )
    (vl-list->string (if (minusp r) (cons (if (= r -48) 49 (car l)) l) l))
  )
  
  (defun ventanea (/ p no se)
    (if (listp (setq p (cadr l)))
      (progn
	(redraw)
        (grvecs (list -7 pv (setq no (list (car pv) (cadr p)))))
	(grvecs (list -7 pv (setq se (list (car p) (cadr pv)))))
	(grvecs (list -7 no p))
	(grvecs (list -7 se p))
      )
    )
  )

  (defun actTX (e / le)
    (entmod (subst (cons 1 tx) (assoc 1 (setq le (entget e))) le))
    (setq tx (dameTexto tx))
    nil
  )

  (defun listOrda (cj pr / e n l)
    (vl-sort
      (while (setq e (ssname cj (setq n (if n (1+ n) 0))))
        (setq l (cons (list (cdr (assoc 10 (entget e))) e) l))
      )
      '(lambda (a b)
         (< (distance pr (car a)) (distance pr (car b)))
       )
    )
  )
    
  (setq	error0	*error*
	*error*	errores
  )
  (setq acdoc (vla-get-activedocument (vlax-get-acad-object)))
  (while (>= (boole 1 (getvar "UNDOCTL") 8) 8)
    (vla-endundomark acdoc)
  )
  (princ (setq s "Select PREVIOUS number text or type it... "))
  (while (not para)
    (setq l (grread T 13 2))
    (if (not (listp (cadr l)))
      (if (member (car l) '(2 3 11 25))
	(cond
	  ((or (= (cadr l) 13) (= (car l) 25) (= (car l) 11))
	    (if (and c (not (wcmatch c "*.*")))
	      (setq ind c para T)
	      (if (not c) (setq para T))
	    )
	  )
	  ((> (cadr l) 31)
            (setq c (if c (strcat c (chr (cadr l))) (chr (cadr l))))
	    (prompt (strcat "\r" s c))
	  )
	  ((= (cadr l) 8)
            (if (setq c (if c (substr c 1 (- (strlen c) 1))))
	      (prompt (strcat "\r" s c))
	    )
	  )
	  (T (princ) )
	)
      )
      (if (= (car l) 3)
	(if (and (setq e (nentselp (cadr l))) (= (cdr (assoc 0 (setq le (entget (setq e (car e)))))) "TEXT"))
	  (if (not (wcmatch (setq ind (cdr (assoc 1 le))) "*.*"))
	    (setq capa (cdr (assoc 8 le)) a (cdr (assoc 40 le)) cl (cdr (assoc 62 le)) para T)
	    (princ "\n*** The selected object is not valid. Please, try again... ***")
	  )
	)
      )
    )
  )
  (setq para nil)
  (if (not capa)
    (while (not para)
      (if (and (setq e (car (entsel "\nLAYER/HEIGHT: Select a sample text object (ENTER or RIGHT CLICK to type it)... ")))
	       (setq l (entget e))
	  )
	(if (= (cdr (assoc 0 l)) "TEXT")
	  (setq	capa (cdr (assoc 8 l)) a (cdr (assoc 40 l)) para T)
	  (princ "\n*** The selected object is not a TEXT. Please, try again... ***")
	)
	(if (not capa)
	  (if (setq capa (getstring "\nType Layer name: "))
	    (if (tblsearch "layer" capa)  
	      (if (not (setq a (getreal "\nType Height: ")))
		(setq capa (princ "\n*** A valid height has not been specified. Please, type it again... ***") capa nil)
		(setq para T)
	      )	      
	      (setq capa (princ "\n*** Specified layer does not exist. Please, type it again... ***") capa nil)
	    )
	  )
	)	  
      )
    )
  )
  (setq tx (dameTexto ind) s nil)
  (while ;(and (setq l (grread T (if s 4 13) (if s 2 0))) (member (car l) '(5 3 2)))
    (and (setq l (grread T (cond (s 4) (v 4) (T 13)) (cond (s 2) ((and pv v) 1) (v 2) (T 0)))) (member (car l) '(5 3 2)))
    (prompt (strcat "\rSelect text to modify or insert new text \"" tx "\" (<V> for ON/OFF multiple selection or <RIGHT CLICK> for exit)"))
    (setq tam (* (getvar "pickbox") (/ (GETVAR "VIEWSIZE") (CADR (GETVAR "SCREENSIZE")))) para nil n nil)
    (if (= (car l) 2)
      (cond
	((member (cadr l) '(86 118))
	 (setq v (not v))
	)
;;;	HERE MORE CASES ?...(ascii "V")
      )
      (if (or v
	      (setq s (ssget "_C" (list (- (car (setq p (cadr l))) tam) (- (cadr p) tam))
			      (list (+ (car p) tam) (+ (cadr p) tam))
		              (list (cons 0 "TEXT"))
		      )
	      )
	  )
        (cond
	  ((= (car l) 3)
	   (if s
	     (setq md (vla-startundomark acdoc) s (actTX (ssname s 0)))
	     (if pv
	       (if (setq cj (ssget "_C" pv (cadr l) (list (cons 0 "TEXT"))) lt (if cj (listOrda cj pv)) pv (if cj (vla-startundomark acdoc)) v (redraw) lt lt)
;;;		 (while (setq e (ssname cj (setq n (if n (1+ n) 0))))
		 (foreach f lt
		   (actTX (cadr f))
		 )
	       )
	       (setq pv (cadr l))
	     )
	   )
	  )
	      
	  ((and pv (= (car l) 5) (not s))
	    (ventanea)
	  )
	  (T (princ) )
;;;	HERE MORE CASES ?...
        )
        (cond
	  ((= (car l) 3)
	   (entmake (list
		      '(0 . "TEXT")
			  (cons 8 capa)
			  (cons 62 (if cl cl 256))
			  (cons 40 a)
			  (cons 1 tx)
			  (cons 10 (list (car p) (cadr p) 0.0))
		    )
	   )
	   (setq tx (dameTexto tx))
	  )
	  (T
	   (if (/= (car l) 5) (princ) )
	  )
;;;	HERE MORE CASES ?...
        )
      )
    )
  )
  (while (>= (boole 1 (getvar "UNDOCTL") 8) 8)
    (vla-endundomark acdoc)
  )
  (princ)
)

 

  • Like 3
  • Thanks 1
leonucadomi Proficient

leonucadomi

Posted
  • Author
Posted
5 minutes ago, GLAVCVS said:

A couple of loose ends to tie up the all-too-fast V.2 release:
-Multiple renumbering is currently done based on the order of the objects in the database: this looks ugly if the dispersion is too random.
-As PGia has suggested, perhaps I should leave a brief explanation of the code's functionality.

So, let's get to it:
 

I've added a couple of improvements to the code that makes up the new version of <<Something different>>, which I've attached below.

 

What's New in Version 2.1
The philosophy of this command is to concentrate the greatest number of functions in the fewest user actions.

In addition to the previous capabilities:
- individual creation/renumbering of texts based on the cursor position
- multiple renumbering of texts using a selection window, thanks to the momentary activation of the 'V' key...

The following has been added:
- readjustment of the renumbering criteria for multiple texts ('V' key option): from now on, renumbering will be done based on proximity to the first corner indicated on the screen of the selection window.

That is, if the selection window is from Northwest to Southwest, the renumbering increment will be in order from least to greatest distance from the Northwest corner.

- In addition, the definition of the real-time selection window is discontinuous to differentiate it from others.

  

;******* <<S o m e t h i n g   d i f f e r e n t  V.2.1>> *******
;*******************  p o r d e s í a r g o  ********************
;************************ G L A V C V S *************************
;************************** F E C I T ***************************
(defun c:txtIncrem  (/ tam    capa   ind    para   a	  c	 cl
		       txsel  le     l	    s	   dameTexto	 uconfig
		       obtcad ent    loc    tipC   nC	  ps	 add
		       errores	     error0 v	   actTX  ventanea
		       pv     n	     cj	    acdoc  md	  listOrda
		       pr     lt     f
		      )
  (defun errores (mens)
    (setq *error* error0)
    (while (>= (boole 1 (getvar "UNDOCTL") 8) 8)
      (vla-endundomark acdoc)
    )
    (prin1)
  )

  (defun dameTexto (cad / v r l daleVuelta)
    ;;; WRITE HERE THE CODE YOU NEED TO CUSTOMIZE THE TEXT YOU WANT TO ENTER OR CREATE
    (defun daleVuelta (a)
      (cond
        ((and (> a 64) (< a 91)) (if (> (setq a (+ a 1)) 90) (setq a -65) a))
        ((and (> a 96) (< a 123)) (if (> (setq a (+ a 1)) 122) (setq a -97) a))
        ((and (> a 47) (< a 58)) (if (> (setq a (+ a 1)) 57) (setq a -48) a))
      )
    )
    (foreach v (reverse (vl-string->list cad))
      (if (or (not r) (minusp r))
        (setq l (cons (abs (setq r (daleVuelta v))) l))
        (setq l (cons v l))
      )
    )
    (vl-list->string (if (minusp r) (cons (if (= r -48) 49 (car l)) l) l))
  )
  
  (defun ventanea (/ p no se)
    (if (listp (setq p (cadr l)))
      (progn
	(redraw)
        (grvecs (list -7 pv (setq no (list (car pv) (cadr p)))))
	(grvecs (list -7 pv (setq se (list (car p) (cadr pv)))))
	(grvecs (list -7 no p))
	(grvecs (list -7 se p))
      )
    )
  )

  (defun actTX (e / le)
    (entmod (subst (cons 1 tx) (assoc 1 (setq le (entget e))) le))
    (setq tx (dameTexto tx))
    nil
  )

  (defun listOrda (cj pr / e n l)
    (vl-sort
      (while (setq e (ssname cj (setq n (if n (1+ n) 0))))
        (setq l (cons (list (cdr (assoc 10 (entget e))) e) l))
      )
      '(lambda (a b)
         (< (distance pr (car a)) (distance pr (car b)))
       )
    )
  )
    
  (setq	error0	*error*
	*error*	errores
  )
  (setq acdoc (vla-get-activedocument (vlax-get-acad-object)))
  (while (>= (boole 1 (getvar "UNDOCTL") 8) 8)
    (vla-endundomark acdoc)
  )
  (princ (setq s "Select PREVIOUS number text or type it... "))
  (while (not para)
    (setq l (grread T 13 2))
    (if (not (listp (cadr l)))
      (if (member (car l) '(2 3 11 25))
	(cond
	  ((or (= (cadr l) 13) (= (car l) 25) (= (car l) 11))
	    (if (and c (not (wcmatch c "*.*")))
	      (setq ind c para T)
	      (if (not c) (setq para T))
	    )
	  )
	  ((> (cadr l) 31)
            (setq c (if c (strcat c (chr (cadr l))) (chr (cadr l))))
	    (prompt (strcat "\r" s c))
	  )
	  ((= (cadr l) 8)
            (if (setq c (if c (substr c 1 (- (strlen c) 1))))
	      (prompt (strcat "\r" s c))
	    )
	  )
	  (T (princ) )
	)
      )
      (if (= (car l) 3)
	(if (and (setq e (nentselp (cadr l))) (= (cdr (assoc 0 (setq le (entget (setq e (car e)))))) "TEXT"))
	  (if (not (wcmatch (setq ind (cdr (assoc 1 le))) "*.*"))
	    (setq capa (cdr (assoc 8 le)) a (cdr (assoc 40 le)) cl (cdr (assoc 62 le)) para T)
	    (princ "\n*** The selected object is not valid. Please, try again... ***")
	  )
	)
      )
    )
  )
  (setq para nil)
  (if (not capa)
    (while (not para)
      (if (and (setq e (car (entsel "\nLAYER/HEIGHT: Select a sample text object (ENTER or RIGHT CLICK to type it)... ")))
	       (setq l (entget e))
	  )
	(if (= (cdr (assoc 0 l)) "TEXT")
	  (setq	capa (cdr (assoc 8 l)) a (cdr (assoc 40 l)) para T)
	  (princ "\n*** The selected object is not a TEXT. Please, try again... ***")
	)
	(if (not capa)
	  (if (setq capa (getstring "\nType Layer name: "))
	    (if (tblsearch "layer" capa)  
	      (if (not (setq a (getreal "\nType Height: ")))
		(setq capa (princ "\n*** A valid height has not been specified. Please, type it again... ***") capa nil)
		(setq para T)
	      )	      
	      (setq capa (princ "\n*** Specified layer does not exist. Please, type it again... ***") capa nil)
	    )
	  )
	)	  
      )
    )
  )
  (setq tx (dameTexto ind) s nil)
  (while ;(and (setq l (grread T (if s 4 13) (if s 2 0))) (member (car l) '(5 3 2)))
    (and (setq l (grread T (cond (s 4) (v 4) (T 13)) (cond (s 2) ((and pv v) 1) (v 2) (T 0)))) (member (car l) '(5 3 2)))
    (prompt (strcat "\rSelect text to modify or insert new text \"" tx "\" (<V> for ON/OFF multiple selection or <RIGHT CLICK> for exit)"))
    (setq tam (* (getvar "pickbox") (/ (GETVAR "VIEWSIZE") (CADR (GETVAR "SCREENSIZE")))) para nil n nil)
    (if (= (car l) 2)
      (cond
	((member (cadr l) '(86 118))
	 (setq v (not v))
	)
;;;	HERE MORE CASES ?...(ascii "V")
      )
      (if (or v
	      (setq s (ssget "_C" (list (- (car (setq p (cadr l))) tam) (- (cadr p) tam))
			      (list (+ (car p) tam) (+ (cadr p) tam))
		              (list (cons 0 "TEXT"))
		      )
	      )
	  )
        (cond
	  ((= (car l) 3)
	   (if s
	     (setq md (vla-startundomark acdoc) s (actTX (ssname s 0)))
	     (if pv
	       (if (setq cj (ssget "_C" pv (cadr l) (list (cons 0 "TEXT"))) lt (if cj (listOrda cj pv)) pv (if cj (vla-startundomark acdoc)) v (redraw) lt lt)
;;;		 (while (setq e (ssname cj (setq n (if n (1+ n) 0))))
		 (foreach f lt
		   (actTX (cadr f))
		 )
	       )
	       (setq pv (cadr l))
	     )
	   )
	  )
	      
	  ((and pv (= (car l) 5) (not s))
	    (ventanea)
	  )
	  (T (princ) )
;;;	HERE MORE CASES ?...
        )
        (cond
	  ((= (car l) 3)
	   (entmake (list
		      '(0 . "TEXT")
			  (cons 8 capa)
			  (cons 62 (if cl cl 256))
			  (cons 40 a)
			  (cons 1 tx)
			  (cons 10 (list (car p) (cadr p) 0.0))
		    )
	   )
	   (setq tx (dameTexto tx))
	  )
	  (T
	   (if (/= (car l) 5) (princ) )
	  )
;;;	HERE MORE CASES ?...
        )
      )
    )
  )
  (while (>= (boole 1 (getvar "UNDOCTL") 8) 8)
    (vla-endundomark acdoc)
  )
  (princ)
)

 

Wow, this looks like magic.

leonucadomi Proficient

leonucadomi

Posted
  • Author
Posted

The only thing missing is to number blocks with attributes or individual attributes.

  • Agree 1
BIGAL Grand Master

BIGAL

Posted
Posted (edited)

Editing blocks needs a separate function so check is it TEXT, MTEXT or a BLOCK, if a block does it have attributes, to complicate more if it has more than one attribute which one to put the number in ? There are ways around this like pick attribute in a block can get Block name and Tagname.

 

This may be useful makes a block with a number.

 

 

pt num bub 2.png

Pt num bubble.lsp

Edited by BIGAL
  • Thanks 1

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
 Share
Go to topic listing
×
×
  • Create New...