Increment number

[Tharwat]

10 minutes ago, Leika said:

And you underestimate your skills because with your code I can keep my formatted Mtext.

 

I did not like your expression here at all and apparently you don't understand what's the meaning of formatted Mtext.

[Leika]

1 hour ago, Tharwat said:

I did not like your expression here at all and apparently you don't understand what's the meaning of formatted Mtext.

@Tharwat

English is not my native language, go to school as a nurse, indeed know little about AutoCad and Lisp but am possessed by AutoCad and Lisp. Can you forgive me because I took it as a compliment to you?

But what's the meaning of understand  for you?
I give example what I need but you give me very beautiful code that does the same as the code of expert Mac Lee... Those codes are sophisticated but I'm not one step further because that was not what I asked.
Of course I'm grateful for your time/code and can certainly learn a lot from it.

I'm here to learn from you, not to be told I don't understand something.
Just explain what people don't understand.

 

Edited June 9, 2022 by Leika

[Steven P]

I thought I had it there for a moment, but not quite....

 

See below, and perhaps someone can point me in the right direction later. This isn't finished yet, it will need things like the cmdecho turning off temporarily and the error stopping, little tidying up.

 

This will work, copy mtext and text as required. The base point will move with the text which I thought was useful. I have used a few of the parts from your example and of course refer to that.

 

 

My problem is the copy loop and how to exit it, at the moment the copy loop will end on escape or with a right mouse click (as requested), problem is that it won't now exit with a space bar or an enter... does anyone know how to force a loop to finish if an enter or space is pressed within it? Or to detect if a space or enter was pressed during the last command (Looked briefly at grread, that might work), thanks

 

See the code below, highlighted  in ';;;;;;;;;;;;' what I a meaning

 

 

