Erasing the text in the 2nd line of an Mtext

April 13, 2011

hi guys. its me again and looking for another solution to my current lisp routine. i have a lisp created by Lee Mac to erase the First line of the Mtext. i tried to edit it so that it would delete the 2nd line this time. but sadly i can't make it to work. here is the script...

(if (not (or StripMText (load "StripMtext v5-0b" nil)))
 (princ "\nStripMText couldn't be loaded.")
)
(defun c:mtd2 ( / *error* ss ) (vl-load-com)
 ;; © Lee Mac 2010, www.lee-mac.com

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

 (if (setq ss (ssget "_:L" '((0 . "MTEXT") (1 . "*\\P*"))))
   (progn
     (if StripMText (StripMtext ss '("F")))
     (
       (lambda ( i / RegEx e rep xd ) (setq RegEx (vlax-create-object "VBScript.RegExp"))
         
         (mapcar '(lambda ( x ) (vlax-put-property RegEx (car x) (cdr x)))
           (list
             (cons 'pattern "^(.*)\\\\P.*$")
             (cons 'global     actrue)
             (cons 'ignorecase actrue)
             (cons 'multiline  actrue)
           )
         )            
         (while (setq e (ssname ss (setq i (1+ i))))
           (
             (lambda ( font )            
               (setq rep (strcat "{[b][color="red"]\\fCalibri|b1|i0|c0|p34;$1[/color][/b]}"))
             )
             (if (setq xd (cdadr (assoc -3 (entget (tblobjname "STYLE" (cdr (assoc 7 (entget e)))) '("ACAD")))))
               (cdr (assoc 1000 xd))
               "Arial"
             )
           )  
           (entupd
             (cdr
               (assoc -1
                 (entmod
                   (subst
                     (cons 1
                       (vlax-invoke RegEx 'replace (cdr (assoc 1 (entget e))) rep)
                     )
                     (assoc 1 (entget e)) (entget e)                      
                   )
                 )
               )
             )
           )
         )
         (LM:ReleaseObject RegEx)
       )
       -1
     )
   )
 )

 (princ)
)

;;------------------=={ Release Object }==--------------------;;
;;                                                            ;;
;;  Releases a VLA Object from memory via plentiful error     ;;
;;  trapping                                                  ;;
;;------------------------------------------------------------;;
;;  Author: Lee Mac, Copyright © 2010 - www.lee-mac.com       ;;
;;------------------------------------------------------------;;
;;  Arguments:                                                ;;
;;  obj - VLA Object to be released from memory               ;;
;;------------------------------------------------------------;;
;;  Returns:  T if Object Released, else nil                  ;;
;;------------------------------------------------------------;;

(defun LM:ReleaseObject ( obj ) (vl-load-com)
 ;; © Lee Mac 2010
 (and obj (eq 'VLA-OBJECT (type obj)) (not (vlax-object-released-p obj))
   (not
     (vl-catch-all-error-p
       (vl-catch-all-apply
         (function vlax-release-object) (list obj)
       )
     )
   )
 )
)

the red text is the part i tried to edit. any help is greatly appreciated. thanks.

April 13, 2011

Check this out buddy .

(vl-load-com)
(defun c:TesT (/ ss)
 ; TharwaT 13. 04. 2011
 (if (setq ss (ssget "_:L" '((0 . "MTEXT"))))
   ((lambda (i / sset e str pt)
      (while
        (setq sset (ssname ss (setq i (1+ i))))
         (setq e (entget sset))
         (setq str (cdr (assoc 1 (entget sset))))
         (if (setq pt (vl-string-search "\\P" str))
           (entupd
             (cdr (assoc -1
                         (entmod (subst (cons 1 (substr str 1  pt ))
                                        (assoc 1 e)
                                        e
                                 )
                         )
                  )
             )
           )
         )
      )
    )
     -1
   )
 )
 (princ)
)

TharwaT

April 14, 2011

thanks for the reply buddy. i tried your code but the result is that it erases the 1st line, not the 2nd line. what i want is to delete the 2nd line and retain the first line.

April 14, 2011

hi guys.. finally i get it to work!! its the pattern that i have to change..

from this:

(cons 'pattern "^(.*)\\\\P.*$")

to this:

(cons 'pattern "^(.*)\\\\P(.*)$")

and this one:

(setq rep (strcat "{\\fCalibri|b1|i0|c0|p34;$1}"))

to this one:

(setq rep (strcat "{\\fCalibri|b1|i0|c0|p34;$2}"))

thanks Tharwat and Lee.. should have to learn more in doing lisp coding.

Problem solved!

April 14, 2011

The routine did not work for you due to the old version of Cad maybe , and here it works normal in Cads 2009 and 2010 .

April 14, 2011

You could use

;(ascii "\n") or 10 will produce the same results
(setq newText (substr text 1 (1-(vl-string-position (ascii "\n") text))))

Haven't tested the above so the 1- might not be required but other than that this line will strip any additonal lines from the string.

April 14, 2011

You could use
;(ascii "\n") or 10 will produce the same results
(setq newText (substr text 1 (1-(vl-string-position (ascii "\n") text))))
Haven't tested the above so the 1- might not be required but other than that this line will strip any additonal lines from the string.

Within text, "\n" is a soft carriage return. Normally, you will see "\\P", a hard carriage return.

April 14, 2011

(defun c:Test (/ ss i e s p)
 (vl-load-com)
 (if (setq ss (ssget "_:L" '((0 . "MTEXT"))))
   (repeat (setq i (sslength ss))
     (if (setq p (cond ((vl-string-search
                          "\\P"
                          (setq s (apply 'strcat
                                         (mapcar '(lambda (x)
                                                    (if (vl-position (car x) '(1 3))
                                                      (cdr x)
                                                      ""
                                                    )
                                                  )
                                                 (entget (setq e (ssname ss (setq i (1- i)))))
                                         )
                                  )
                          )
                        )
                       )
                       ((vl-string-search "\n" s))
                 )
         )
       (vla-put-textstring (vlax-ename->vla-object e) (substr s 1 p))
     )
   )
 )
 (princ)
)

April 14, 2011

Within text, "\n" is a soft carriage return. Normally, you will see "\\P", a hard carriage return.

This is probably more down to ignorance on my part than anything else but. Wouldn't "\\P" look for the string literal "\P" and not the "\P" unicode hard carriage return? (first "\" neutralising the second leaving a single "\" and "P"). Other than that I agree hard carriage return is the way forward

April 14, 2011

This is probably more down to ignorance on my part than anything else but. Wouldn't "\\P" look for the string literal "\P" and not the "\P" unicode hard carriage return? (first "\" neutralising the second leaving a single "\" and "P"). Other than that I agree hard carriage return is the way forward

No. The code is "\\P" and that's what you need to search for.

BAD CODE YELLOWED OUT:

[color=yellow](defun c:Test (/ ss i e s p)
 (vl-load-com)
 (if (setq ss (ssget "_:L" '((0 . "MTEXT"))))
   (repeat (setq i (sslength ss))
     (if (setq p (cond ((vl-string-search
                          "\\P"
                          (setq s (vl-string-left-trim
                                    "\n"
                                    (vl-string-left-trim
                                      "\\P"
                                      (vl-string-left-trim
                                        "\n"
                                        (apply 'strcat
                                               (mapcar '(lambda (x)
                                                          (if (vl-position (car x) '(1 3))
                                                            (cdr x)
                                                            ""
                                                          )
                                                        )
                                                       (entget (setq e (ssname ss (setq i (1- i)))))
                                               )
                                        )
                                      )
                                    )
                                  )
                          )
                        )
                       )
                       ((vl-string-search "\n" s))
                 )
         )
       (vla-put-textstring (vlax-ename->vla-object e) (substr s 1 p))
     )
   )
 )
 (princ)
)[/color]

Edited April 14, 2011 by alanjt

April 14, 2011

I was about to say that you could combine those string-left-trim statements into:

(vl-string-left-trim "\\P\n" ...

But that thinking also led me to point out:

_$ (vl-string-left-trim "\\P" "Program")
"rogram"

Since the string-trim functions deal in characters.

Edited April 14, 2011 by Lee Mac

April 14, 2011

Maybe this could be another approach:

(defun c:test ( / ss i ) (vl-load-com)

 (if (setq ss (ssget "_:L" '((0 . "MTEXT") (1 . "*\\P*,*\n*"))))
   (repeat (setq i (sslength ss))
     (
       (lambda ( / e s )      
         (foreach x (entget (setq e (ssname ss (setq i (1- i)))))
           (if (member (car x) '(1 3))
             (setq s (cons (cdr x) s))
           )
         )
         (setq s
           (read
             (strcat "(\""
               (LM:StringSubst "\" \"" "\\P"
                 (LM:StringSubst "\" \"" "\n" (apply 'strcat s))
               )
               "\")"
             )
           )
         )
         (vla-put-Textstring (vlax-ename->vla-object e) (car s))
       )
     )
   )
 )
 (princ)
)

(defun LM:StringSubst ( new old string / l i ) (setq l (strlen new) i 0)
 (while (setq i (vl-string-search old string i))
   (setq string (vl-string-subst new old string i) i (+ i l))
 )
 string
)

Edited June 8, 2019 by Lee Mac

April 14, 2011

I was about to say that you could combine those string-left-trim statements into:
(vl-string-left-trim "\\P\n" ...
But that thinking also led me to point out:
_$ (vl-string-left-trim "\\P" "Program")
"rogram"
Since the string-trim functions deal in characters.

How odd. I always just assumed the vl-string-* functions always searched/trimmed based on only finding the exact supplied string, not a portion of it.

April 14, 2011

Maybe this could be another approach:

Try it on text with the following string:

(1 . "\\Pthis\\Pis a test")

BTW, why are you creating an anonymous function in the middle of your repeat?

Also, am I missing something as to why your string will be strcat'ed in a reverse order?

April 14, 2011

string-*

search / subst deal in matches

translate / right-trim / left-trim / trim / position deal in characters

April 14, 2011

string-*

search / subst deal in matches

translate / right-trim / left-trim / trim / position deal in characters

Hmph, I never knew.

April 14, 2011

alanjt said:
Try it on text with the following string:
(1 . "\\Pthis\\Pis a test")

Oops! Forgot the vl-remove!

(defun c:test ( / ss i ) (vl-load-com)

 (if (setq ss (ssget "_:L" '((0 . "MTEXT") (1 . "*\\P*,*\n*"))))
   (repeat (setq i (sslength ss))
     (
       (lambda ( / e s )      
         (foreach x (entget (setq e (ssname ss (setq i (1- i)))))
           (if (member (car x) '(1 3))
             (setq s (cons (cdr x) s))
           )
         )
         (setq s
           (vl-remove ""
             (read
               (strcat "(\""
                 (LM:StringSubst "\" \"" "\\P"
                   (LM:StringSubst "\" \"" "\n" (apply 'strcat (reverse s)))
                 )
                 "\")"
               )
             )
           )
         )
         (vla-put-Textstring (vlax-ename->vla-object e) (car s))
       )
     )
   )
 )
 (princ)
)

(defun LM:StringSubst ( new old string / l i ) (setq l (strlen new) i 0)
 (while (setq i (vl-string-search old string i))
   (setq string (vl-string-subst new old string i) i (+ i l))
 )
 string
)

alanjt said:

Also, am I missing something as to why your string will be strcat'ed in a reverse order?

Ah yes, you're quite right - added a reverse above

I'll leave the old code, to help those learning.

alanjt said:

BTW, why are you creating an anonymous function in the middle of your repeat?

To localise the variable 's'

Edited June 8, 2019 by Lee Mac

April 14, 2011

I had already tweaked it, so I'll post my mod:

(defun c:test (/ ss i e)
 (vl-load-com)

 (if (setq ss (ssget "_:L" '((0 . "MTEXT") (1 . "*\\P*,*\n*"))))
   (repeat (setq i (sslength ss))
     (vla-put-Textstring
       (vlax-ename->vla-object (setq e (ssname ss (setq i (1- i)))))
       (car (vl-remove ""
                       (read
                         (strcat "(\""
                                 (LM:StringSubst
                                   "\" \""
                                   "\\P"
                                   (LM:StringSubst
                                     "\" \""
                                     "\n"
                                     (apply 'strcat
                                            (mapcar '(lambda (x)
                                                       (if (vl-position (car x) '(1 3))
                                                         (cdr x)
                                                         ""
                                                       )
                                                     )
                                                    (entget e)
                                            )
                                     )
                                   )
                                 )
                                 "\")"
                         )
                       )
            )
       )
     )
   )
 )
 (princ)
)

(defun LM:StringSubst (new old string / l i)
 (setq l (strlen new)
       i 0
 )
 (while (setq i (vl-string-search old string i))
   (setq string (vl-string-subst new old string i)
         i      (+ i l)
   )
 )
 string
)

April 14, 2011

LoL

You know, since we're using the ssget filter

(1 . "*\\P*,*\n*")

we could just retrieve the text string with

(cdr (assoc 1 (entget e)))

instead of stepping through the entire entity data dump.

April 14, 2011

Not necessary, in case DXF 1 started with either "\\P" or "\n" and the next line of text didn't start until somewhere within the DXF 3 block perhaps.

Sign In

Erasing the text in the 2nd line of an Mtext

Recommended Posts

LearningLisP

Top Posters In This Topic

Popular Days

Top Posters In This Topic

Popular Days

Posted Images

Tharwat

LearningLisP

LearningLisP

Tharwat

SOliver

alanjt

alanjt

SOliver

alanjt

Lee Mac

Lee Mac

alanjt

alanjt

Lee Mac

alanjt

Lee Mac

alanjt

alanjt

Lee Mac

Join the conversation

Tutorials

Forums

Activity