Topic: Add/Subtract (M)Text Values

[DanB]

Does anyone have a routine that allows a user to Add or Subtract a value from multiple (m)text strings. I have a grading layout of spot elevation callouts that are shown in Mtext as (first line) "High Point" or "Low Point" (second line) "24.46" (example). I now need to add "0.67" (8 inches) to all this. Please don't get side tracked on how others label spots with points or blocks I know there are lots of different ways people do this, but this sheet was requested this way so that's what I have to do. Thanks for any help on this one.

Dan

[DanB]

I came across this bit of code a co-worker had but it does not accept MText. Not real thrilled with the precision settings...

Code: [Select]


;This function takes a string in the form of a real
;number and adds another number to it

(defun c:addt ()
   (setq add (getreal "\nEnter Number to add to text:"))
   (setq prec (getint "\nEnter Precision :"))
   (print "\nSelect object to modify")
   (setq s (ssget '((0 . "TEXT"))))
   (setq le (sslength s))
   (setq count 0)

   (while (<= count (- le 1))
      (setq n (ssname s count))
      (setq lis (entget n))
      (setq old1 (assoc 1 lis))
      (setq old (cdr old1))
      (setq oldr (atof old))
      (setq new (+ oldr add))
      (setq new (cons 1 (rtos new 2 prec)))
      (setq lis (subst new old1 lis))
      (entmod lis)
      (setq count (1+ count))
      )
   (setq s nil)
   (setq count nil)
   (setq le nil)
   (setq old1 nil)
   (setq old nil)
   (setq oldr nil)
   (setq new nil)
   (setq lis nil)
   )


[CAB]

This may help you out.
http://theswamp.org/phpBB2/viewtopic.php?t=518&highlight=txtinc

[Anonymous]

Maybe this will give you help, but you need to explode the MTEXT into normal dtexts.

http://www.ikozmos.com/htmls/mathanno2005.htm

[bman]

This one works good on dtext

Code: [Select]

;A2T = Adds specified text value to text entitieS
;=================================
(defun c:A2t (/ txt1 txt2 cnt1 ent1)

(setq txt1 (getreal "\nEnter value to increase by (if decreasing, add a minus sign before). "))
(setq cnt1 0)
(if txt1
(progn
(setq ss (ssget '((0 . "*TEXT"))))
(while (/= cnt1 (sslength ss))
(setq ent1 (entget (ssname ss cnt1)))
(setq txt2 (cdr (assoc 1 ent1)))
(MakeSureNum txt2)
(setq cnt1 (1+ cnt1))
)
)
)
(princ)
)

;==============

(defun MakeSureNum (txt3 / cnt1 cnt2 txt4 txt5 txt6 txt7)

(setq cnt1 0
cnt2 1
)
(if (and (>= (ascii (substr txt3 1 1)) 65) (/= (ascii (substr txt3 1 1)) 32))
(while (>= (ascii (substr txt3 1 1)) 65)
(if txt4
(setq txt4 (strcat txt4 (substr txt3 1 1)))
(setq txt4 (substr txt3 1 1))
)
(setq txt3 (substr txt3 2 (strlen txt3)))
)
)
(while (= (substr txt3 1 1) " ")
(setq txt4 (strcat txt4 " "))
(setq txt3 (substr txt3 2 (strlen txt3)))
)
(if (< (ascii (substr txt3 1 1)) 65)
(while (and (<= (ascii (substr txt3 1 1)) 65) (/= (ascii (substr txt3 1 1)) 0) (/= (ascii (substr txt3 1 1)) 32))
(if txt5
(setq txt5 (strcat txt5 (substr txt3 1 1)))
(setq txt5 (substr txt3 1 1))
)

[CAB]

DanB
TextInc will add to the first number found. To get to the second number you
would have to write a special routine.

[DanB]

bman, I receive an Error: malformed list on input with your code. Any ideas?

CAB, I really need to be able to add/subtract decimal values (i.e. 0.67, 1.5, .02) Your routine only allows for non-zero integers.

Thanks for all the feedback.

DanB

[Mark]

CAB, I really need to be able to add/subtract decimal values (i.e. 0.67, 1.5, .02) Your routine only allows for non-zero integers.

according to CAB's source code
";;;  No support for reals or fractions "

[DanB]

I just wanted to point out  that the code he (CAB) had provided although much appreciated, will not work for my circumstances.

DanB

[bman]

danb, i just apploaded & it worked fine in 2005.
did you save it to a file & appload or cut/paste?

[CAB]

I just wanted to point out  that the code he (CAB) had provided although much appreciated, will not work for my circumstances.

DanB

Thanks for the pointer Dan
But the code I offered was meant as an example of how you could approach the problem.
Not to solve your problem.
If you examine the code it is an example of how MTEXT can be edited & incremented.
MTEXT can be very complicated as it can have imbedded control characters you will
have to deal with. Although your case may be a special one where no control characters
are expected it is a good idea to familiarize yourself with the data structure of mtext
before you create your routine.
Happy Coding.

[DanB]

If it matters at all, I am running LDD2004.

I copied the code and ran appload, I still get the error messages.

[DanB]

Thanks Again CAB.

[CAB]

Thanks Again CAB.

You are welcome.
Sometimes the 'Cut & Paste' does not work well.
Here is the latest version of TxtInc.

[Anonymous]

try this one...had word wrap on

Code: [Select]

;A2T = Adds specified text value to text entitieS
;=================================
(defun c:A2t (/ txt1 txt2 cnt1 ent1)

(setq txt1 (getreal "\nEnter value to increase by (if decreasing, add a minus sign before). "))
(setq cnt1 0)
(if txt1
(progn
(setq ss (ssget '((0 . "*TEXT"))))
(while (/= cnt1 (sslength ss))
(setq ent1 (entget (ssname ss cnt1)))
(setq txt2 (cdr (assoc 1 ent1)))
(MakeSureNum txt2)
(setq cnt1 (1+ cnt1))
)
)
)
(princ)
)

;==============

(defun MakeSureNum (txt3 / cnt1 cnt2 txt4 txt5 txt6 txt7)

(setq cnt1 0
cnt2 1
)
(if (and (>= (ascii (substr txt3 1 1)) 65) (/= (ascii (substr txt3 1 1)) 32))
(while (>= (ascii (substr txt3 1 1)) 65)
(if txt4
(setq txt4 (strcat txt4 (substr txt3 1 1)))
(setq txt4 (substr txt3 1 1))
)
(setq txt3 (substr txt3 2 (strlen txt3)))
)
)
(while (= (substr txt3 1 1) " ")
(setq txt4 (strcat txt4 " "))
(setq txt3 (substr txt3 2 (strlen txt3)))
)
(if (< (ascii (substr txt3 1 1)) 65)
(while (and (<= (ascii (substr txt3 1 1)) 65) (/= (ascii (substr txt3 1 1)) 0) (/= (ascii (substr txt3 1 1)) 32))
(if txt5
(setq txt5 (strcat txt5 (substr txt3 1 1)))
(setq txt5 (substr txt3 1 1))
)
(setq txt3 (substr txt3 2 (strlen txt3)))
)
)
(setq txt5 (atof txt5))
(setq txt6 (+ txt5 txt1))
(setq txt7
(if txt4
(strcat txt4 (rtos txt6 1 3) txt3)
(strcat (rtos txt6 2 2) txt3);;;;;;change numbers to change precision
)
)
(setq ent1 (subst (cons 1 txt7) (assoc 1 ent1) ent1))
(entmod ent1)

)