(defun c:inctext ( / myent lstpt nxtpt)
;;;; Sub routines ;;;;
    (defun *Error* (Msg)
      (cond
        ((or (not Msg)
          (member Msg '("console break" "Function cancelled" "quit / exit abort"))))
          ((princ (strcat "\nError: " Msg)))
        )
      (setvar "cmdecho" 1)
      (princ)
    )
    (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 numbinc (myent Inc / NewNum )
      (setq Lst (entget myent))
      (setq OldStr (cdr (assoc 1 (entget myent))))
      (setq OldNum (read (wcfilter OldStr "[0-9 .]"))) ;;check if a number
      (if (numberp OldNum)
        (progn
          (setq Res (+ Inc OldNum))
          (setq Res (vl-princ-to-string Res))
          (setq OldNum (vl-princ-to-string OldNum))
          (setq NewStr (vl-string-subst Res OldNum OldStr 0)) ;;Number increased

          (setq Lst (entget myent)) ;;entget new text
          (setq Lst (subst (cons 1 NewStr) (assoc 1 Lst) Lst)) ;;substitute in new number (up to 250 characters)
          (entmod Lst) ;;modify
          (entupd myent) ;;update

        ) ;end progn
      (princ "\nNumber not found in text object ")
      ) ;end if
    )
;;; End Sub;;;;

  (setq Inc 1)

  (if (setq myss (ssget "_+.:E:S" '((0 . "*TEXT"))) ) ;;c/o Lee Mac tutorials, if: just ends if no text, while: gives another chance
    (progn
      (setq myent (ssname myss 0))
      (setq lastpt (cdr (assoc 10 (entget myent)))) ;;get old base point
      (command ".copy" myent "" (setq nxtp (getpoint)) pause) ;;first copy.
      (setq myent (entlast)) ;; Get new text
      (numbinc myent Inc) ;; increase new text '+Inc'
      (setq newpt (cdr (assoc 10 (entget myent)))) ;;get new base point
      (setq mydsp (list (- (nth 0 newpt)(nth 0 lastpt))(- (nth 1 newpt)(nth 1 lastpt))(- (nth 2 newpt)(nth 2 lastpt))))
      (setq nxtp (list (+ (nth 0 nxtp)(nth 0 mydsp))(+ (nth 1 nxtp)(nth 1 mydsp))(+ (nth 2 nxtp)(nth 2 mydsp))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
      (while (< 1 acount) ;;Infinite loop - don't like it
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
        (setq lastpt (cdr (assoc 10 (entget myent)))) ;;get old base point
        (command ".copy" myent "" nxtp pause )

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; add here cancel if space or enter pressed
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

        (setq myent (entlast)) ;; Get new text

        (numbinc myent Inc) ;; increase new text '+Inc'
        (setq newpt (cdr (assoc 10 (entget myent)))) ;;get new base point
        (setq mydsp (list (- (nth 0 newpt)(nth 0 lastpt))(- (nth 1 newpt)(nth 1 lastpt))(- (nth 2 newpt)(nth 2 lastpt))))
        (setq nxtp (list (+ (nth 0 nxtp)(nth 0 mydsp))(+ (nth 1 nxtp)(nth 1 mydsp))(+ (nth 2 nxtp)(nth 2 mydsp))))
      );end while


    );;end progn
    (princ "Text not selected")
  );end if
  (princ)
)

 

[Tharwat]

@Steven P Have you seen my post HERE it should answer your question in regard to exit quietly and safely. 

[Steven P]

16 minutes ago, Tharwat said:

@Steven P Have you seen my post HERE it should answer your question in regard to exit quietly and safely. 

 

Yes, though we are dong this in 2 different ways, mine works using (Command "copy"...... ) which allows the OP visual representation of the copied text as it is being copied, selecting the points is done within the command, your points are selected outside of the copy command and then copies the text (which is a lot easier to include some code to end the loop)? I can ask the user to select points before the copy line but then you loose the visual of the text moving,

 

So to escape my loop ideally I am looking for a way to detect whether a space or enter is pressed during the (Command "copy".... ), once I know how to do that I can put in an end to the loop

[mhupp]

5 hours ago, Steven P said:

Yes, though we are dong this in 2 different ways, mine works using (Command "copy"...... ) which allows the OP visual representation of the copied text as it is being copied, selecting the points is done within the command, your points are selected outside of the copy command and then copies the text (which is a lot easier to include some code to end the loop)? I can ask the user to select points before the copy line but then you loose the visual of the text moving,

 

So to escape my loop ideally I am looking for a way to detect whether a space or enter is pressed during the (Command "copy".... ), once I know how to do that I can put in an end to the loop

 

Probably use the grread function between picking the two points to allow visual rep. like the way lee mac uses it here.

but I have no idea how to use it.

 

-edit but a simpler coding solution maybe?

 

(setq LastEntity T) ;make it so they are diffrent starting out
(while (not (equal LastEntity ThisEntity))
   (setq LastEntity (entlast))
   ;if you don't create a new text it will exit loop
   (setq ThisEntity (entlast))
 )

 

Edited June 10, 2022 by mhupp

[Leika]

As far as I know I got out, definitely not perfect but got the base I wanted.
With the code you all show here I can build in and embellish many options with OpenDCL.
Thank you very much !

 

;;; ===================================================================================================
;;; All Credits to Joe Burke - 3/2/2003                                    
;;; Modified by Leika Marchal 10/06/2022
;;; 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 or Return to end
;;; 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 bpt nxpt)
    (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
    )
    (setvar "cmdecho" 0)
    (defun PickTest ()
        (setq Obj (entsel "\nSelect text to increment or Cancel to end: "))
        (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: "))
        )
    )

    (setq Inc (read (getstring "\nEnter increment value positive or negative: ")))
    (initget "Y N") ; Force User Input with (initget 1 "Y N ")
    (prompt "\n| ")
    (prompt "\n| Yes, will copy and add or subtract multiple times")
    (prompt "\n| No, will add or subtract existing text ")
    (prompt "\n| ")
    (prompt "\n| ")
    (princ)
    (setq Mode (getkword "\nCopy text [Yes/No] : "))
    
    (if (= Mode "N")
        (progn
            (prompt "\n| ")
            (prompt "\n| ")
            (prompt "\n| ")
            (prompt "\n| Existing text will be edit ")
            (prompt "\n| ")
            (princ)
            (while (setq Obj (entsel "\nSelect text to edit <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: "))
                )
                (setq Ent (car Obj))
                (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 ")
                )
            )
        )
    )
    (if (= Mode "Y")
        (progn
            (PickTest)
            (setvar "lastpoint" (setq bpt (getpoint "\nBase point :")))
            (while (setq nxpt (getpoint "\nEnter next point <exit> :" ))
                (if (null Ent)
                    (progn
                        (setq Ent (car Obj))
                        (command ".copy" Ent "" bpt nxpt)
                        (setq Ent (entlast))
                    )
                    (progn
                        (command ".copy" (entlast) "" (getvar "lastpoint") nxpt)
                        (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)
    (setvar "cmdecho" 1)
    (princ)
)
;shortcut
;(defun c:IT () (c:IncrementText))
(c:IncrementText)

 

[Steven P]

no, I don't know grread well, I have tried it today but am not getting anything I am happy with yet. Also I am gong to look at Lee Macs IncarrayD - think somewhere on his website there is a description of what he does to make objects visible as you copy or move them - which is what I was trying to do here

 

I'll try your suggestion later or over the weekend.

 

 

 

NIce Leika, glad it is working for you

[Leika]

48 minutes ago, Steven P said:

NIce Leika, glad it is working for you

Thank you for your support Steven!
I searched everywhere for weeks on end with all the associated frustrations.
The explanation behind your code suddenly gave me a push and saw the light burn
 

[myloveflyer]

(defun c:IncrementText (/ oce ss p1 p2 p0 x0 y0 x1 y1 hudu ent aa txt1 pp kk txt2 num juli)
(setq oce(getvar "cmdecho"))
(setvar "cmdecho" 0)
(setq ent (car (entsel "\nIncremental copy:\nSelect starting text:")))
(if (null ent) (exit))
(setq p0 (getpoint "\nSpecify base point:"))
(if (null p0 )(exit))
(princ "\nSpecify second point or displacement:")
(while t
(setq p1 (getpoint p0))
(if (null p1) (mosi111) (mosi112))
)
(princ)
)
(defun mosi112()
(command ".copy" ent "" "m" p0 p1 "")
(setq juli (distance p0 p1))
(setq ent (entlast))
(DS)
(setq  x0 (car p0))
(setq  y0 (cadr p0))
(setq p0 p1)
(setq  x1 (car p1))
(setq  y1 (cadr p1))
(setq  x (- x1 x0))
(setq  y (- y1 y0))
(setq  hudu (atan y x) )
(setq  x1 (+ x0 x))
(setq  y1 (+ y0 y))
(setq  p1 (list x1 y1 0.0))
(princ (strcat "\nSpecify next point or continue displacement<" (rtos juli ) ">:"))
)

(defun mosi111()
      (setq p1 (list (+ (nth 0 p0) (* juli (cos hudu)))
                     (+ (nth 1 p0) (* juli (sin hudu)))
                     (nth 2 p0)
               )
      )
(command ".copy" ent "" "m" p0 p1 "")
(setq ent (entlast))
(DS)
(setq juli (distance p0 p1))
(setq p0 p1)
(princ (strcat "\nSpecify next point or continue displacement<<" (rtos juli ) ">:"))
)

(defun DS( )
(setq txt1 (entget ent))
(setq txt1 (cdr (assoc 1 txt1)))
(setq aa (atoi txt1))
(if (and (> aa 0 ) (= (itoa aa) txt1 ) ) (tj120 ) (tj110 ) )
(princ)
)
(defun tj110( / mm zz pp txt2 kk txt3)
(setq mm (strlen txt1))
(setq zz mm )
(while (or (> (atoi (substr txt1 zz )) 0) (= (substr txt1 zz zz ) "0" )) 
(setq zz (- zz 1))
)
(setq pp (substr txt1 (+ zz 1) ))
(setq txt2 (substr txt1 1 zz ))
(setq kk (atoi pp) )
(setq kk (+ kk 1 ))
(setq txt3 (strcat txt2 (itoa kk)))
(setq ent (entget ent))
(setq ent (subst (cons 1 txt3 ) (assoc 1 ent) ent) )
(entmod ent)
(setq ent (cdr (assoc -1 ent)))
(princ)
)
(defun tj120 ( / txt2 num txt3)
(setq num 0 )
(setq txt2 (atoi txt1))

(setq num (+ num 1 ))
(setq txt3 ( + txt2 num) )
(setq ent (entget ent))
(setq ent (subst (cons 1 (itoa txt3) ) (assoc 1 ent) ent) )
(entmod ent)
(setq ent (cdr (assoc -1 ent)))
(princ)
) 

Hope it helps you。