Increment number

[Leika]

Hello,
My goal is following:

• Copy existing number (or text with number)
• Specify base point
• Specify second point
• Insert and increase that number by 1
• exit all with the right mouse button

 

I've tweaked this nice code a bit and it works.
But exiting with the right mouse button turns out to be a big problem!
Can you help?
Thanks for your time!

 

;-------------------------------------------------------------------------------------------
;by Joe Burke - modified 3/2/2003
;increment first number found in text or mtext object
;other characters may precede number, "A-2" +2 returns "A-4"
;works with reals and integers
;options: increment copy multiple or increment existing text
;Cancel to end
;shortcut: IT
; https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/copy-and-increment-text/td-p/840715

(defun c:IncrementText (/ *Error* Inc Ent Obj OldStr Mode NewStr OldNum Lst Res Pt x xxx)

    (defun *Error* (Msg)
        (cond
            ((or (not Msg)
            (member Msg '("console break" "Function cancelled" "quit / exit abort"))))
            ((princ (strcat "\nError: " Msg)))
        )
        (setvar "cmdecho" 1)
        (princ)
    )

    (vl-load-com)

    ;by Michael Puckett
    ;retain characters contained in pattern within string
    (defun wcfilter ( string pattern / i c result )
        (setq result "" i 0)
        (repeat (strlen string)
            (if
                (wcmatch
                    (setq c (substr string (setq i (1+ i)) 1))
                    pattern
                )
                (setq result (strcat result c))
            )
        )
        result
    )

    (defun PickTest ()
        (setq Obj (entsel "\nSelect text to increment or Cancel to end <exit> : "))
        (while
            (or (not Obj)
                (and
                    (/= "MTEXT" (cdr (assoc 0 (entget (car Obj)))))
                    (/= "TEXT" (cdr (assoc 0 (entget (car Obj)))))
                )
            )
            
            (setq Obj (entsel "\nText object not selected - try again: "))
        )
    )
    
    (setvar "cmdecho" 0)
    (setq Inc 1)
    (setq Mode "Y")
    
    (while T ;repeat
        (cond
            ((= Mode "Y")
                (if (null Ent)
                    (progn
                        (PickTest)
                        (setvar "lastpoint" (setq x (getpoint "\nBase point :")))
                        (setq xxx (getpoint "\nEnter next point <exit> :" ))
                        (setq Ent (car Obj) Pt (cadr Obj))
                        (command ".copy" Ent "" x xxx)
                        (setq Ent (entlast))
                    )
                    (progn
                        (command ".copy" (entlast) "" (getvar "lastpoint") pause)
                        (setq Ent (entlast))
                    )
                )
            )
        )
        (setq Lst (entget Ent))
        (setq OldStr (cdr (assoc 1 (entget Ent))))
        (setq OldNum (read (wcfilter OldStr "[0-9 .]")))
        (if (numberp OldNum)
            (progn
                (setq
                    Res (+ Inc OldNum)
                    Res (vl-princ-to-string Res)
                    OldNum (vl-princ-to-string OldNum)
                    NewStr (vl-string-subst Res OldNum OldStr 0)
                    Lst (subst (cons 1 NewStr) (assoc 1 Lst) Lst)
                )
                (entmod Lst)
                (entupd Ent)
            )
        (princ "\nNumber not found in text object ")
        )
    )
    (*Error* nil)
    (princ)
)

(c:IncrementText)

 

[Tharwat]

How is your text with number looks like ?

What's the need of the second point ?

[Steven P]

I suspect it might be something to do with how the entities are selected but I would need to check that, a right click appears to want a context menu here which is blank, so won't show anything).

 

Thinking that in your copy command you put a (setq nxpt (getpoint "Select Next Point"), and copy to be (command ".copy" (entlast) "" (getvar "lastpoint") nxpt) that might work.. but I have been wrong before. Then there is a break between copying the last point and copying the next point where the right click can jump in and cancel the routine. My guess anyway, will have a look shortly

 

But I have been wrong a lot before.....

[Steven P]

3 minutes ago, Tharwat said:

How is your text with number looks like ?

What's the need of the second point ?

 

i tried it with a text, just a number, did the same

[mhupp]

Yeah don't know why their are using two points as well. I guess it has to do with dxf 10 or 11 code based on justification.

 

You only have to pick one point now and fixes your other problem @Leika  you can now right click to exit.

 

;-------------------------------------------------------------------------------------------
;by Joe Burke - modified 3/2/2003
;increment first number found in text or mtext object
;other characters may precede number, "A-2" +2 returns "A-4"
;works with reals and integers
;options: increment copy multiple or increment existing text
;https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/copy-and-increment-text/td-p/840715

(defun c:IncrementText (/ i Ent Obj OldStr Mode NewStr OldNum Lst Res Pt x xxx)
  (vl-load-com)
  ;by Michael Puckett
  ;retain characters contained in pattern within string
  (defun wcfilter (string pattern / i c result)
    (setq result "" i 0)
    (repeat (strlen string)
      (if
        (wcmatch
          (setq c (substr string (setq i (1+ i)) 1))
          pattern
        )
        (setq result (strcat result c))
      )
    )
    result
  )
  (defun PickTest ()
    (setq Obj (car (entsel "\nSelect text to increment: ")))
    (while
      (or (not Obj)
          (and
            (/= "MTEXT" (cdr (assoc 0 (entget Obj))))
            (/= "TEXT" (cdr (assoc 0 (entget Obj))))
          )
      )
      (setq Obj (car (entsel "\nText object not selected - try again: ")))
    )
    (if (eq (cdr (assoc 10 (entget Obj))) "0.0 0.0 0.0")
      (setq bpt (cdr (assoc 11 (entget Obj))))
      (setq bpt (cdr (assoc 10 (entget Obj))))
    )
  )
  (PickTest)
  (setq OldStr (cdr (assoc 1 (entget obj)))
        OldNum (read (wcfilter OldStr "[0-9 .]"))
  )
  (if (numberp OldNum)
    (progn
      (setq NewNum (1+ OldNum)
            NewStr (vl-string-subst (itoa NewNum) (itoa OldNum) OldStr 0)
      )
    )
    (princ "\nNumber not found in text object ")
  )
  (setq x (getpoint "\nBase point :"))
  (setq offset (mapcar '/ (mapcar '- bpt x)))
  (while (setq pt (mapcar '/ (mapcar '+ offset (getpoint "\nNext point: "))))
    (entmake (list '(0 . "TEXT")
                    (cons 10 pt)
                   '(40 . 8.0)
                    (cons 1 NewStr)
             )
    )
    (setq Newnum (1+ NewNum)
          NewStr (vl-string-subst (itoa NewNum) (itoa OldNum) OldStr 0)
    )
  )
  (princ)
)

 

 

Edited June 9, 2022 by mhupp
formatting

[Tharwat]

21 minutes ago, Steven P said:

 

i tried it with a text, just a number, did the same

My intension all the time is not to work on anyone's codes so I was asking about the way the OP's situation's needs.  

[Tharwat]

@mhupp try to write your own codes and I am sure that you would come up with much better codes than that modified one. 

[Leika]

Thank you Tharwat and Steven to reply me
I quickly made an example

I copy the text R5 with base point and click second point in another square, "R6" will then appear in it.
When i click on the next point "R7" will appear in that square.
And this is how I want to fill in the other squares...
Good example;  I can also indicate the number of steps of a staircase...

[Steven P]

9 minutes ago, Leika said:

Thank you Tharwat and Steven to reply me
I quickly made an example

I copy the text R5 with base point and click second point in another square, "R6" will then appear in it.
When i click on the next point "R7" will appear in that square.
And this is how I want to fill in the other squares...
Good example;  I can also indicate the number of steps of a staircase...

 

 

If this is what you are dong, the new texts in a regular array such as a staircase, then you might try Lee Macs Incarray and Incarrayd which I use all the time, http://lee-mac.com/incrementalarray.html

 

However there is a solution out there to the right click too

[Leika]

@mhupp
I am sorry but I got this error:

 

@Steven
Thank you for the link!
I'm going to study it (as far as I can understand)
Actually it should work like the traditional copy button but with an addition...


 

[Tharwat]

@Leika that error took a place due to your formatted mtext so explode it to be converted to single text then try again.

[Steven P]

5 minutes ago, Tharwat said:

@Leika that error took a place due to your formatted mtext so explode it to be converted to single text then try again.

 

Could also pass the text through Lee Macs unformat LISP before pasting it.

[Tharwat]

Just now, Steven P said:

 

Could also pass the text through Lee Macs unformat LISP before pasting it.

After unformatting the Mtext object thee presentation may look different than the original one.  

[Tharwat]

Can't post a .gif file and it errors all the time even after changing the size and record over and over again with no avail ! 

[Leika]

32 minutes ago, Tharwat said:

@Leika that error took a place due to your formatted mtext so explode it to be converted to single text then try again.

Yes, it works with Explode R5 but then other problems arise 
It is important to keep the text nicely centered.

 

 

[mhupp]

1 hour ago, Tharwat said:

@mhupp try to write your own codes and I am sure that you would come up with much better codes than that modified one. 

 

Maybe ? + all the ground work is done. I can understand your stance on not modifying others code but 1 its on the internet and 2 its almost 20 years old.

 

added back in the two point pick (offset) @Leika recopy it from above

 

https://ibb.co/K54jFxK

Edited June 9, 2022 by mhupp

[Tharwat]

Here is my attempt and please don't run the program on formatted Mtext otherwise you would get weird result.

 

(defun c:test (/ sel ent str old new ltr obj get ins pt1 pt2 dis ent cpy
               tmp grr len lst)
  ;;------------------------------------------------------------;;
  ;;	Author: Tharwat Al Choufi - Date: 09.Jun.2022		;;
  ;;	website: https://autolispprograms.wordpress.com		;;
  ;;------------------------------------------------------------;;
  (and
    (princ "\nPick on text ends with number : ")
    (setq sel (ssget "_+.:S:E:L" '((0 . "*TEXT") (1 . "*#"))))
    (setq ent (ssname sel 0)
          str (cdr (assoc 1 (entget ent)))
          old ""
    )
    (while (not (numberp (read (setq ltr (substr str 1 1)))))
      (setq old (strcat old ltr)
            str (substr str 2)
      )
    )
    (setq str (read str)
          new str
          obj (vlax-ename->vla-object ent)
    )
    (setq pt1 (getpoint "\nSpecify base point :"))
    (setq pt2 (getpoint "\nNew position :" pt1))
    (setq dis (distance pt1 pt2))
    (princ "\nMove your cursor far from text to copy text with increments < right click to exit > :")
    (while (eq (car (setq grr (grread t 14 0))) 5)
      (redraw)
      (and lst (progn (mapcar 'entdel lst) (setq lst nil) t))
      (and (> (setq tmp 0.0
                    str new
                    len (distance pt1 (cadr grr))
              )
              dis
           )
           (repeat (fix (/ len dis))
             (vlax-invoke
               (setq cpy (vla-copy obj))
               'Move
               pt1
               (polar pt1 (angle pt1 pt2) (setq tmp (+ tmp dis)))
             )
             (setq ent (vlax-vla-object->ename cpy)
                   get (entget ent)
                   get (entmod
                         (subst
                           (cons
                             1
                             (strcat old
                                     (vl-princ-to-string (setq str (1+ str)))
                             )
                           )
                           (assoc 1 get)
                           get
                         )
                       )
                   lst (cons ent lst)
             )
           )
      )
    )
  )
  (princ)
) (vl-load-com)

 

[Leika]

1 hour ago, Steven P said:

If this is what you are dong, the new texts in a regular array such as a staircase, then you might try Lee Macs Incarray and Incarrayd which I use all the time, http://lee-mac.com/incrementalarray.html

Nice, this code works perfectly!
The problem is that everything has to be in a straight line?
Suppose, as in this example, you have a line everywhere and you want the text neatly above the line in the middle, then that will not work.
Just thought I'd click anywhere in the middle or end of the line here
I am very sorry that this little task looks so complicated

 

 

 

[Leika]

44 minutes ago, Tharwat said:

Here is my attempt and please don't run the program on formatted Mtext otherwise you would get weird result.

Beautiful code! And you underestimate your skills because with your code I can keep my formatted Mtext.
I am a user who always uses mtext with the text toolbar above my text...

Is it a big problem to fill in the lines one by one like in my previous example?
I'll bring them together as an option...

 

[Leika]

@ mhupp
Yes, when I EXPLODE the Mtext it work fine!
Sad, if I can't use the Mtext, I still have a lot to learn, that's for sure.
Thank you very much for the code.

Edited June 9, 2022 by Leika