Leaderboard

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'

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) )

Do you have a before and after drawing?

I think I understand how it works. I've had to change my mental patterns, hahaha. It's fantastic!!

wow this routine is wonderful thank you

I look later today if I have time. I fixed your first one by debugging it. If you use the VLIDE to debug, have a look at Debugging Code with the Visual LISP IDE | Lee Mac Programming For the Blade Debugging BLADE Debugging LISP with Steve Johnson - “BricsCAD® Unplugged” Visual Studio Code

@JerryFiedler " Reinaldo N. Togores" he has 4 books at least, look on Kindle can copy code from Kindle and paste into your lisp. Very cheap.

If you understand support paths OPTIONS FILES, you just need to add the loaction opf where files are saved, you can then use a short version of (load "mylisp22") the mylisp22.lsp can be located anywhere the CAD will look at the support path and use that starting with top path and try to find it. It auto adds the full path to the file name. Re memory problems there is a lisp Function "AUTOLOAD" it allows you to load a lisp when you type the correct command name, it is not loaded till you type the command. An example of a custom lisp I call autoload.lsp. Loaded using Appload save into Start up suite. Way bigger than shown. Note for Acad need to add also to trusted paths, ;The dtr function converts degrees to radians ;The rtd function converts radians to degrees (defun dtr (a) (* pi (/ a 180.0)) ) ; (defun rtd (a) (/ (* a 180.0) pi) ) (setq pi2 (/ pi 2.0)) ; 90 degs up ; pi is 180 degs left (setq pi3 (* pi 1.5)) ; 270 degs down (autoload "COPY0" '("COPY0")) (autoload "COPYCOMMAND" '("ZZZ")) (autoload "COVER" '("COVER")) (autoload "DIMFLIP" '("DIMFLIP")) (autoload "DRAWXFALL" '("DRAWXFALL")) (defun c:vp3 () (command "-vpoint" "1,1,1")) (defun C:ZE () (command "zoom" "E") ) (defun C:15 ()(setvar "osmode" 15359)) ; sets all snaps on (defun C:47 ()(setvar "osmode" 47)(setvar "AUNITS" 0)) (defun C:99 ()(setvar "osmode" 99)) (defun C:8 ()(setvar "osmode" 8)) (defun C:9 ()(setvar "osmode" 9)) (defun C:0 ()(setvar "osmode" 0))

After some thinking, if you look at the loaded files in appload or even if you load by drag and drop, the path to the file is displayed. AutoCAD is storing it somewhere. Another thread on the issue... How to get the path of the downloaded lisp file - AutoLISP, Visual LISP & DCL - AutoCAD Forums

Similar to the above, I have this to load all files in a location: You can save your *.lsp files where you want and add this to each users startup suit - you can keep control of this file in a shared location if you want to add more locations as required. Note that if this is saved in the same location as 'MyLispFolder' (in the LISP) then don't auto-run this as it is loaded else it loops forever (load, runs, loads itself and runs, loads and runs...). (defun c:appreload ( / MyLispFolder myfiles acount mylistlength Failedtoload) ;;Define LISP files folder. (setq MyLispFolder "C:\\Users\\SP\\CAD\\") (setq myfiles (vl-directory-files mylispfolder "*.lsp" nil)) ;;Get *.lsp file list (setq mylistlength (length myfiles)) ;;count of number of lsp files (setq acount -1) (repeat mylistlength ;;Loop each file (setq acount (1+ acount)) (setq FailedtoLoad (strcat (nth acount myfiles) " failed to load")) ;; Error message (load (strcat mylispfolder (nth acount myfiles)) FailedtoLoad) ;;Load *.lsp file ) (princ "\n") (princ mylistlength) (princ " lsp files loaded from ") (princ mylispfolder) (princ) ) There is also this option, a bit more work to set up and add to startup suit, loads the LISP on demand, however if you have a lot of (large) LISPs it can make CAD start-up quicker (defun c:0,0 ( / ) ;; duplicate of a LISP name (load "C:\\Users\\SP\\OneDrive\\Desktop\\AutoCAD\\AutoCAD LISPS\\SIMPLELISP.lsp") ;; Load file that the 'real' c:0,0 is saved in (c:0,0) ;; Run 0,0 (princ) ;; exit quietly )

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)) )