numbering routine help...

[Nikon]

18 hours ago, GLAVCVS said:

;******* <<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

An interesting feature is that if you select a text like L1, the numbering continues to L9, then comes M0...M9, etc.

Edited May 3 by Nikon

[Vica]

On 5/3/2025 at 12:27 AM, 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)
)

 

 

Nice!

[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> is going on 'holidays' and won't be serving any more requests for a while

I'm attaching the description and new features of V.3:
- Individual creation/renumbering of TEXTs and MTEXTs based on the cursor position
- Multiple renumbering of TEXTs/MTEXTs via selection window (option key 'V') 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 Southeast, the renumbering increment will be in order from least to greatest distance from the Northwest corner
 

Added in this version:
- Ability to detect and renumber block attributes using the same criteria as 'TEXT' and 'MTEXT' attributes.
(Note: This may not work for block attributes with multiple levels of nesting.)
- New functionality (by pressing the 'A' key) to change text alignment on the fly.

 

A preview of how it works:

 

 

SDifferent_V3.lsp

Edited May 5 by GLAVCVS