Need LISP fixed

[margaretl]

I have the following code for an old LISP routine. It is supposed to allow adding or subtracting of a fixed number from several text strings. It worked once upon a time ago. I can't recall what version of CAD, but I need it now. Any help would be greatly appreciated.

Example) If I have 695.61, 698.25, 700.01, and 701.87 and run the routine, it will ask the amount to add/subtract (-0.30 for this example) It will alow the user to select a group of numbers and then process the following result: 695.31, 697.95, 699.71, and 701.57 Original text being changed.


'ADTEXT.LSP program to add or subtract from an elevation text
(defun c:adtext ()
(setvar "cmdecho" 0)
(setq e (getreal "\n Enter +/- amount to change elevation: "))
(while (/= e nil)
(setq en (entsel "\n Pick the elevation to change: "))
(setq ed(entget (car en)))
(setq a (cdr (assoc 1 ed)))
(setq b (assoc 1 ed))
(setq e1 (+ e (atof a)))
(setq e1 (rtos e1 2 2))
(setq d (cons 1 e1))
(setq ed (subst d b ed))
(entmod ed)
(setq en (entsel "\n Pick the elevation to change: "))
)
(setvar "cmdecho" 1)
(princ)
)

[Opie]

I adjusted your while statement and removed a duplicate user prompt at the end of the while loop. It worked in 2008 on TEXT objects that only contained a number.
(defun c:adtext ( / A B D E E1 ED EN)
(setvar "cmdecho" 0)
(setq e (getreal "\n Enter +/- amount to change elevation: "))
(while (setq en (entsel "\n Pick the elevation to change: "))
(setq ed (entget (car en)))
(setq a (cdr (assoc 1 ed)))
(setq b (assoc 1 ed))
(setq e1 (+ e (atof a)))
(setq e1 (rtos e1 2 2))
(setq d (cons 1 e1))
(setq ed (subst d b ed))
(entmod ed)
)
(setvar "cmdecho" 1)
(princ)
)

[margaretl]

That works well for text without letters. I forgot to mention, I have some that have letters preempting the numbers i.e. T/C+698.75 or G+698.25

Also, it is only letting me pick one piece of text at a time. I have a drawing with a thousand or so spot grades that need to change. In addition, it is adding a zero to the end of say 699.4 to make it 699.10 I need it to be 699.1

Is this possible?

[fixo]

Try edited version

(defun c:adtext ( / a b d e e1 ed en head pos tail)
(setvar "cmdecho" 0)
(setq e (getreal "\n Enter +/- amount to change elevation: "))
(while (setq en (entsel "\n Pick the elevation to change: "))
(setq ed (entget (car en)))
(setq a (cdr (assoc 1 ed)))
(setq pos (vl-string-position (ascii "+") a))
(setq head (substr a 1 (1+ pos)))
(setq tail (substr a (+ pos 2)))
(setq b (assoc 1 ed))
(setq e1 (+ e (atof tail)))
(setq e1 (strcat head (rtos e1 2 1)))
(setq d (cons 1 e1))
(setq ed (subst d b ed))
(entmod ed)
)
(setvar "cmdecho" 1)
(princ)
)

~'J'~

[margaretl]

Fixo,
The edited routine does not work on just number text. Also, on strings with two decimal places, it truncates to one.

I have elevations for hard surfaces that need to maintain 2 decimal places and elevations for soft surfaces that need to maintain 1 decimal place.

Some of the hard surface elevations have a prefix to specify what the grade is for because they are right next to each other. i.e. T/C+ is for Top of Curb and G+ is for Gutter. Soft surfaces have no prefix just the elevation.

I appreciate the time everyone is putting into this for me. It will be a bear if I can't get this routine to work.

[fixo]

Not sure about I understand you correctly
Anyway you can try another one:

(defun c:adtext ( / a b d e e1 ed en head pos tail)
(setvar "cmdecho" 0)
(setq e (getreal "\n Enter +/- amount to change elevation: "))
(while (setq en (entsel "\n Pick the elevation to change: "))
(setq ed (entget (car en)))
(setq b (assoc 1 ed))
(setq a (cdr b))
(if (wcmatch a "*+*")
(progn
(setq prec 2)
(setq pos (vl-string-position (ascii "+") a))
(setq head (substr a 1 (1+ pos)))
(setq tail (substr a (+ pos 2)))
(setq e1 (+ e (atof tail)))
(setq e1 (strcat head (rtos e1 2 prec)))
(setq d (cons 1 e1))
(setq ed (subst d b ed)))
(progn
(setq prec 1)
(setq e1 (+ e (atof a)))
(setq e1 (rtos e1 2 prec))
(setq d (cons 1 e1))
(setq ed (subst d b ed))))
(entmod ed)
)
(setvar "cmdecho" 1)
(princ)
)

~'J'~

[margaretl]

Fixo,

This works great!

Is there anyway to allow for a window select? No sweat if you can't. This will certainly speed of the process.

[fixo]

Can you upload a small screen capture to illustrate the points
location?
Or better yet attach the part of your working drawing without
blocks, lines etc. to see the current situation, this would be
easier for me, because of in this case I could to build
the filter to select particular texts, say by its own layer,
text height, style etc., just zip 'em before

~'J'~

[margaretl]

Okay. I wblocked a portion of the layers I have on in my drawing. I do not know if both layers appear in this portion.

I would like to window this and have it be changed instead of picking each grade individually.

Thanks again for your help.

[fixo]

I added selection filter to your suit
but maybe in other drawing you'll have
another options for your texts, in this case
you can use just simple filter like this:

(setq ss (ssget (list (cons 0 "*TEXT"))))
where asterix in front of TEXT allows to
select both TEXT and MTEXT as in your attached sample

Try this instead:


(defun c:adtext ( / a b d e e1 ed en head pos tail)
(princ "\n Select all grades by window or with another method ")
(if (setq ss (ssget (list (cons 0 "*TEXT")
(cons -4 "<and")
(cons 7 "L80")
(cons 8 "Ex-Elev")
(cons -4 "and>"))))
(progn
(setq e (getreal "\n Enter +/- amount to change elevation: "))
(while (setq en (ssname ss 0))
(setq ed (entget en))
(setq b (assoc 1 ed))
(setq a (cdr b))
(if (wcmatch a "*+*")
(progn
(setq prec 2)
(setq pos (vl-string-position (ascii "+") a))
(setq head (substr a 1 (1+ pos)))
(setq tail (substr a (+ pos 2)))
(setq e1 (+ e (atof tail)))
(setq e1 (strcat head (rtos e1 2 prec)))
(setq d (cons 1 e1))
(setq ed (subst d b ed)))
(progn
(setq prec 1)
(setq e1 (+ e (atof a)))
(setq e1 (rtos e1 2 prec))
(setq d (cons 1 e1))
(setq ed (subst d b ed))))
(entmod ed)
(ssdel en ss)
)
)
(alert "0 texts/mtexts with similar properties selected")
)
(princ)
)


~'J'~

[margaretl]

You are AWSOME!!!! I tried adding reputation, but it won't let me.

I with the filter comment, would that replace:

(setq ss (ssget (list (cons 0 "*TEXT")
(cons -4 "<and")
(cons 7 "L80")
(cons 8 "Ex-Elev")
(cons -4 "and>"))))

with:

(setq ss (ssget (list (cons 0 "*TEXT"))))

if I wanted a more generic filter? I don't need anything modified. What you gave me is perfect for this drawing. Just a question.

[fixo]

Glad if that helps
And no flowers, please,
Cheers :)

~'J'~