Topic: QUICK TEXT LISP ROUTINE NEEDED

[rhino]

Hi,

I need a quick routine that will:

  - prompt user to select text (which will be real numbers)
  - convert the same to reals & multiply by a factor (1.1 in my case)
  - replace the text with the new values

[CAB]

Here is a beginning, absolutely no error checking.
You need to look at the Help File for rtos for formatting options.

Code: [Select]

(defun c:FixText(/ ent elst num)
  (setq ent (car(entsel "\nSelect text"))) ; - prompt user to select text (which will be real numbers)
  (setq elst (entget ent))
  (setq Num (atof (cdr (assoc 1 elst)))) ; - convert the same to reals & multiply by a factor (1.1 in my case)
  (entmod (subst (cons 1 (rtos (* 1.1 Num)))(assoc 1 elst) elst)) ; - replace the text with the new values
  (princ)
)

[T.Willey]

Maybe the code here will work for you.

http://www.theswamp.org/index.php?topic=12867.msg157064#msg157064

[CAB]

You might also look here http://www.theswamp.org/index.php?topic=24700.msg359343#msg359343

Look for -------------  Increment Number  -----------------

[Lee Mac]

Another:

Code: [Select]

(defun c:doit (/ i ss ent num eLst)

  (if (setq i -1 ss (ssget "_:L" '((0 . "MTEXT,TEXT"))))
    (while (setq ent (ssname ss (setq i (1+ i))))
      (setq num (atof (cdr (assoc 1 (setq eLst (entget ent))))))
      (entmod (subst (cons 1 (rtos (* num 1.1))) (assoc 1 eLst) eLst))))

  (princ))


[rhino]

Here is a beginning, absolutely no error checking.
You need to look at the Help File for rtos for formatting options.

Code: [Select]

(defun c:FixText(/ ent elst num)
  (setq ent (car(entsel "\nSelect text"))) ; - prompt user to select text (which will be real numbers)
  (setq elst (entget ent))
  (setq Num (atof (cdr (assoc 1 elst)))) ; - convert the same to reals & multiply by a factor (1.1 in my case)
  (entmod (subst (cons 1 (rtos (* 1.1 Num)))(assoc 1 elst) elst)) ; - replace the text with the new values
  (princ)
)

Thanks CAB - here's what i ended up with:

Code: [Select]


(defun c:ft (/)(c:FixText))
(defun c:FixText(/ usercmd *error* ent elst etyp num loop)

(defun *error* (msg)
    (if (not
          (member msg '("console break" "Function cancelled" "quit / exit abort" "" nil))
        )
      (princ (strcat "\nError: " msg))
    )
    (and usercmd (setvar "cmdecho" usercmd))
    (princ)
)

(setq usercmd (getvar "cmdecho"))
(setvar "cmdecho"  0)

(prompt "\nThis command will update the text entries by factoring to the given factor...
\nPlease select text entries that are numbers only..."
)
  ;(setq fac (getreal "\nEnter factor <1.1>: "))
   ; (or fac (setq fac 1.1))
    (setq loop "T")
      (while (= loop "T")
(setq ent  (car(entsel "\nSelect text")));prompt user to select text (which will be real numbers)
  (if (null ent)
            (progn
              (princ (strcat "\nno object selected..."))
              (setq ent (car(entsel "\nTry again Select text object: ")))
(if (null ent)
(progn
  (princ
           (strcat "\nFor the scond time no entity has been selected: ")
  )
          (exit)
         )
                )
    )
   )
(setq elst (entget ent);get entity data
      etyp (cdr (assoc 0 elst));get entity type
)
  (if etyp (= "TEXT") (setq loop "T"))
    (if (/= etyp "TEXT") ((exit) (princ)));if entity is not text or nil - exit quietly :)
      (if (= loop "T")
        (progn
          (setq num (atof (cdr (assoc 1 elst))));convert the selected text to reals & multiply by a factor (1.1 in my case)
          (entmod (subst (cons 1 (rtos (* 1.1 num) 2 2))(assoc 1 elst) elst));replace the text with the new values
          (command "_.chprop" ent "" "_color" "1" "");change updated text to red
  (princ)
)
      )
);end loop
)

[rhino]

Another:

Code: [Select]

(defun c:doit (/ i ss ent num eLst)

  (if (setq i -1 ss (ssget "_:L" '((0 . "MTEXT,TEXT"))))
    (while (setq ent (ssname ss (setq i (1+ i))))
      (setq num (atof (cdr (assoc 1 (setq eLst (entget ent))))))
      (entmod (subst (cons 1 (rtos (* num 1.1))) (assoc 1 eLst) eLst))))

  (princ))


really slick - but i like the way CAB's routine works as it'll show u each update without having to exit the loop - i'm gonna give this lisp to our estimating dept - they'll use it give us sales guys the pre-lim column reactions with the 10% added (for safety)

[rhino]

i'd appreciate if someone could help to add the option for an undo...

[Lee Mac]

Hi Rhino,

I have just tidied up your routine a bit, I hope you don't mind:

Code: [Select]

(defun c:ft nil (c:FixText))

(defun c:FixText  (/ *error* ent eLst Num)

  (defun *error*  (msg)
    (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
        (princ (strcat "\n** Error: " msg " **")))
    (princ))

  (prompt (strcat "\nThis command will update the text entries by factoring to the given factor..."
          "\nPlease select text entries that are numbers only..."))
  (while
    (progn
      (setq ent (car (entsel "\nSelect Text <Exit> : ")))

      (cond (  (eq 'ENAME (type ent))

               (if (wcmatch (cdr (assoc 0 (setq eLst (entget ent)))) "*TEXT")
                 (progn
                   (setq Num  (atof (cdr (assoc 1 eLst))))
                   (setq eLst (subst (cons 1 (rtos (* 1.1 Num) 2 2)) (assoc 1 eLst) eLst))

                   (entmod
                     (if (assoc 62 eLst) (subst (cons 62 1) (assoc 62 eLst) eLst)
                       (append eLst (list (cons 62 1))))))

                 (princ "\n** Object is Not Text **"))))))
  (princ))


[Lee Mac]

Another approach:

Code: [Select]

(defun c:ft nil (c:FixText))

(defun c:FixText  (/ *error* ent uFlag obj)
  (vl-load-com)
  (setq *doc (cond (*doc) ((vla-get-ActiveDocument (vlax-get-acad-object)))))

  (defun *error*  (msg)
    (and uFlag (vla-EndUndoMark *doc))
    (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
        (princ (strcat "\n** Error: " msg " **")))
    (princ))

  (prompt (strcat "\nThis command will update the text entries by factoring to the given factor..."
          "\nPlease select text entries that are numbers only..."))
  (while
    (progn
      (setq ent (car (entsel "\nSelect Text <Exit> : ")))

      (cond (  (eq 'ENAME (type ent))

               (if (vl-position (cdr (assoc 0 (entget ent))) '("TEXT" "MTEXT"))
                 (progn
                   (setq uFlag (not (vla-StartUndoMark *doc)))

                   (vla-put-TextString (setq obj (vlax-ename->vla-object ent))
                     (rtos (* 1.1 (atof (vla-get-TextString obj))) 2 2))

                   (vla-put-color obj 1)
                   (setq uFlag (vla-EndUndomark *doc)) t)

                 (princ "\n** Object is Not Text **"))))))
  (princ))


[CAB]

Lee I think he wants is a companion routine to reverse the process.
Or at lease some undo marks.  
I could be mistaken.


PS I like the vl version when dealing with COLOR.

[Lee Mac]

Lee I think he wants is a companion routine to reverse the process.
Or at lease some undo marks.  
I could be mistaken.


PS I like the vl version when dealing with COLOR.

Yeah, I prefer the UndoMarks in the VL version - I don't like to use (command "_.undo"...

[CAB]

Here is my combine of the routines.

Code: [Select]

(defun c:ft (/) (c:FixText))
(defun c:FixText (/ *error* ent obj num loop fac acad doc)
  (vl-load-com)
  (defun *error* (msg)
    (if (not
  (member msg
  '("console break" "Function cancelled" "quit / exit abort" "" nil)
  )
)
      (princ (strcat "\nError: " msg))
    )
    (princ)
  )


  (prompt
    "\nThis command will update the text entries by factoring to the given factor...
\nPlease select text entries that are numbers only..."
  )
  ;;(setq fac (getreal "\nEnter factor <1.1>: "))
  (or fac (setq fac 1.1))
  (setq acad (vlax-get-acad-object)
doc  (vla-get-ActiveDocument acad))
  (vla-EndUndoMark doc)
 
  (setq loop "T")
  (while loop
    (setvar "ErrNo" 0) ; reset variable
    (initget 128)
    (setq ent (car (entsel "\nSelect text")))

    (cond
      ((= 52 (getvar "ErrNo")) ; <Enter> was hit
       (setq Loop nil))
     
      ((null ent)
(princ "\nNo object selected... Please try again.")
      )

      ((and (setq obj (vlax-ename->vla-object ent))
    (= "AcDbText" (vla-get-ObjectName obj))
       )
       (if (numberp (setq num (distof (vla-get-TextString obj))))
(progn ;replace the text with the new values
   (vla-StartUndoMark doc)
           (vla-put-TextString obj (rtos (* fac num) 2 2))
           (vla-put-color obj 1) ;change updated text to red
   (vla-EndUndoMark doc)
)
(prompt "\nNo number in text...  Please try again.")
        )
      )
      ((prompt "\nObject is not a Text Object... Please try again."))
    )
  ) ;end loop
  (princ)
)

Code: [Select]

;;==================================================================
(defun c:ftu (/) (c:FixTextUndo))
(defun c:FixTextUndo (/ *error* ent obj num loop fac acad doc)
  (vl-load-com)
  (defun *error* (msg)
    (if (not
  (member msg
  '("console break" "Function cancelled" "quit / exit abort" "" nil)
  )
)
      (princ (strcat "\nError: " msg))
    )
    (princ)
  )


  (prompt
    "\nThis command will updo the text entries by factoring to the given factor...
\nPlease select Red text entries that are numbers only..."
  )
  ;;(setq fac (getreal "\nEnter factor <1.1>: "))
  (or fac (setq fac (/ 1 1.1)))
  (setq acad (vlax-get-acad-object)
doc  (vla-get-ActiveDocument acad))
  (vla-EndUndoMark doc)
 
  (setq loop "T")
  (while loop
    (setvar "ErrNo" 0) ; reset variable
    (initget 128)
    (setq ent (car (entsel "\nSelect text")))

    (cond
      ((= 52 (getvar "ErrNo")) ; <Enter> was hit
       (setq Loop nil))
     
      ((null ent)
(princ "\nNo object selected... Please try again.")
      )

      ((and (setq obj (vlax-ename->vla-object ent))
    (= "AcDbText" (vla-get-ObjectName obj))
    (or (= (vla-get-color obj) 1)
(prompt "\nNot Red Text."))
       )
       (if (numberp (setq num (distof (vla-get-TextString obj))))
(progn ;replace the text with the new values
   (vla-StartUndoMark doc)
           (vla-put-TextString obj (rtos (* fac num) 2 2))
           (vla-put-color obj 7) ;change updated text to white
   (vla-EndUndoMark doc)
)
(prompt "\nNo number in text...  Please try again.")
        )
      )
      ((prompt "\nObject is not a Text Object... Please try again."))
    )
  ) ;end loop
  (princ)
)

<edit: code updated>

[Lee Mac]

Alan, I would be inclined to save the vla-ActiveDocument as a variable, instead of calling vlax-get-acad-object over and over 

[CAB]

When in a loop that pauses for user input there is no time penalty, so what is the harm?

[Lee Mac]

When in a loop that pauses for user input there is no time penalty, so what is the harm?

I've read (from one of Kerry's posts) that every time you call it, it increments the reference count of the object, and you have to call vlax-release-object the same amount of times to release it - or until the ACAD Garbage collection does so. So I avoid calling it excessively.

[rhino]

Hi Rhino,

I have just tidied up your routine a bit, I hope you don't mind:

not at all - i'll just add the fac variable to it - thanks! I have much to learn  

Lee I think he wants is a companion routine to reverse the process.
Or at lease some undo marks.  
I could be mistaken.


PS I like the vl version when dealing with COLOR.

I like the vlisp version too.

@CAB
I don't want a separate func to reverse the process - the vl-undo works well but after you exit the loop/function

i'd like it to work within the loop itself - as a user  might click some text string like those under the grid line column...

lee's routine is fine otherwise - and has thought me quite a bit.

Thanks 

[Kerry]

Alan, I would be inclined to save the vla-ActiveDocument as a variable, instead of calling vlax-get-acad-object over and over  

Lee,
You could try something like this, which saves a few process ticks ...

Code: [Select]

(vl-load-com)
(or *AcadApplication
    (setq *AcadApplication (vlax-get-acad-object))
)
(OR *activeDocument
    (SETQ *activeDocument (VLA-GET-ACTIVEDOCUMENT *AcadApplication))
)
Then just use the variable.

[CAB]

When in a loop that pauses for user input there is no time penalty, so what is the harm?

I've read (from one of Kerry's posts) that every time you call it, it increments the reference count of the object, and you have to call vlax-release-object the same amount of times to release it - or until the ACAD Garbage collection does so. So I avoid calling it excessively.

I don't think it's that big a deal in this case. As with many things it depends where you use them.
In a loop dealing with user input the loop will not be executed much compared to a sub function that may executed a 1000 times or more.
Take a look at this thread:  http://www.theswamp.org/index.php?topic=2005.msg25790#msg25790

All I am saying is that I pick & choose when  & where I use a variable that can be released.

[Lee Mac]

Alan, I would be inclined to save the vla-ActiveDocument as a variable, instead of calling vlax-get-acad-object over and over  

Lee,
You could try something like this, which saves a few process ticks ...

Code: [Select]

(vl-load-com)
(or *AcadApplication
    (setq *AcadApplication (vlax-get-acad-object))
)
(OR *activeDocument
    (SETQ *activeDocument (VLA-GET-ACTIVEDOCUMENT *AcadApplication))
)
Then just use the variable.

Thanks Kerry - thats pretty much what I have used in my example above 

[Lee Mac]

When in a loop that pauses for user input there is no time penalty, so what is the harm?

I've read (from one of Kerry's posts) that every time you call it, it increments the reference count of the object, and you have to call vlax-release-object the same amount of times to release it - or until the ACAD Garbage collection does so. So I avoid calling it excessively.

I don't think it's that big a deal in this case. As with many things it depends where you use them.
In a loop dealing with user input the loop will not be executed much compared to a sub function that may executed a 1000 times or more.
Take a look at this thread:  http://www.theswamp.org/index.php?topic=2005.msg25790#msg25790

All I am saying is that I pick & choose when  & where I use a variable that can be released.

I tend to just stick to a way of doing things - I realise performance doesn't matter here, but if you can get better performance, why not 

[CAB]

That's true. I suppose that it was lazy of me to just cut & paste those items from my template file and knowing
it met minimum requirements figured it was OK. Knowing that everyone that looks at the code doesn't know the
rules behind some of the things done makes this a bad example.

[Lee Mac]

Another approach 

Code: [Select]

(defun c:ft nil (c:fixtext))

(defun c:fixtext (/ *error*

                    CODE DATA ENT GR LAST_ENT MSG NUM OBJ OCM UFLAG)

  ;; Lee Mac  ~  19.01.10
  (vl-load-com)

  (defun *error* (msg)
    (and uFlag (vla-EndUndoMark *doc))
    (and ocm   (setvar "CMDECHO" ocm))
    (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
        (princ (strcat "\n** Error: " msg " **")))
    (princ))

  (setq  ocm (getvar "CMDECHO")

        *doc (cond (*doc) ((vla-get-ActiveDocument (vlax-get-acad-object))))
        *fac (cond (*fac) (1.1))

        *fac (cond ((getreal (strcat "\nSpecify Factor <" (rtos *fac 2 2) "> : "))) (*fac)))
 
  (setvar "CMDECHO" 0)

  (princ (eval (setq msg '(strcat "\n<< Current Factor: " (rtos *fac 2 2) ">>"
                                  "\nSelect Text, [F]actor [U]ndo <Exit> : "))))
                   
  (while
    (progn
      (setq gr (grread 't 15 2) code (car gr) data (cadr gr))

      (cond (  (and (= 3 code) (listp data))

               (if (setq ent (car (nentselp data)))

                 (if (and (vl-position (cdr (assoc 0 (entget ent))) '("TEXT" "MTEXT"))
                          (numberp (setq num (distof (cdr (assoc 1 (entget ent)))))))
                   (progn
                     (setq uFlag (not (vla-StartUndoMark *doc)) last_ent (cons ent last_ent))

                     (vla-put-TextString
                       (setq obj (vlax-ename->vla-object ent)) (rtos (* *fac num) 2 2))

                     (vla-put-color obj 1)
                     (setq uFlag (vla-EndUndoMark *doc)) t)

                   (princ (strcat "\n** Object Must be Numerical Text **" (eval msg))))

                 (princ (strcat "\n** Nothing Selected **" (eval msg)))))

            (  (= code 25) nil)

            (  (= code 2)

               (cond (  (vl-position data '(85 117))

                        (if last_ent (vl-cmdf "_.undo" 1)
                          (princ (strcat "\n** Nothing to Undo **" (eval msg))))

                        (setq last_ent (cdr last_ent)) t)                     

                     (  (vl-position data '(70 102))

                        (setq *fac (cond ((getreal (strcat "\nSpecify Factor <" (rtos *fac 2 2) "> : ")))

                                         (*fac)))

                        (princ (eval msg)))

                     (  (vl-position data '(13 32)) nil)

                     (t )))

            (t ))))
 

  (and ocm (setvar "CMDECHO" ocm))
  (princ))