Undoing variable incremental

March 3

Hello,

I'm new to AutoLISP and I am currently working on a rutine for incrementing text objects content (that contains numerical value) based on chosen prefix by user and chosen incremental/decremental step. So in last step of rutine user is prompted to click on as many text/mtext object as they want and on each click content of chosen object is replaced by prefixText+incNum+suffixText where the incNum is incremented by chosen step after click, my question is: is there any way to decrease incNum by a step after calling 'undo' (in case of wrong pick by a user)?

I tried wrapping it into undo command and undo group but nothing seems to work. I tried Googling for an answer, and also tried asking LLM but I can't find a solution. I assume it's maybe not even possible but I just wanted to check here before I give up since I found a lot of useful things here and I know that here are some experts who can know a bit more about my problem.

P.S. - I'm using ZWCad, and sorry for maybe a little bit bad English.

March 3

Welcome to Cadtutor Fidelojo.

It would be a good idea when you post a question to attach a sample drawing + lisp file or paste / type the code you have so far (use the <> symbol left to the smiley). That way other users have a better start and understanding of what you try to accomplish.

March 3

Hi @Fidelojo
Yes, there is a way: you can store the value of 'incNum', every time you modify a text, in the variable 'USERI1'. The content of this variable is sensitive to '_undo' and will retrieve the value you need.
All this is like this in AutoCAD, but in ZWCAD, I don't know about it.

Try it

Edited March 3 by GLAVCVS

Monday at 11:03 PM

A better place to save a value is using LDATA as some one else's code may reset the "Userxx", you can also do a UNDO mark so can go back many undo's in one step.

(setq  num (vlax-ldata-get "numinc" "num" ))

(vlax-ldata-put "numinc" "num" x)

Tuesday at 12:19 AM

Another option if you want it to persist between drawings and even restarting your computer is writing it to your registry

(setenv "NUM" "12345")
(princ (getenv "NUM"))  ; Output: "12345"

Tuesday at 09:36 AM

Thank you all for feedback!

14 hours ago, rlx said:

Welcome to Cadtutor Fidelojo.

It would be a good idea when you post a question to attach a sample drawing + lisp file or paste / type the code you have so far (use the <> symbol left to the smiley). That way other users have a better start and understanding of what you try to accomplish.

Sorry for that, here is the main function:

