addition and substraction to selected Station marking(MText)

[smitaranjan]

Can anyone help to write lisp, so that it can add/substract Particular value to the selected mtext which are in 1+11 format. They should ask Add or substract the value{How much should I add or How much should I substract} and eg, if there is Station marking 0+20, 0+70, 1+20, 2+50, 11+21 and I give command SMADD and it should ask "how much should I add:" and then if I give value 70, then it should add 70 to whichever mtext I am selecting convert the existing Station marking to 0+90, 1+40, 1+90, 3+20, 11+91. Same with substraction.

 

You can try with DWG attached. And the lisp should not change text style, layer, size or color.

 

 station marking.dwg

[EnM4st3r]

like this maybe?
 

(defun c:smadd (/ ss i addnum obj num)
  (setq ss (ssget '((0 . "MTEXT"))))
  (setq i 0)
  (setq addnum (/ (getreal "\nhow much should I add: ") 100))
  (while (< i (sslength ss))
    (setq obj (vlax-ename->vla-object (ssname ss i)))
    (setq num (+ addnum (atof (vl-string-subst "." "+" (LM:UnFormat (vla-get-textstring obj) t)))))
    (vla-put-textstring obj (vl-string-subst "+" "." (rtos num 2 2)))
    (setq i (1+ i))
  )
)

also beware that your text uses individual text formatting.
cant read the text values with it so using LM:UnFormat to remove it.
https://www.lee-mac.com/unformatstring.html

Edited May 29 by EnM4st3r

[smitaranjan]

14 hours ago, EnM4st3r said:

like this maybe?
 

(defun c:smadd (/ ss i addnum obj num)
  (setq ss (ssget '((0 . "MTEXT"))))
  (setq i 0)
  (setq addnum (/ (getreal "\nhow much should I add: ") 100))
  (while (< i (sslength ss))
    (setq obj (vlax-ename->vla-object (ssname ss i)))
    (setq num (+ addnum (atof (vl-string-subst "." "+" (LM:UnFormat (vla-get-textstring obj) t)))))
    (vla-put-textstring obj (vl-string-subst "+" "." (rtos num 2 2)))
    (setq i (1+ i))
  )
)

also beware that your text uses individual text formatting.
cant read the text values with it so using LM:UnFormat to remove it.
https://www.lee-mac.com/unformatstring.html

Still getting :   ; error: no function definition: LM:UNFORMAT 

[Steven P]

Unformat is here: https://lee-mac.com/unformatstring.html - copy and paste the code to a text file and load as a LISP, maybe add it to the same as c:smadd above - before the LISP that refers to it is often better

[smitaranjan]

13 hours ago, Steven P said:

Unformat is here: https://lee-mac.com/unformatstring.html - copy and paste the code to a text file and load as a LISP, maybe add it to the same as c:smadd above - before the LISP that refers to it is often better

yess after addition of text its working but changed those MTEXT style too. Is there any method will add without changing the Style?? and For substraction what needs to change?

[EnM4st3r]

34 minutes ago, smitaranjan said:

yess after addition of text its working but changed those MTEXT style too. Is there any method will add without changing the Style??

The Lisp has to remove the individual text formatting since it cant read the values otherwise.

To retain the Formatting would be way more complicated.

 

35 minutes ago, smitaranjan said:

and For substraction what needs to change?

Just type for example -20 or -50.

[Steven P]

Quickly looking at the drawing, the mtexts in question all have formatting code 'p34;' - could use Lee Macs String to List using p34; as a delimitator, change the text portion and then list to string to remake the text again

[EnM4st3r]

8 minutes ago, Steven P said:

Quickly looking at the drawing, the mtexts in question all have formatting code 'p34;' - could use Lee Macs String to List using p34; as a delimitator, change the text portion and then list to string to remake the text again

also thought of saving the formatting in a list somehow, but didnt wanna dive into that

[exceed]

 

some edit of EnM4st3r's code.

 

ah.. my mistake.

Add and Subtract the last number of mtext with only one + or -.

When it becomes negative, + changes to -. It does not work if there are two or more +'s.

 

(defun c:smadd (/ ss i addnum obj num otext utext ulist onum anum rnum rtext plusminus)
  (vl-load-com)
  (setq ss (ssget '((0 . "MTEXT"))))
  (setq i 0)
  (setq addnum (getreal "\nhow much should I add: "))
  (while (< i (sslength ss))
    (setq obj (vlax-ename->vla-object (ssname ss i)))
    (setq otext (vla-get-textstring obj))
    (setq utext (LM:UnFormat otext t))
    (setq ulist (Lm:str->lst utext "+")) 
    (if (= (length ulist) 2)
      (progn
        (setq onum (last ulist))
        (setq anum (+ addnum (atof onum)))
        (if (> anum 0)
          (progn  
            (setq anum (rtos anum 2 0))
            (if (= (strlen anum) 1)
              (setq anum (strcat "0" anum))
            )
            (setq plusminus "+")
          )
          (progn
            (if (= (strlen (rtos anum 2 0)) 2)
              (setq anum (strcat "0" (rtos (abs anum) 2 0)))
              (setq anum (rtos (abs anum) 2 0))
            )
            (setq plusminus "-")
          )
        )
        (setq rnum (strcat (car ulist) plusminus anum))
        (setq rtext (vl-string-subst rnum utext otext))
        (vla-put-textstring obj rtext)
      )
      (progn
        (setq ulist (Lm:str->lst utext "-")) 
        (if (= (length ulist) 2)
          (progn
            (setq onum (* -1 (atof (last ulist))))
            (setq anum (+ addnum onum))
            (if (> anum 0)
              (progn  
                (setq anum (rtos anum 2 0))
                (if (= (strlen anum) 1)
                  (setq anum (strcat "0" anum))
                )
                (setq plusminus "+")
              )
              (progn
                (if (= (strlen (rtos anum 2 0)) 2)
                  (setq anum (strcat "0" (rtos (abs anum) 2 0)))
                  (setq anum (rtos (abs anum) 2 0))
                )
                (setq plusminus "-")
              )
            )
            (setq rnum (strcat (car ulist) plusminus anum))
            (setq rtext (vl-string-subst rnum utext otext))
            (vla-put-textstring obj rtext)
          )
        )
      )
    )
    (setq i (1+ i))
  )
  (princ)
)

;; String to List  -  Lee Mac
;; Separates a string using a given delimiter
;; str - [str] String to process
;; del - [str] Delimiter by which to separate the string
;; Returns: [lst] List of strings
 
(defun LM:str->lst ( str del / pos )
    (if (setq pos (vl-string-search del str))
        (cons (substr str 1 pos) (LM:str->lst (substr str (+ pos 1 (strlen del))) del))
        (list str)
    )
)

;;-------------------=={ UnFormat String }==------------------;;
;;                                                            ;;
;;  Returns a string with all MText formatting codes removed. ;;
;;------------------------------------------------------------;;
;;  Author: Lee Mac, Copyright © 2011 - www.lee-mac.com       ;;
;;------------------------------------------------------------;;
;;  Arguments:                                                ;;
;;  str - String to Process                                   ;;
;;  mtx - MText Flag (T if string is for use in MText)        ;;
;;------------------------------------------------------------;;
;;  Returns:  String with formatting codes removed            ;;
;;------------------------------------------------------------;;

(defun LM:UnFormat ( str mtx / _replace rx )

    (defun _replace ( new old str )
        (vlax-put-property rx 'pattern old)
        (vlax-invoke rx 'replace str new)
    )
    (if (setq rx (vlax-get-or-create-object "VBScript.RegExp"))
        (progn
            (setq str
                (vl-catch-all-apply
                    (function
                        (lambda ( )
                            (vlax-put-property rx 'global     actrue)
                            (vlax-put-property rx 'multiline  actrue)
                            (vlax-put-property rx 'ignorecase acfalse) 
                            (foreach pair
                               '(
                                    ("\032"    . "\\\\\\\\")
                                    (" "       . "\\\\P|\\n|\\t")
                                    ("$1"      . "\\\\(\\\\[ACcFfHLlOopQTW])|\\\\[ACcFfHLlOopQTW][^\\\\;]*;|\\\\[ACcFfHLlOopQTW]")
                                    ("$1$2/$3" . "([^\\\\])\\\\S([^;]*)[/#\\^]([^;]*);")
                                    ("$1$2"    . "\\\\(\\\\S)|[\\\\](})|}")
                                    ("$1"      . "[\\\\]({)|{")
                                )
                                (setq str (_replace (car pair) (cdr pair) str))
                            )
                            (if mtx
                                (_replace "\\\\" "\032" (_replace "\\$1$2$3" "(\\\\[ACcFfHLlOoPpQSTW])|({)|(})" str))
                                (_replace "\\"   "\032" str)
                            )
                        )
                    )
                )
            )
            (vlax-release-object rx)
            (if (null (vl-catch-all-error-p str))
                str
            )
        )
    )
)

 

Edited May 31 by exceed

[EnM4st3r]

@exceed nice ,  this is smart didnt think about that.

(vl-string-subst rnum utext otext)

 

 

but i thought he wanted only the last 2 numbers behind the plus everything else should be added like infront of the plus.
So 0+48 added with +1000 should be 10+48

Edited May 31 by EnM4st3r

[exceed]

8 minutes ago, EnM4st3r said:

@exceed nice ,

 

but i thought he wanted only the last 2 numbers behind the plus everything else should be added like infront of the plus.
So 0+48 added with +1000 should be 10+48

 

 

(defun c:smadd (/ ss i addnum obj num otext utext ulist onum anum rnum rtext plusminus)
  (vl-load-com)
  (setq ss (ssget '((0 . "MTEXT"))))
  (setq i 0)
  (setq addnum (/ (getreal "\nhow much should I add: ") 100))
  (while (< i (sslength ss))
    (setq obj (vlax-ename->vla-object (ssname ss i)))
    (setq otext (vla-get-textstring obj))
    (setq utext (LM:UnFormat otext t))
    (setq ulist (Lm:str->lst utext "+")) 
    (if (= (length ulist) 2)
      (progn
        (setq num (vl-string-subst "+" "." (rtos (+ addnum (atof (vl-string-subst "." "+" utext))) 2 2)))
        (setq rtext (vl-string-subst num utext otext))
        (vla-put-textstring obj rtext)
      )
      (progn
      )
    )
    (setq i (1+ i))
  )
  (princ)
)

;; String to List  -  Lee Mac
;; Separates a string using a given delimiter
;; str - [str] String to process
;; del - [str] Delimiter by which to separate the string
;; Returns: [lst] List of strings
 
(defun LM:str->lst ( str del / pos )
    (if (setq pos (vl-string-search del str))
        (cons (substr str 1 pos) (LM:str->lst (substr str (+ pos 1 (strlen del))) del))
        (list str)
    )
)

;;-------------------=={ UnFormat String }==------------------;;
;;                                                            ;;
;;  Returns a string with all MText formatting codes removed. ;;
;;------------------------------------------------------------;;
;;  Author: Lee Mac, Copyright © 2011 - www.lee-mac.com       ;;
;;------------------------------------------------------------;;
;;  Arguments:                                                ;;
;;  str - String to Process                                   ;;
;;  mtx - MText Flag (T if string is for use in MText)        ;;
;;------------------------------------------------------------;;
;;  Returns:  String with formatting codes removed            ;;
;;------------------------------------------------------------;;

(defun LM:UnFormat ( str mtx / _replace rx )

    (defun _replace ( new old str )
        (vlax-put-property rx 'pattern old)
        (vlax-invoke rx 'replace str new)
    )
    (if (setq rx (vlax-get-or-create-object "VBScript.RegExp"))
        (progn
            (setq str
                (vl-catch-all-apply
                    (function
                        (lambda ( )
                            (vlax-put-property rx 'global     actrue)
                            (vlax-put-property rx 'multiline  actrue)
                            (vlax-put-property rx 'ignorecase acfalse) 
                            (foreach pair
                               '(
                                    ("\032"    . "\\\\\\\\")
                                    (" "       . "\\\\P|\\n|\\t")
                                    ("$1"      . "\\\\(\\\\[ACcFfHLlOopQTW])|\\\\[ACcFfHLlOopQTW][^\\\\;]*;|\\\\[ACcFfHLlOopQTW]")
                                    ("$1$2/$3" . "([^\\\\])\\\\S([^;]*)[/#\\^]([^;]*);")
                                    ("$1$2"    . "\\\\(\\\\S)|[\\\\](})|}")
                                    ("$1"      . "[\\\\]({)|{")
                                )
                                (setq str (_replace (car pair) (cdr pair) str))
                            )
                            (if mtx
                                (_replace "\\\\" "\032" (_replace "\\$1$2$3" "(\\\\[ACcFfHLlOoPpQSTW])|({)|(})" str))
                                (_replace "\\"   "\032" str)
                            )
                        )
                    )
                )
            )
            (vlax-release-object rx)
            (if (null (vl-catch-all-error-p str))
                str
            )
        )
    )
)

 

ah i understand. like this?

 

If the total number is negative, how should it be expressed? For example, if -0.40 then -0+40? -0-60?

Or Doesn't this work with negative numbers?

Edited May 31 by exceed

[EnM4st3r]

2 minutes ago, exceed said:

ah i understand. like this?

yes i think like that.

 

2 minutes ago, exceed said:

If the total number is negative, how should it be expressed? For example, if -0.40 then -0+40? -0-60?

Or Doesn't this work with negative numbers?

not sure, guess @smitaranjan needs to tell us more about the expected result

[smitaranjan]

41 minutes ago, EnM4st3r said:

@exceed nice ,  this is smart didnt think about that.

(vl-string-subst rnum utext otext)

 

 

but i thought he wanted only the last 2 numbers behind the plus everything else should be added like infront of the plus.
So 0+48 added with +1000 should be 10+48

yes this is what I wanted. 0+70 added 900 should be 9+70, 0+72 added with 2001 should be 20+73.....and for negative 0+10 substracted 50 then it should be 0-40 and from 0+21 substracted 129 then -1-08 may be although 0+00 will be the smallest value for my work

Edited May 31 by smitaranjan
Extra

[EnM4st3r]

what about 0+10 substracted 500?

 

-5-10? but since 0+00 ist the smallest value leaving it at -5+10 is the easiest.

Edited May 31 by EnM4st3r

[smitaranjan]

41 minutes ago, exceed said:

 

 

(defun c:smadd (/ ss i addnum obj num otext utext ulist onum anum rnum rtext plusminus)
  (vl-load-com)
  (setq ss (ssget '((0 . "MTEXT"))))
  (setq i 0)
  (setq addnum (/ (getreal "\nhow much should I add: ") 100))
  (while (< i (sslength ss))
    (setq obj (vlax-ename->vla-object (ssname ss i)))
    (setq otext (vla-get-textstring obj))
    (setq utext (LM:UnFormat otext t))
    (setq ulist (Lm:str->lst utext "+")) 
    (if (= (length ulist) 2)
      (progn
        (setq num (vl-string-subst "+" "." (rtos (+ addnum (atof (vl-string-subst "." "+" utext))) 2 2)))
        (setq rtext (vl-string-subst num utext otext))
        (vla-put-textstring obj rtext)
      )
      (progn
      )
    )
    (setq i (1+ i))
  )
  (princ)
)

;; String to List  -  Lee Mac
;; Separates a string using a given delimiter
;; str - [str] String to process
;; del - [str] Delimiter by which to separate the string
;; Returns: [lst] List of strings
 
(defun LM:str->lst ( str del / pos )
    (if (setq pos (vl-string-search del str))
        (cons (substr str 1 pos) (LM:str->lst (substr str (+ pos 1 (strlen del))) del))
        (list str)
    )
)

;;-------------------=={ UnFormat String }==------------------;;
;;                                                            ;;
;;  Returns a string with all MText formatting codes removed. ;;
;;------------------------------------------------------------;;
;;  Author: Lee Mac, Copyright © 2011 - www.lee-mac.com       ;;
;;------------------------------------------------------------;;
;;  Arguments:                                                ;;
;;  str - String to Process                                   ;;
;;  mtx - MText Flag (T if string is for use in MText)        ;;
;;------------------------------------------------------------;;
;;  Returns:  String with formatting codes removed            ;;
;;------------------------------------------------------------;;

(defun LM:UnFormat ( str mtx / _replace rx )

    (defun _replace ( new old str )
        (vlax-put-property rx 'pattern old)
        (vlax-invoke rx 'replace str new)
    )
    (if (setq rx (vlax-get-or-create-object "VBScript.RegExp"))
        (progn
            (setq str
                (vl-catch-all-apply
                    (function
                        (lambda ( )
                            (vlax-put-property rx 'global     actrue)
                            (vlax-put-property rx 'multiline  actrue)
                            (vlax-put-property rx 'ignorecase acfalse) 
                            (foreach pair
                               '(
                                    ("\032"    . "\\\\\\\\")
                                    (" "       . "\\\\P|\\n|\\t")
                                    ("$1"      . "\\\\(\\\\[ACcFfHLlOopQTW])|\\\\[ACcFfHLlOopQTW][^\\\\;]*;|\\\\[ACcFfHLlOopQTW]")
                                    ("$1$2/$3" . "([^\\\\])\\\\S([^;]*)[/#\\^]([^;]*);")
                                    ("$1$2"    . "\\\\(\\\\S)|[\\\\](})|}")
                                    ("$1"      . "[\\\\]({)|{")
                                )
                                (setq str (_replace (car pair) (cdr pair) str))
                            )
                            (if mtx
                                (_replace "\\\\" "\032" (_replace "\\$1$2$3" "(\\\\[ACcFfHLlOoPpQSTW])|({)|(})" str))
                                (_replace "\\"   "\032" str)
                            )
                        )
                    )
                )
            )
            (vlax-release-object rx)
            (if (null (vl-catch-all-error-p str))
                str
            )
        )
    )
)

 

ah i understand. like this?

 

If the total number is negative, how should it be expressed? For example, if -0.40 then -0+40? -0-60?

Or Doesn't this work with negative numbers?

Its working perfectly.

[smitaranjan]

5 minutes ago, EnM4st3r said:

what about 0+10 substracted 500?

 

-5-10?

that mostly not required as 0+00 will be the starting and all the Station marking will be greater than and positive one.  But for curiosity -4-90 

[symoin]

9 hours ago, exceed said:

 

 

(defun c:smadd (/ ss i addnum obj num otext utext ulist onum anum rnum rtext plusminus)
  (vl-load-com)
  (setq ss (ssget '((0 . "MTEXT"))))
  (setq i 0)
  (setq addnum (/ (getreal "\nhow much should I add: ") 100))
  (while (< i (sslength ss))
    (setq obj (vlax-ename->vla-object (ssname ss i)))
    (setq otext (vla-get-textstring obj))
    (setq utext (LM:UnFormat otext t))
    (setq ulist (Lm:str->lst utext "+")) 
    (if (= (length ulist) 2)
      (progn
        (setq num (vl-string-subst "+" "." (rtos (+ addnum (atof (vl-string-subst "." "+" utext))) 2 2)))
        (setq rtext (vl-string-subst num utext otext))
        (vla-put-textstring obj rtext)
      )
      (progn
      )
    )
    (setq i (1+ i))
  )
  (princ)
)

;; String to List  -  Lee Mac
;; Separates a string using a given delimiter
;; str - [str] String to process
;; del - [str] Delimiter by which to separate the string
;; Returns: [lst] List of strings
 
(defun LM:str->lst ( str del / pos )
    (if (setq pos (vl-string-search del str))
        (cons (substr str 1 pos) (LM:str->lst (substr str (+ pos 1 (strlen del))) del))
        (list str)
    )
)

;;-------------------=={ UnFormat String }==------------------;;
;;                                                            ;;
;;  Returns a string with all MText formatting codes removed. ;;
;;------------------------------------------------------------;;
;;  Author: Lee Mac, Copyright © 2011 - www.lee-mac.com       ;;
;;------------------------------------------------------------;;
;;  Arguments:                                                ;;
;;  str - String to Process                                   ;;
;;  mtx - MText Flag (T if string is for use in MText)        ;;
;;------------------------------------------------------------;;
;;  Returns:  String with formatting codes removed            ;;
;;------------------------------------------------------------;;

(defun LM:UnFormat ( str mtx / _replace rx )

    (defun _replace ( new old str )
        (vlax-put-property rx 'pattern old)
        (vlax-invoke rx 'replace str new)
    )
    (if (setq rx (vlax-get-or-create-object "VBScript.RegExp"))
        (progn
            (setq str
                (vl-catch-all-apply
                    (function
                        (lambda ( )
                            (vlax-put-property rx 'global     actrue)
                            (vlax-put-property rx 'multiline  actrue)
                            (vlax-put-property rx 'ignorecase acfalse) 
                            (foreach pair
                               '(
                                    ("\032"    . "\\\\\\\\")
                                    (" "       . "\\\\P|\\n|\\t")
                                    ("$1"      . "\\\\(\\\\[ACcFfHLlOopQTW])|\\\\[ACcFfHLlOopQTW][^\\\\;]*;|\\\\[ACcFfHLlOopQTW]")
                                    ("$1$2/$3" . "([^\\\\])\\\\S([^;]*)[/#\\^]([^;]*);")
                                    ("$1$2"    . "\\\\(\\\\S)|[\\\\](})|}")
                                    ("$1"      . "[\\\\]({)|{")
                                )
                                (setq str (_replace (car pair) (cdr pair) str))
                            )
                            (if mtx
                                (_replace "\\\\" "\032" (_replace "\\$1$2$3" "(\\\\[ACcFfHLlOoPpQSTW])|({)|(})" str))
                                (_replace "\\"   "\032" str)
                            )
                        )
                    )
                )
            )
            (vlax-release-object rx)
            (if (null (vl-catch-all-error-p str))
                str
            )
        )
    )
)

 

ah i understand. like this?

 

If the total number is negative, how should it be expressed? For example, if -0.40 then -0+40? -0-60?

Or Doesn't this work with negative numbers?

Dear Exceed,

I appreciate your efforts and contribution but doubt the use of this code. Normally in station values, any number before the + sign is considered a Kilometer, and after that 3 places as meters and then a point with 2 or 3 decimal digits. 
Now as per your definition, "So 0+48 added with +1000 should be 10+48" if 1000 or 1 Km is added to 48 or 480 meters it gives the result as "10+48" i.e, 10 Km and 48m whereas the correct answer should be 1+048 or 1+480 or 1+480.00 or 1.048.00.
Correct me if I am Wrong

[smitaranjan]

6 hours ago, symoin said:

Dear Exceed,

I appreciate your efforts and contribution but doubt the use of this code. Normally in station values, any number before the + sign is considered a Kilometer, and after that 3 places as meters and then a point with 2 or 3 decimal digits. 
Now as per your definition, "So 0+48 added with +1000 should be 10+48" if 1000 or 1 Km is added to 48 or 480 meters it gives the result as "10+48" i.e, 10 Km and 48m whereas the correct answer should be 1+048 or 1+480 or 1+480.00 or 1.048.00.
Correct me if I am Wrong

In my case unit is feet. So the result I wanted and code written by @exceedmatches.

[BIGAL]

Depends where you are in the world here in AUS its Ch 1234.45. Postal addresses in remote areas on roads are like 1092 meaning 10920 m from a start point.