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?