(defun C:TNC ( / *error* oldErr osm mainObject mainText prefixText userInput position incNum suffixText incStep targetObject targetData prefixList)
	
	;; Rutine for increasing number in text object by chosen prefix and costum incremental step
    ;; Functions declaration: LM is by Lee Mac, AT is by Alan J. Thompson, MM are mine.
	
	(setq oldErr *error*
          *error* LM:error)
	
	(setq osm (getvar 'osmode))
    (setvar 'osmode 0)
	
	(setq mainObject (car (entsel "\nSelect text object: ")))
	
	(while  (or 
				(= mainObject nil)  ; Check if user clicked on background
			    (and (not (= "AcDbText" (vla-get-objectname (vlax-ename->vla-object mainObject))))  ; Check if user clicked on Text object
					 (not (= "AcDbMText" (vla-get-objectname (vlax-ename->vla-object mainObject)))))  ; Check if user clicked on MText object
				(not (MM:contains-number (LM:remove-rich-format (vla-get-TextString (vlax-ename->vla-object mainObject)))))  ; Check if text object contains any numbers
			) ; or end
		(setq mainObject (car (entsel "\nInvalid selection, try again: ")))  ; Returns user information of invalid selection
	) ; while end
	
	(setq mainText (vla-get-TextString (vlax-ename->vla-object mainObject)))  ; Get selected text object content
	(setq mainText (LM:remove-rich-format mainText))  ; Remove rich text format from text (UnFormat String by Lee Mac)
	
	(if (MM:all-numbers (MM:trim-non-numerical-from-sides mainText))  ; Check if there's only one number value in text
			(setq incNum (MM:trim-non-numerical-from-sides mainText)  ; Set number as text with trimmed non-numeric values from sides
				  position (vl-string-search incNum mainText)  ; Set position where number starts
				  prefixText (substr mainText 1 position)  ; Set prefix as everything before number
				  suffixText (substr mainText (1+ (+ position (strlen incNum)))))  ; Set suffix as everything after number
		
		;; ELSE
		(progn
			(setq position 2)  ; Set position on second character
	
			(if (vl-string-search (substr mainText 1 1) "0123456789")  ; Check if first character is number
				(setq prefixList (cons "No prefix" prefixList))  ; Add option with no prefix
			) ; if end
			
			(while (<= position (strlen mainText))  ; While not end of string
				(if (and (vl-string-search (substr mainText position 1) "0123456789")  ; Check if there's a number at current position
						 (not (vl-string-search (substr mainText (1- position) 1) "0123456789")))  ; Check if there's not a number at previous position
					(setq prefixList (cons (substr mainText 1 (1- position)) prefixList))  ; Get prefix before current number
				)
				(setq position (1+ position))  ; Go to next character in a string
			) ; while end
			
			(setq userInput (car (AT:list-select prefixList)))  ; Open dialog box with all possible prefixes and save user selection
			
			(if (= userInput "No prefix")  ; Check if user selected "No prefix" option (else means that some prefix is selected)
				(setq prefixText ""  ; Set prefix as nothing
					  suffixText (vl-string-left-trim "0123456789" mainText)  ; Set suffix as text without starting numbers
					  incNum (vl-string-subst "" suffixText mainText))  ; Set number as part without suffix
				;; ELSE
				(progn
				(setq prefixText userInput  ; Set prefix as prefix selected by user
					  suffixText (vl-string-left-trim "0123456789" (substr mainText (1+ (strlen prefixText))))  ; Set suffix as text without prefix and leading numbers
					  incNum (substr mainText (1+ (strlen prefixText)) (- (strlen mainText) (strlen suffixText) (strlen prefixText))))  ; Set number as a part after prefix
				)
			) ; if end
		) ; progn end
	) ; if end

	(setq incStep 1)
	
	(while
		(progn
			(setvar 'errno 0)
			(initget "Step Exit")
			(setq targetObject (entsel "\nSelect destination block [Step/Exit] <Step>: "))
			(cond
				((= 7 (getvar 'errno))  ; Check if clicked on background
                    (princ "\nMissed, try again.")
                )  ; End of first condition
				
				((or (= "" targetObject) (= "Step" targetObject))  ; Check if user want change step
					(while
						(progn
							(setq userInput (getstring (strcat "\nEnter increase step: ")))
							(cond 
								((and (vl-string-search (substr userInput 1 1) "-+0123456789")  ; Check if first character is valid
									(MM:all-numbers (substr userInput 2)))  ; Check if rest of input is valid
									(setq incStep (atoi userInput))
									nil
								)  ; End of second condition
								(t (princ "\nInvalid input, try again."))
							) ; cond end
						) ; progn end
					) ; while end
					T ; return 'true'
                )  ; End of second condition
				
                ((= "Exit" targetObject)  ; Check if user want to exit
					(princ "\nNo more destination blocks selected. Exiting.")
                    nil ; return 'false'
                )  ; End of third condition
				
				((or (= (cdr (assoc 0 (entget (car targetObject)))) "TEXT")(= (cdr (assoc 0 (entget (car targetObject)))) "MTEXT"))  ; Check if text or mtext is chosen
					(setq targetData (entget (car targetObject)))  ; Get choosen objects data
					(setq incNum (MM:increase-number incNum incStep))  ; Increase number
					(entmod (subst (cons 1 (strcat prefixText incNum suffixText)) (assoc 1 targetData) targetData))  ; Change object content
				)  ; End of fourth condition
				
				(t (princ "\nInvalid selection, try again: "))
			) ; cond end
		) ; progn end
	) ; while end
	
	(setvar 'osmode osm)
	(setq *error* olderr)
	
	(princ)
) ; TNC end

If needed I can also provide a helper functions. Also this code probably can be optimized, but i don't know how, this is my current max.

This is the part for pasting content with increased number part:

((or (= (cdr (assoc 0 (entget (car targetObject)))) "TEXT")(= (cdr (assoc 0 (entget (car targetObject)))) "MTEXT"))  ; Check if text or mtext is chosen
					(setq targetData (entget (car targetObject)))  ; Get choosen objects data
					(setq incNum (MM:increase-number incNum incStep))  ; Increase number
					(entmod (subst (cons 1 (strcat prefixText incNum suffixText)) (assoc 1 targetData) targetData))  ; Change object content
				)  ; End of fourth condition

So the way I think about solution to my problem (probably wrong thinking) is to somehow trigger step subtraction after UNDO is called.

@GLAVCVS thanks for answering but due to answer by BIGAL I thing that I might have some problems with your solution since I have a several active scripts in every drawing.

@mhupp thanks for the answer, it's just that there is no need for persisting a value between drawings for now, but thanks anyway.

This looks like something that might work for my code:

9 hours ago, BIGAL said:
A better place to save a value is using LDATA as some one else's code may reset the "Userxx", you can also do a UNDO mark so can go back many undo's in one step.
(setq  num (vlax-ldata-get "numinc" "num" ))

(vlax-ldata-put "numinc" "num" x)

But I'm not sure how. Multiple undo's is also something I want to cover. I looked into documentation here and here but I can't figure out how to implement it in my code. If someone can please clarify this a bit? Are functions vlax-ldata-get and vlax-ldata-put only things needed for my case or should there also be some subtraction?

Tuesday at 01:08 PM

3 hours ago, Fidelojo said:

Thank you all for feedback!

Sorry for that, here is the main function:

(defun C:TNC ( / *error* oldErr osm mainObject mainText prefixText userInput position incNum suffixText incStep targetObject targetData prefixList)
	
	;; Rutine for increasing number in text object by chosen prefix and costum incremental step
    ;; Functions declaration: LM is by Lee Mac, AT is by Alan J. Thompson, MM are mine.
	
	(setq oldErr *error*
          *error* LM:error)
	
	(setq osm (getvar 'osmode))
    (setvar 'osmode 0)
	
	(setq mainObject (car (entsel "\nSelect text object: ")))
	
	(while  (or 
				(= mainObject nil)  ; Check if user clicked on background
			    (and (not (= "AcDbText" (vla-get-objectname (vlax-ename->vla-object mainObject))))  ; Check if user clicked on Text object
					 (not (= "AcDbMText" (vla-get-objectname (vlax-ename->vla-object mainObject)))))  ; Check if user clicked on MText object
				(not (MM:contains-number (LM:remove-rich-format (vla-get-TextString (vlax-ename->vla-object mainObject)))))  ; Check if text object contains any numbers
			) ; or end
		(setq mainObject (car (entsel "\nInvalid selection, try again: ")))  ; Returns user information of invalid selection
	) ; while end
	
	(setq mainText (vla-get-TextString (vlax-ename->vla-object mainObject)))  ; Get selected text object content
	(setq mainText (LM:remove-rich-format mainText))  ; Remove rich text format from text (UnFormat String by Lee Mac)
	
	(if (MM:all-numbers (MM:trim-non-numerical-from-sides mainText))  ; Check if there's only one number value in text
			(setq incNum (MM:trim-non-numerical-from-sides mainText)  ; Set number as text with trimmed non-numeric values from sides
				  position (vl-string-search incNum mainText)  ; Set position where number starts
				  prefixText (substr mainText 1 position)  ; Set prefix as everything before number
				  suffixText (substr mainText (1+ (+ position (strlen incNum)))))  ; Set suffix as everything after number
		
		;; ELSE
		(progn
			(setq position 2)  ; Set position on second character
	
			(if (vl-string-search (substr mainText 1 1) "0123456789")  ; Check if first character is number
				(setq prefixList (cons "No prefix" prefixList))  ; Add option with no prefix
			) ; if end
			
			(while (<= position (strlen mainText))  ; While not end of string
				(if (and (vl-string-search (substr mainText position 1) "0123456789")  ; Check if there's a number at current position
						 (not (vl-string-search (substr mainText (1- position) 1) "0123456789")))  ; Check if there's not a number at previous position
					(setq prefixList (cons (substr mainText 1 (1- position)) prefixList))  ; Get prefix before current number
				)
				(setq position (1+ position))  ; Go to next character in a string
			) ; while end
			
			(setq userInput (car (AT:list-select prefixList)))  ; Open dialog box with all possible prefixes and save user selection
			
			(if (= userInput "No prefix")  ; Check if user selected "No prefix" option (else means that some prefix is selected)
				(setq prefixText ""  ; Set prefix as nothing
					  suffixText (vl-string-left-trim "0123456789" mainText)  ; Set suffix as text without starting numbers
					  incNum (vl-string-subst "" suffixText mainText))  ; Set number as part without suffix
				;; ELSE
				(progn
				(setq prefixText userInput  ; Set prefix as prefix selected by user
					  suffixText (vl-string-left-trim "0123456789" (substr mainText (1+ (strlen prefixText))))  ; Set suffix as text without prefix and leading numbers
					  incNum (substr mainText (1+ (strlen prefixText)) (- (strlen mainText) (strlen suffixText) (strlen prefixText))))  ; Set number as a part after prefix
				)
			) ; if end
		) ; progn end
	) ; if end

	(setq incStep 1)
	
	(while
		(progn
			(setvar 'errno 0)
			(initget "Step Exit")
			(setq targetObject (entsel "\nSelect destination block [Step/Exit] <Step>: "))
			(cond
				((= 7 (getvar 'errno))  ; Check if clicked on background
                    (princ "\nMissed, try again.")
                )  ; End of first condition
				
				((or (= "" targetObject) (= "Step" targetObject))  ; Check if user want change step
					(while
						(progn
							(setq userInput (getstring (strcat "\nEnter increase step: ")))
							(cond 
								((and (vl-string-search (substr userInput 1 1) "-+0123456789")  ; Check if first character is valid
									(MM:all-numbers (substr userInput 2)))  ; Check if rest of input is valid
									(setq incStep (atoi userInput))
									nil
								)  ; End of second condition
								(t (princ "\nInvalid input, try again."))
							) ; cond end
						) ; progn end
					) ; while end
					T ; return 'true'
                )  ; End of second condition
				
                ((= "Exit" targetObject)  ; Check if user want to exit
					(princ "\nNo more destination blocks selected. Exiting.")
                    nil ; return 'false'
                )  ; End of third condition
				
				((or (= (cdr (assoc 0 (entget (car targetObject)))) "TEXT")(= (cdr (assoc 0 (entget (car targetObject)))) "MTEXT"))  ; Check if text or mtext is chosen
					(setq targetData (entget (car targetObject)))  ; Get choosen objects data
					(setq incNum (MM:increase-number incNum incStep))  ; Increase number
					(entmod (subst (cons 1 (strcat prefixText incNum suffixText)) (assoc 1 targetData) targetData))  ; Change object content
				)  ; End of fourth condition
				
				(t (princ "\nInvalid selection, try again: "))
			) ; cond end
		) ; progn end
	) ; while end
	
	(setvar 'osmode osm)
	(setq *error* olderr)
	
	(princ)
) ; TNC end

If needed I can also provide a helper functions. Also this code probably can be optimized, but i don't know how, this is my current max.

This is the part for pasting content with increased number part:

((or (= (cdr (assoc 0 (entget (car targetObject)))) "TEXT")(= (cdr (assoc 0 (entget (car targetObject)))) "MTEXT"))  ; Check if text or mtext is chosen
					(setq targetData (entget (car targetObject)))  ; Get choosen objects data
					(setq incNum (MM:increase-number incNum incStep))  ; Increase number
					(entmod (subst (cons 1 (strcat prefixText incNum suffixText)) (assoc 1 targetData) targetData))  ; Change object content
				)  ; End of fourth condition

So the way I think about solution to my problem (probably wrong thinking) is to somehow trigger step subtraction after UNDO is called.

@GLAVCVS thanks for answering but due to answer by BIGAL I thing that I might have some problems with your solution since I have a several active scripts in every drawing.

@mhupp thanks for the answer, it's just that there is no need for persisting a value between drawings for now, but thanks anyway.

This looks like something that might work for my code:

But I'm not sure how. Multiple undo's is also something I want to cover. I looked into documentation here and here but I can't figure out how to implement it in my code. If someone can please clarify this a bit? Are functions vlax-ldata-get and vlax-ldata-put only things needed for my case or should there also be some subtraction?

If you use several Lisp and you don't know exactly what they do, then the best option is BIGAL: LDATA.
But you will have to assign them to an object that is safe from any contingency: 'activeDocument'

To assign it:

(vlax-ldata-put activeDocument 'valueIncrement value)

Tuesday at 02:03 PM

Of course:
'activeDocument' should be ...

(vlax-get-activedocument (vlax-get-modelSpace (vlax-get-acad-object)))

(I hope I haven't written anything wrong from my smartphone)

Tuesday at 06:46 PM

My humble opinion is that your ENTSEL function stands in the way between your dreams and success. It only accepts a selection. If you were to use GRREAD it would be possible to both detect if you clicked on something or pressed a key like 'u' for undo or 'tab' to switch between increment or decrement. Using the 'tab' key you could for example change the increment number from +1 to -1 , or with plus and minus keys you could increment , well , the increment. Not sure if I have something 'on the shelf' but I'm pretty sure searching this site could give you some results too.

Wednesday at 08:57 AM

So I tried using vlax-ldata-put and vlax-ldata-get (just for future info those are vla-ldata-put/vla-ldata-get in ZWCad), and I resolved all errors but now I found a new problem and that's that it seems it's not possible to undo when script is inside of while loop, so even if I make a mistake and have my number stored in LDATA I'm not able to undo last step and keep looping with decreased number, can someone just confirm that please?

Also thanks @rlx for pointing out the GRREAD function, I didn't even know that exists. It's awesome, but I didn't manage make it work for my problem, can't make it to undo wrong selection and decrease last number value by step. But it will certainly do for some future projects.

Wednesday at 09:43 AM

Hi
I just saw your code. I couldn't yesterday.
As RLX says, you can't ask 'entsel' to accept more arguments than a message to the user and a point (indicated on screen or by a list). In exchange for this, you should not expect it to return more than: either a list (point-entity name), or nil. This is true, at least in AutoCAD.
As for undoing the increment inside a 'while' loop, I think it should be possible for you to achieve it. Although it would be good if you shared the loop you are referring to so we can give you a more concrete opinion

Wednesday at 10:31 AM

I think that 'entsel' isn't a problem in my case, it probably can be replaced with some better input function but for my case I think (I might be wrong) it does just what I need, it takes info of chosen text object so I can alternate its content. Sure, if it's needed, I am willing to replace 'entsel' with something other in order to achieve functionality that I'm looking for if that's something that must be done.

Here is just the while loop for incrementing and pasting:

(while
	(progn
		(setvar 'errno 0)
		(initget "Step Exit")
		(setq targetObject (entsel "\nSelect destination block [Step/Exit] <Step>: "))
		(cond
			((= 7 (getvar 'errno))  ; Check if clicked on background
                   (princ "\nMissed, try again.")
               )  ; End of first condition
			
			((or (= "" targetObject) (= "Step" targetObject))  ; Check if user want change step
				(while
					(progn
						(setq userInput (getstring (strcat "\nEnter increase step: ")))
						(cond 
							((and (vl-string-search (substr userInput 1 1) "-+0123456789")  ; Check if first character is valid
								(MM:all-numbers (substr userInput 2)))  ; Check if rest of input is valid
								(setq incStep (atoi userInput))
								nil
							)  ; End of second condition
							(t (princ "\nInvalid input, try again."))
						) ; cond end
					) ; progn end
				) ; while end
				T ; return 'true'
               )  ; End of second condition
				
               ((= "Exit" targetObject)  ; Check if user want to exit
				(princ "\nNo more destination blocks selected. Exiting.")
                   nil ; return 'false'
               )  ; End of third condition
				
			((or (= (cdr (assoc 0 (entget (car targetObject)))) "TEXT")(= (cdr (assoc 0 (entget (car targetObject)))) "MTEXT"))  ; Check if text or mtext is chosen
				(setq targetData (entget (car targetObject)))  ; Get choosen objects data
				(setq incNum (MM:increase-number incNum incStep))  ; Increase number
				(entmod (subst (cons 1 (strcat prefixText incNum suffixText)) (assoc 1 targetData) targetData))  ; Change object content
			)  ; End of fourth condition
				
			(t (princ "\nInvalid selection, try again: "))
		) ; cond end
	) ; progn end
) ; while end

So in this part of script are prefix, number and suffix all already defined, and step is set to default of 1. Fourth condition is where the incrementation happens and the new content is pasted and here I thought that it's maybe possible to somehow detect when 'UNDO' happens and than make 'if condition' to handle incrementation/decrementation, but I don't know if that's possible and how to achieve it.

Wednesday at 03:44 PM

The problem, I think, is that 'entsel' is not suitable for what you need. Because the value that 'entsel' can deposit in 'targetObject' can only be a list '(entity_name point)' or 'nil'.
That is: it can never be "", nor "Step" nor "Exit"

Edited Wednesday at 03:46 PM by GLAVCVS

Wednesday at 10:16 PM

As already mentioned, when you pick a blank spot on the dwg you will get nil returned, so can then pop a choice exit or change step.

I use my Multi radio buttons as below its here in Downloads, you can use Acet-yes--no where yes would mean set Step, no is Exit, You can use initget "Exit Step". Yes I do use this method when asking to add to a table or start a new one.

Ps (exit) will do just that a built in lisp function.

Thursday at 12:13 AM

just a simplified example with GRREAD (only works for TEXT with integers and currently no undo built in)

(defun RlxSel1 ( $e-type / done-selecting inp i p2 result e ent)
  (princ (strcat "\nEsc, enter, Rmouse to cancel, zoom with E(extend), Z(oom) or + / -\nSelect " $e-type))
  (setq done-selecting nil)
  (while (not done-selecting)
    (setq inp (vl-catch-all-apply 'grread (list nil 4 2)))
    (if (vl-catch-all-error-p inp)
      (setq done-selecting t result nil)
      (cond
	; if point selected
	((= (car inp) 3)
	 ; if point has object under it
	 (if (setq ent (nentselp (cadr inp))) (setq e (car ent) typ (get_type e)))
	 (cond
	   ; if we have object and object is the right type we have a winner
	   ((and e typ (eq $e-type typ))
	    (redraw e 3)(setq done-selecting t result e))
	   ; maybe its the parent
	   ; this happens when type is dimension and you select dimensions text
	   ((and (caddr ent) (setq ent (last (last ent)))(eq $e-type (get_type ent)))
	    (redraw ent 3)(setq done-selecting t result ent))
	   ; sorry object is not the right stuf
	   ((and e typ (not (eq $e-type typ)))
	    (princ (strcat "\rYou selected the wrong type (" $e-type ")")))
	   ; else try crossing selection
	   (t
	    (if (and (setq i 0 p2 (getcorner (cadr inp) "\tOther corner : "))
		     (setq ss (ssget "c" (cadr inp) p2)))
	      (while (setq e (ssname ss i))
		(if (= (cdr (assoc 0 (entget e))) $e-type)
		  (progn (redraw e 3) (setq result e done-selecting t)))
		(setq i (1+ i))))
	   );end t
	  ); end cond
        ); end (= (car inp) 3)
	
	; user pressed E of e
	((member inp '((2 69)(2 101))) (command "zoom" "e"))
	; user clicked R-mouse button, pressed enter or space (done selecting)
	((or (equal (car inp) 25)(member inp '((2 13)(2 32))))
	 (setq done-selecting t result nil))
	; user pressed +
	((equal inp '(2 43)) (command "zoom" "2x"))
	; user pressed -
	((equal inp '(2 45)) (command "zoom" ".5x"))
	; user pressed z or Z
	((member inp '((2 122)(2 90))) (command "'zoom" ""))
        ;;; enter undo routine here
        ;;; ***********************
      )
    )
  )
  result
)

; 'kelvinated' (compressed) version of vt_splituptext
; (splitss (getvar 'dwgname)) -> ("06" "E" "001474" "S" "0011" ".DWG")
; (vl-remove-if-not 'distof (splitss "06E001474S0011.dwg")) -> ("06" "001474" "0011")
;;; (setq r (Splitss (cdr (assoc 1 (entget (car (entsel)))))))
(defun splitss (s / a c p l d i)
  (if (and s (= (type s) 'str)(> (strlen s) 0)(setq i 1)(setq d ""))(progn (if (wcmatch (substr s i 1) "#")(setq p "num")(setq p "s"))
   (while (<= i (strlen s))(if (wcmatch (substr s i 1) "#")(setq c "num")(setq c "s"))(if (= c p)(setq d (strcat d (substr s i 1)))
    (progn (setq l (append l (list d)) p c d (substr s i 1))))(setq i (1+ i)))(if (and d (/= d ""))(setq l (append l (list d)))))) l)

(defun isnum  (n)(if (distof n) t nil))

(defun get_type ( %o )
  (cond
    ((= (type %o) 'ENAME)(cdr (assoc 0 (entget %o))))
    ((= (type %o) 'VLA-object)(cdr (assoc 0 (entget (vlax-vla-object->ename  %o)))))
    (t nil)
  )
)

;;; test 1 : increment with 1
(defun c:t1 ( / inc sel)
  (setq inc 1)
  (while (setq sel (RlxSel1 "TEXT")) (inc_ent sel))
  (princ)
)

(defun inc_ent (e / ent ent-type str-lst new-str-lst new-str done s len)
  (cond
    ((null e)
     (alert "Computer says no : nothing selected"))
    ((not (eq (type e) 'ename))
     (alert (strcat "Computer says no : wrong type (" (vl-princ-to-string (type e)) ")")))
    ((not (eq (setq ent-type (cdr (assoc 0 (setq ent (entget e))))) "TEXT"))
     (alert (strcat "Computer says no : selected object is not a text (" (vl-princ-to-string ent-type) ")")))
    (t
     ;;; assuming last number must be incremented I reverse the string list and work from end to begin
     (setq done nil new-str-lst '() str-lst (reverse (Splitss (cdr (assoc 1 ent)))))
     (while (and (vl-consp str-lst) (not done) (setq s (car str-lst)))
       (setq str-lst (cdr str-lst))
       (if (isnum s)
         (progn
           ;;; make sure "001" becomes "002" and not "2"
           (setq len (strlen s))
           ;;; increment string with inc
           (setq s (itoa (+ inc (atoi s))))
           ;;; put back leading zero's
           (while (< (strlen s) len) (setq s (strcat "0" s)))
           ;;; save to new string list
           (setq new-str-lst (cons s new-str-lst) done T)
         )
         (setq new-str-lst (cons s new-str-lst))
       );;; end if
     );;; end while
     (while (vl-consp str-lst)
       (setq new-str-lst (cons (car str-lst) new-str-lst) str-lst (cdr str-lst)))
     ;;; put string back together
     (if (vl-consp new-str-lst) (setq new-str (apply 'strcat new-str-lst)))
     ;;; update text object
     (setq ent (subst (cons 1 new-str) (assoc 1 ent) ent))
     ;;; update ent
     (entmod ent)(entupd e)
    )
  )
)

for undo to work built an undo (assoc) list with ent + original text string and when undoing get last ent in list , reset text and remove it from undo-list.

Should look something like this : (setq undo-list (reverse (cdr (reverse undo-list))))

Unless you built this list with cons , then (setq undo-list (cdr undo-list)) will work too.

I do have a far more advanced program (VT.lsp) for my increment jobs , posted it years ago , which I still use to this day. Added lots of options through the years but most of them are so company specific I don't think its useful to post the latest version (also it still doesn't like Mtext) because I have no use for Mtext for my line of work so every time I see one I blow it out of the water.

Edited Thursday at 12:28 AM by rlx

Thursday at 07:48 AM

15 hours ago, GLAVCVS said:

The problem, I think, is that 'entsel' is not suitable for what you need. Because the value that 'entsel' can deposit in 'targetObject' can only be a list '(entity_name point)' or 'nil'.
That is: it can never be "", nor "Step" nor "Exit"

Just for clarification, the script I pasted (with all it's helper functions) works fine in my case, even the "Step" and "Exit" part, I'm not sure what can 'entsel' deposit into a variable but in my case writing only "S" or "s" in terminal directs me to changing step, same for exiting part.

9 hours ago, BIGAL said:

As already mentioned, when you pick a blank spot on the dwg you will get nil returned, so can then pop a choice exit or change step.

I use my Multi radio buttons as below its here in Downloads, you can use Acet-yes--no where yes would mean set Step, no is Exit, You can use initget "Exit Step". Yes I do use this method when asking to add to a table or start a new one.

Ps (exit) will do just that a built in lisp function.

That part works fine for now, but it wouldn't be bad to implement this pop-up menu in some future project's with multiple options, thanks for idea.

@rlx thanks for suggestion, I tried your script, it works nice, it's just that increasing part increases the last number and in my case I want to pick which part to increase based on prefix, it looks like this:

but I surely got the feeling of what GRREAD does and how to use it and I'm considering including it in my script, so thanks for that.

Also after browsing for solution I found out that it's not possible to undo an iteration of while loop when while loop is iterating, only when it's done (at least that what I found out), so I'll try saving all picked entities with their old content into a list, I'll add an "Undo" option next to "Step" and "Exit", and when "Undo" is triggered script will restore last changed entity to its previous content and remove it from the list.

For now that's just a plan, I'll notify here if everything goes well. Thanks all for help.

Thursday at 10:28 AM

18 hours ago, GLAVCVS said:

The problem, I think, is that 'entsel' is not suitable for what you need. Because the value that 'entsel' can deposit in 'targetObject' can only be a list '(entity_name point)' or 'nil'.
That is: it can never be "", nor "Step" nor "Exit"

@Fidelojo

I think I looked at your 'while' too quickly: I didn't notice 'initget'. I'm sure my comment confused you: SORRY.

Anyway, I can't test your code completely because there are functions that are called during execution that don't appear in the code.

Thursday at 11:37 AM

45 minutes ago, GLAVCVS said:

@Fidelojo

I think I looked at your 'while' too quickly: I didn't notice 'initget'. I'm sure my comment confused you: SORRY.

No problem

3 hours ago, Fidelojo said:

Also after browsing for solution I found out that it's not possible to undo an iteration of while loop when while loop is iterating, only when it's done (at least that what I found out), so I'll try saving all picked entities with their old content into a list, I'll add an "Undo" option next to "Step" and "Exit", and when "Undo" is triggered script will restore last changed entity to its previous content and remove it from the list.

For now that's just a plan, I'll notify here if everything goes well. Thanks all for help.

So just a feedback, it works as I planned!

Thanks all for help!!!

Here is full code:

(vl-load-com)

(defun C:TNC ( / *error* oldErr osm activeDoc docModelspace mainObject mainText prefixText userInput position incNum suffixText prefixList incStep targetObject targetData changedEntities)
	
	;; Rutine for increasing number in text object by chosen prefix and costum incremental step
	
	(setq oldErr *error*
          *error* LM:error)
	
	(setq osm (getvar 'osmode))
    (setvar 'osmode 0)
	
	(setq mainObject (car (entsel "\nSelect text object: "))
		  activeDoc (vla-get-activedocument (vlax-get-acad-object))
		  docModelspace (vla-get-modelspace activeDoc))
	
	(while  (or 
				(= mainObject nil)  ; Check if user clicked on background
			    (and (not (= "AcDbText" (vla-get-objectname (vlax-ename->vla-object mainObject))))  ; Check if user clicked on Text object
					 (not (= "AcDbMText" (vla-get-objectname (vlax-ename->vla-object mainObject)))))  ; Check if user clicked on MText object
				(not (MM:check-for-numbers "some" (LM:remove-rich-format (vla-get-TextString (vlax-ename->vla-object mainObject)))))  ; Check if text object contains any numbers
			) ; or end
		(setq mainObject (car (entsel "\nInvalid selection, try again: ")))  ; Returns user information of invalid selection
	) ; while end
	
	(setq mainText (vla-get-TextString (vlax-ename->vla-object mainObject)))  ; Get selected text object content
	(setq mainText (LM:remove-rich-format mainText))  ; Remove rich text format from text
	
	(if (MM:check-for-numbers "every" (MM:trim-non-numerical-from-sides mainText))  ; Check if there's only one number value in text
			(setq incNum (MM:trim-non-numerical-from-sides mainText)  ; Set number as text with trimmed non-numeric values from sides
				  position (vl-string-search incNum mainText)  ; Set position where number starts
				  prefixText (substr mainText 1 position)  ; Set prefix as everything before number
				  suffixText (substr mainText (1+ (+ position (strlen incNum)))))  ; Set suffix as everything after number
		
		;; ELSE
		(progn
			(setq position 2)  ; Set position on second character
	
			(if (vl-string-search (substr mainText 1 1) "0123456789")  ; Check if first character is number
				(setq prefixList (cons "No prefix" prefixList))  ; Add option with no prefix
			) ; if end
			
			(while (<= position (strlen mainText))  ; While not end of string
				(if (and (vl-string-search (substr mainText position 1) "0123456789")  ; Check if there's a number at current position
						 (not (vl-string-search (substr mainText (1- position) 1) "0123456789")))  ; Check if there's not a number at previous position
					(setq prefixList (cons (substr mainText 1 (1- position)) prefixList))  ; Get prefix before current number
				)
				(setq position (1+ position))  ; Go to next character in a string
			) ; while end
			
			(setq userInput (car (AT:list-select prefixList)))  ; Open dialog box with all possible prefixes and save user selection
			
			(if (= userInput "No prefix")  ; Check if user selected "No prefix" option (else means that some prefix is selected)
				(setq prefixText ""  ; Set prefix as nothing
					  suffixText (vl-string-left-trim "0123456789" mainText)  ; Set suffix as text without starting numbers
					  incNum (vl-string-subst "" suffixText mainText))  ; Set number as part without suffix
				;; ELSE
				(progn
				(setq prefixText userInput  ; Set prefix as prefix selected by user
					  suffixText (vl-string-left-trim "0123456789" (substr mainText (1+ (strlen prefixText))))  ; Set suffix as text without prefix and leading numbers
					  incNum (substr mainText (1+ (strlen prefixText)) (- (strlen mainText) (strlen suffixText) (strlen prefixText))))  ; Set number as a part after prefix
				)
			) ; if end
		) ; progn end
	) ; if end

	(setq incStep 1)
	
	(while
		(progn
			(setvar 'errno 0)
			(initget "Step Undo Exit")
			(setq targetObject (entsel "\nSelect destination block [Step/Undo/Exit]: "))
			(cond
				((= 7 (getvar 'errno))  ; Check if clicked on background
                    (princ "\nMissed, try again.")
                )  ; End of first condition
				
				((= "Step" targetObject)  ; Check if user want change step
					(while
						(progn
							(setq userInput (getstring (strcat "\nEnter increase step: ")))
							(cond 
								((and (vl-string-search (substr userInput 1 1) "-+0123456789")  ; Check if first character is valid
									(MM:check-for-numbers "every" (substr userInput 2)))  ; Check if rest of input is valid
									(setq incStep (atoi userInput))
									nil
								)  ; End of second condition
								(t (princ "\nInvalid input, try again."))
							) ; cond end
						) ; progn end
					) ; while end
					T ; return 'true'
                )  ; End of second condition
				
				((= "Undo" targetObject)  ; Check if user want to undo last change
                    (if changedEntities  ; Check if there are any changed objects
						(progn
							(entmod (car changedEntities))  ; Change last changed object to its previous content
							(setq changedEntities (cdr changedEntities)  ; Remove that object from a list of changed entities
								  incNum (MM:increase-number '- incNum incStep))  ; Decrease number
						)
						(princ "\nThere's no changes to undo.")
					)
                )  ; End of third condition
				
                ((= "Exit" targetObject)  ; Check if user want to exit
					(princ "\nNo more destination blocks selected. Exiting.")
                    (exit)
                )  ; End of fourth condition
				
				((or (= (cdr (assoc 0 (entget (car targetObject)))) "TEXT")(= (cdr (assoc 0 (entget (car targetObject)))) "MTEXT"))  ; Check if text or mtext is chosen
					(vla-StartUndoMark activeDoc)
					(setq targetData (entget (car targetObject))  ; Get choosen objects data
						  changedEntities (cons targetData changedEntities)  ; Save content of target object (for future undoing)
						  incNum (MM:increase-number '+ incNum incStep))  ; Increase number
					(entmod (subst (cons 1 (strcat prefixText incNum suffixText)) (assoc 1 targetData) targetData))  ; Change object content
					(vla-EndUndoMark activeDoc)
					T
				)  ; End of fifth condition
				
				(t (princ "\nInvalid selection, try again: "))
			) ; cond end
		) ; progn end
	) ; while end
	
	(setvar 'osmode osm)
	(setq *error* olderr)
	
	(princ)
) ; TNC end

(defun LM:error ( msg )  ; by Lee Mac
	(if osm (setvar 'osmode osm))
    (if (not (member msg '("Function cancelled" "quit / exit abort")))
		(princ (strcat "\nError: " msg))
	) ; if end
    (princ)
) ; LM:error end

(defun MM:check-for-numbers ( amount targetStr )  ; Checks if string contains any or all numbers [any: amount == 'some'; all: amount == 'every']
	(eval ((read (strcat "vl-" amount))(lambda (ch)(vl-string-search (chr ch) "0123456789"))(vl-string->list targetStr)))
) ; MM:check-for-numbers end

(defun MM:trim-non-numerical-from-sides ( targetStr / start end len)  ; Removes all leading and trailing non-numeric characters
	(setq start 1) ; Set start at first character
	(while (not (vl-string-search (substr targetStr start 1) "0123456789"))  ; Check if character at current position is not a number
		(setq  start (1+ start))  ; Increase position
	) ; while end
	
	(setq end (strlen targetStr)) ; Set end at last character
	(while (not (vl-string-search (substr targetStr end 1) "0123456789"))  ; Check if character at current position is not a number
		(setq  end (1- end))  ; Decrease position
	) ; while end
	
	(setq len (1+ (- end start)))
	
	(substr targetStr start len)  ; Return string without trailing non-numerical characters
) ; MM:trim-non-numerical-from-sides end

(defun MM:increase-number ( operator numStr step / num numLen strL zeros )  ; Increments number while keeping possible leading zeros
	(setq num (apply operator (list (atoi numStr) step)))  ; Convert string to integer and increment
	(setq numLen (strlen (itoa num)))  ; Length of the incremented number
	(setq strL (strlen numStr))     ; Original string length
	(if (> strL numLen)
		(setq zeros (repeat (- strL numLen) "0"))  ; Calculate needed zeros
		(setq zeros "")
	) ; if end
	(strcat zeros (itoa num))  ; Return concatenated zeros and number
) ; MM:increase-number end


(defun LM:remove-rich-format ( str / _replace rx )  ; by Lee Mac

    (defun _replace ( new old str )
        (vlax-put-property rx 'pattern old)
        (vlax-invoke rx 'replace str new)
    )
	
    (if (setq rx (vlax-get-or-create-object "VBScript.RegExp"))
        (progn
            (setq str
                (vl-catch-all-apply
                    (function
                        (lambda ( )
                            (vlax-put-property rx 'global     actrue)
                            (vlax-put-property rx 'multiline  actrue)
                            (vlax-put-property rx 'ignorecase acfalse) 
                            (foreach pair
                               '(
                                    ("\032"    . "\\\\\\\\")
                                    (" "       . "\\\\P|\\n|\\t")
                                    ("$1"      . "\\\\(\\\\[ACcFfHLlOopQTW])|\\\\[ACcFfHLlOopQTW][^\\\\;]*;|\\\\[ACcFfHLlOopQTW]")
                                    ("$1$2/$3" . "([^\\\\])\\\\S([^;]*)[/#\\^]([^;]*);")
                                    ("$1$2"    . "\\\\(\\\\S)|[\\\\](})|}")
                                    ("$1"      . "[\\\\]({)|{")
                                )
                                (setq str (_replace (car pair) (cdr pair) str))
                            )
                        )
                    )
                )
            )
            (vlax-release-object rx)
            (if (null (vl-catch-all-error-p str))
                str
            )
        )
    )
) ; LM:remove-rich-format end

(defun AT:list-select ( lst / longestString title label height width multi fileName openFile dialogObject userSelection dialogValue indexValue outputList )
	
	;; Alan J. Thompson, 09.23.08 / 05.17.10 (rewrite) / 03.03.25 (remake by MM)
	;; List Select Dialog (Temp DCL list box selection, based on provided list)
	
	(setq longestString (apply 'max (mapcar 'strlen lst))) ; Get the length of longest string in a list
	
	(setq title "Prefix List"									; title - list box title
		  label "Select prefix:"								; label - label for list box
		  height 20												; height - height of the box
		  width (if (< longestString 25) 30 (+ longestString 5)); width - width of the box
		  multi "false"											; multi - selection method ["true": multiple, "false": single]
		  lst (vl-sort lst '<))									; lst - ascending list of strings to place in list box
	
	(setq openFile (open (setq fileName (vl-filename-mktemp "" "" ".dcl")) "w")) ; Open temporarily .dcl file for writing
	(foreach text_line 
		(list 
			(strcat "list_select : dialog { label = \"" title "\"; spacer;")
			(strcat ": list_box { label = \"" label "\";" "key = \"lst\";")
			(strcat "allow_accept = true; height = " (vl-princ-to-string height) ";")
			(strcat "width = " (vl-princ-to-string width) ";")
			(strcat "multiple_select = " multi "; } spacer; ok_cancel; }")
		) ; DCL code for dialog
		(write-line text_line openFile) ; Open file and write line in it
	) ; Iterate through all lines
	(close openFile)  ; Close temporarily .dcl file
	
	(new_dialog "list_select" (setq dialogObject (load_dialog fileName)))
	
	(start_list "lst")
	(mapcar (function add_list) lst)
	(end_list)
	
	(setq userSelection (set_tile "lst" "0"))
	(action_tile "lst" "(setq userSelection $value)")
	(setq dialogValue (start_dialog))
	
	(unload_dialog dialogObject)
	(vl-file-delete fileName)
	
	(if (= dialogValue 1) ; Check 'dialogValue' value ["0": Cancel, "1": OK]
		(progn
			(while (setq indexValue (vl-string-search " " userSelection)) ; Find space in string (for multiple selections)
				(setq outputList (cons (nth (atoi (substr userSelection 1 indexValue)) lst) outputList)) ; Find element (based on index) in original string and store it in output list
				(setq userSelection (substr userSelection (+ 2 indexValue))) ; Remove processed part of the string
			) ; while end
			(reverse (cons (nth (atoi userSelection) lst) outputList)) ; Add last element and return reversed list
		) ; progn end
	) ; if end
) ; AT:list-select end

(princ "\n CustomIncrement.lsp - \"TNC\" to select object, pick which part to increase, pick incremental step, and then click to paste and generate.")
(princ)

This is my first "bigger" AutoLISP script so if someone has some suggestions for improving the code I am more than welcome to take them because there's for sure much that can be done better.

Also big thanks to @Lee Mac on creating script for 'UnFormat String' that I'm using in my script (it's called 'remove-rich-format' in my script just because it looks nicer to me) and on this tutorial on error handling (not sure if I got it right, but I tried ), as much as on all other he created that I was learning from and on which I will continue learning - you are legend.

And also big thanks to Alan J. Thompson for creating 'List Select Dialog' that I'm also using in my script.

Sign In

Undoing variable incremental

Recommended Posts

Fidelojo

rlx

GLAVCVS

BIGAL

mhupp

Fidelojo

GLAVCVS

GLAVCVS

rlx

Fidelojo

GLAVCVS

Fidelojo

GLAVCVS

BIGAL

rlx

Fidelojo

GLAVCVS

Fidelojo

Join the conversation

Tutorials

Forums

Activity