To remove some specific text & rearrange words

March 16, 2019

Hi friends,

I have a drawing, which contains lots of Mtext Available on that drawing, my request is to remove some specific word from the drawing & also to keep only last word from each line

& atlast NX text has to be added at the end of the each line in aligned.

To Explain the above, i have attached the images, in that images i have mentioned steps to be done in this request.

step1: shows the original condition of this Mtext

step2: all NX word has to be removed from the Mtext (All over the drawing)

step3: from line 3, i need only the last word only to be kept in drawing

step4: NX has to be added at the end of each line as shown in pic.

Sample.dwg

March 16, 2019

Step 3 is a bit difficult as there is no real pattern that can be used to just do an all in one go. if you look for a word by checking the string for a space then discard what is after 1s word, the problem is that 1st line has spaces, but you want it kept.

Is the 1st line always to be kept as is with spaces ? Then a simple answer can be done by skipping 1st line.

Step 1 code for testing

; Remove text  in text or mtext
; By Alan H March 2019
; Hard coded for string for testing
 
(defun c:test ( / obj str rem txt txtstr pos x y)
(setq txtstr "\tNX")
(setq ss (ssget (list (cons 0 "*text"))))
(repeat (setq x (sslength ss))
(setq obj (vlax-ename->vla-object (ssname ss (setq x (- x 1)))))
(setq txt (vla-get-textstring obj))
(setq y 1)
(while (> (setq pos (vl-string-search txtstr txt)) 0)
(setq str (SUBSTR TXT  1 POS  ))
(Setq rem (substr txt (+ pos 4)))
(setq txt (strcat str rem))
(princ (setq y (+ y 1)))
)
(vla-put-textstring obj txt)
)
)
(c:test)

March 17, 2019

Hi Bigal,

Thank you so much for looking on this topic, i have tested with your code, it works perfectly for step 1,

i have few modification in above request, it can be either done in below any one methods, whichever is feasible

request 1: please ignore the first two lines, just keep as it is & from line 3 we can consider for removing NX & we can discard all words except last word from each line.

request 2: if request is not possible, is it possible to convert the first 2 lines separated & remaining separated from line 3, so we can apply the conditions in second part(from line 3) Mtext

finally it should appear as in attached image

March 17, 2019

Its becoming big job, almost got 1st word plus NC but if you want NC lined up a bit more again.

Anyone else have a go. I think I am approaching it wrong, maybe throw it away and start again.

Edited March 17, 2019 by BIGAL

March 17, 2019

This sort of works I need to go away and revisist, just do test and pick 1 mtext, if you pick them all does something screwy I just can not see it any one else please have a look.


; custom edit text remove some values add others
; convert mtext to list look for \\p 1st part
; then rip out anything past 1 word using tabs
: BY alan H March 2019


;(defun c:test ( / ans ss obj Y  W lst nlst str  x txt txtstr pos)
(defun c:test ( /)
(if (not AH:getvalsm)(load "Multi Getvals.lsp"))
(setq ans (AH:getvalsm (list "Enter values" "Word to remove" 8 6 "NX" "Word to add" 8 6 "NC" "Lines at start" 5 4 "2")))
(setq txtstr "\\P")
(setq ss (ssget (list (cons 0 "*text"))))
(repeat (setq k (sslength ss))
(setq obj (vlax-ename->vla-object (ssname ss (setq k (- k 1)))))
(setq txt (vla-get-textstring obj))
(setq y 1)
(setq lst '())
(while (> (setq  pos (vl-string-search txtstr txt)) 0)
(setq str (SUBSTR TXT 1 POS ))
(setq lst (cons str lst))
(Setq txt (substr txt (+ pos  3)))
(princ (setq y(+ y 1)))
)
(princ "\n")
(setq nlst '())
(setq w 0)
(setq txtstr "\t")
(repeat (length lst)
(setq txt (nth w lst))
(setq pos (vl-string-search txtstr txt))
(setq txt (SUBSTR TXT 1 POS  ))
(setq nlst (cons txt nlst))
(setq w (+ w 1))
)
(setq nlst (reverse nlst))
( setq j 0)
(setq str "")
(repeat (length nlst)
(setq str (strcat (nth j nlst) "\t" (nth 1 ans)"\\P"  str ))
(setq  j (+ j 1))
)
(vla-put-textstring obj str)
(princ lst)
)
) 
(c:test)

Multi GETVALS.lsp

March 17, 2019

(defun KGA_Conv_Pickset_To_ObjectList (ss / i ret)
  (if ss
    (repeat (setq i (sslength ss))
      (setq ret (cons (vlax-ename->vla-object (ssname ss (setq i (1- i)))) ret))
    )
  )
)

(defun KGA_String_Join (strLst delim)
  (if strLst
    (apply
      'strcat
      (cons
        (car strLst)
        (mapcar '(lambda (a) (strcat delim a)) (cdr strLst))
      )
    )
    ""
  )
)

(defun KGA_String_SplitAll (str sub ignoreCaseP / i j len lst srchStr)
  (if (/= 0 (setq len (strlen sub)))
    (progn
      (if ignoreCaseP
        (progn
          (setq srchStr (strcase str))
          (setq sub (strcase sub))
        )
        (setq srchStr str)
      )
      (setq i 0)
      (while (setq j (vl-string-search sub srchStr i))
        (setq lst (cons (substr str (1+ i) (- j i)) lst))
        (setq i (+ j len))
      )
      (reverse (cons (substr str (1+ i)) lst))
    )
  )
)

(defun UpdateMtext (obj / strLst)
  (setq strLst (KGA_String_SplitAll (vla-get-textstring obj) "\\P" nil))
  (vla-put-textstring
    obj
    (strcat
      "\\pxt15;" ; Tab setting.
      (KGA_String_Join
        (append
          (list
            (car strLst)
            (cadr strLst)
          )
          (mapcar
            '(lambda (sub / lst)
              (strcat
                (last (vl-remove "NX" (KGA_String_SplitAll sub "\t" nil)))
                "\tNC"
              )
            )
            (cddr strLst)
          )
        )
        "\\P"
      )
    )
  )
)

(defun c:Test ( / doc ss)
  (setq doc (vla-get-activedocument (vlax-get-acad-object)))
  (vla-endundomark doc)
  (vla-startundomark doc)
  (if (setq ss (ssget '((0 . "MTEXT"))))
    (foreach obj (KGA_Conv_Pickset_To_ObjectList ss)
      (UpdateMtext obj)
    )
  )
  (vla-endundomark doc)
  (princ)
)

March 17, 2019

2 hours ago, BIGAL said:

Hi Bigal,

Thank you so much for your code, it almost works great

As you said its behaving screwy if i pick multiple, it works fine for single

one more thing to mention, i have given to start change from line 3,but its applying NC for line 1 & 2 also,

could you check it.

March 17, 2019

Hi Roy,

It works perfectly for multiple pick selection of texts & also its ignore line 1 & 2 for NC, its really perfectly

I Hearlty appreciate your great work, Thank you so much for your code

One Kind request, is it possible to align all NC texts uniformly as shown in attached picture, then my work gets 100% complete

Edited March 17, 2019 by amb2301

March 17, 2019

Hmm, on my system (but I use BricsCAD) the NCs are being aligned as you want. Can you post a dwg with the desired result. I suspect this may be a case where BricsCAD is not fully compatible.

March 17, 2019

Hi Roy,

Thank you so much for your response

Actually the problem is in my drawing, all Mtexts are available with width of 0, if i increase the width manually to 40, then i used

your lisp, it works perfectly & all texts getting aligned as per the my requirements.

To make the Mtext width increase using lisp, i got a code from online, attaching that code, could you please help me to merge this with your provided

code, since i can do all works in a single go.'

Awaiting for your reply, Thanks in Advance

(vl-load-com)

(defun c:wid (/ *error* ss acDoc i e)

  (defun *error* (msg)
    (if s
      (vla-delete s)
    )
    (if acDoc
      (vla-endundomark acDoc)
    )
    (cond ((not msg))                                                   ; Normal exit
          ((member msg '("Function cancelled" "quit / exit abort")))    ; <esc> or (quit)
          ((princ (strcat "\n** Error: " msg " ** ")))                  ; Fatal error, display it
    )
    (princ)
  )

  (if (setq ss (ssget "_:L" '((0 . "MTEXT"))))    
    (progn
      (vla-startundomark
        (setq acDoc (vla-get-activedocument (vlax-get-acad-object)))
      )
      (repeat (setq i (sslength ss))
        (setq e (entget (ssname ss (setq i (1- i))))
              e (append e '((75 . 0)))
              e (subst '(41 . 40.0) (assoc 41 e) e)
        )
        (entmod e)
      )
    )
  )
  (*error* nil)
)

(princ)

March 17, 2019

Change the c:Test function to:

(defun c:Test ( / doc ss)
  (setq doc (vla-get-activedocument (vlax-get-acad-object)))
  (vla-endundomark doc)
  (vla-startundomark doc)
  (if (setq ss (ssget '((0 . "MTEXT"))))
    (foreach obj (KGA_Conv_Pickset_To_ObjectList ss)
      (UpdateMtext obj)
      (vla-put-width obj 40.0)
    )
  )
  (vla-endundomark doc)
  (princ)
)

March 18, 2019

Thank you so much Roy, its working as expected.

i am so thankfull to you

March 19, 2019

Hi Roy,

sorry for disturbing you again,

A small help required, Actually i want to remove the line 3 from some of the Mtext, i already have a lisp(please check the attached) which removes the line 3,

but after that if i use your above code to remove NC, it goes screwy(please check attached screenshot), could you please check with attached sample file.

(defun LM:csv->lst ( str sep pos / s )
    (cond
        (   (not (setq pos (vl-string-search sep str pos)))
            (if (wcmatch str "\"*\"")
                (list (LM:csv-replacequotes (substr str 2 (- (strlen str) 2))))
                (list str)
            )
        )
        (   (or (wcmatch (setq s (substr str 1 pos)) "\"*[~\"]")
                (and (wcmatch s "~*[~\"]*") (= 1 (logand 1 pos)))
            )
            (LM:csv->lst str sep (+ pos 2))
        )
        (   (wcmatch s "\"*\"")
            (cons
                (LM:csv-replacequotes (substr str 2 (- pos 2)))
                (LM:csv->lst (substr str (+ pos 2)) sep 0)
            )
        )
        (   (cons s (LM:csv->lst (substr str (+ pos 2)) sep 0)))
    )
)

(defun LM:csv-replacequotes ( str / pos )
    (setq pos 0)
    (while (setq pos (vl-string-search  "\"\"" str pos))
        (setq str (vl-string-subst "\"" "\"\"" str pos)
              pos (1+ pos)
        )
    )
    str
)

; mtext find remove
(defun C:jobs ( / ent strent ans newline x k ssmtxt )
(command ".undo" "m")
(setq ssmtxt (ssget (list (cons 0 "Mtext"))))
(repeat (setq k (sslength ssmtxt))
(setq strent (vlax-ename->vla-object (ssname ssmtxt (setq k (- k 1)))))
(setq str (vla-get-textstring strent))
(setq ans (LM:csv->lst str "\\" 0))
(setq newline (nth 0 ans))
(setq x 1)
(repeat (- (length ans) 1)
(if (= (wcmatch (strcase (nth x ans))  "PJOB*") T)
(princ)
(setq newline (strcat newline "\\" (nth x ans)))
)
(setq x (+ x 1))
)
(vla-put-textstring strent newline)
) ; repeat
)

sample_.dwg

Edited March 19, 2019 by amb2301

March 20, 2019

The issue is probably that the original mtext ends in an empty line.

(defun KGA_Conv_Pickset_To_ObjectList (ss / i ret)
  (if ss
    (repeat (setq i (sslength ss))
      (setq ret (cons (vlax-ename->vla-object (ssname ss (setq i (1- i)))) ret))
    )
  )
)

(defun KGA_String_Join (strLst delim)
  (if strLst
    (apply
      'strcat
      (cons
        (car strLst)
        (mapcar '(lambda (a) (strcat delim a)) (cdr strLst))
      )
    )
    ""
  )
)

(defun KGA_String_SplitAll (str sub ignoreCaseP / i j len lst srchStr)
  (if (/= 0 (setq len (strlen sub)))
    (progn
      (if ignoreCaseP
        (progn
          (setq srchStr (strcase str))
          (setq sub (strcase sub))
        )
        (setq srchStr str)
      )
      (setq i 0)
      (while (setq j (vl-string-search sub srchStr i))
        (setq lst (cons (substr str (1+ i) (- j i)) lst))
        (setq i (+ j len))
      )
      (reverse (cons (substr str (1+ i)) lst))
    )
  )
)

(defun UpdateMtext (obj / strLst)
  (setq strLst (vl-remove "" (KGA_String_SplitAll (vla-get-textstring obj) "\\P" nil))) ; Remove empty lines.
  (vla-put-textstring
    obj
    (strcat
      "\\pxt15;" ; Tab setting.
      (KGA_String_Join
        (append
          (list
            (car strLst)
            (cadr strLst)
          )
          (mapcar
            '(lambda (sub / lst)
              (strcat
                (last (vl-remove "NX" (KGA_String_SplitAll sub "\t" nil)))
                "\tNC"
              )
            )
            (cddr strLst)
          )
        )
        "\\P"
      )
    )
  )
)

(defun c:Test ( / doc ss)
  (setq doc (vla-get-activedocument (vlax-get-acad-object)))
  (vla-endundomark doc)
  (vla-startundomark doc)
  (if (setq ss (ssget '((0 . "MTEXT"))))
    (foreach obj (KGA_Conv_Pickset_To_ObjectList ss)
      (UpdateMtext obj)
      (vla-put-width obj 40.0) ; Required for AutoCAD.
    )
  )
  (vla-endundomark doc)
  (princ)
)

March 20, 2019

hi Roy,

You are right, as you said there is a empty line i found at the end of original mtext, if i do following steps its getting disappears, could you please look on that

step_1: please refer pic, it shows the original mtext with empty line at the end & text width 0

step_2: please refer pic, i manually increased the text width to required length, even then i found that empty line at end of mtext

step_3: then i just came out of mtext edit mode & clicked outside

step_4: please refer pic, Now i did mtext edit again & checked it, Here i found the empty line disappeared at the end of mtext.

after the above steps i used your code, its working fine

kindly help me to resolve this issue.

Edited March 20, 2019 by amb2301

March 20, 2019

Hi Roy,

just i checked it, no need to increase the text width(step_2) as mentioned in above thread,

just i did the command ED & selected the mtext & clicked outside,

if i check again the mtext, empty line get disappears

kind request: if possible could you please give me a same lisp with additional task like to remove line 3

fyi.......i checked with your revised latest lisp code, its not removing the empty line

Edited March 20, 2019 by amb2301

March 20, 2019

The last version should remove those empty lines, and it works on the latest sample you have posted. Maybe the line is not empty as it contains spaces and/or tabs?

March 20, 2019

Hi Roy,

Thank you so much its working fine, i checked again now, maybe problem in myside

thank you so much, last version is working fine.

only thing is i need to remove line3 , could you please help me on that part.

March 21, 2019

(defun KGA_Conv_Pickset_To_ObjectList (ss / i ret)
  (if ss
    (repeat (setq i (sslength ss))
      (setq ret (cons (vlax-ename->vla-object (ssname ss (setq i (1- i)))) ret))
    )
  )
)

(defun KGA_String_Join (strLst delim)
  (if strLst
    (apply
      'strcat
      (cons
        (car strLst)
        (mapcar '(lambda (a) (strcat delim a)) (cdr strLst))
      )
    )
    ""
  )
)

(defun KGA_String_SplitAll (str sub ignoreCaseP / i j len lst srchStr)
  (if (/= 0 (setq len (strlen sub)))
    (progn
      (if ignoreCaseP
        (progn
          (setq srchStr (strcase str))
          (setq sub (strcase sub))
        )
        (setq srchStr str)
      )
      (setq i 0)
      (while (setq j (vl-string-search sub srchStr i))
        (setq lst (cons (substr str (1+ i) (- j i)) lst))
        (setq i (+ j len))
      )
      (reverse (cons (substr str (1+ i)) lst))
    )
  )
)

(defun UpdateMtext (obj remove3rdP / strLst)
  (setq strLst (vl-remove "" (KGA_String_SplitAll (vla-get-textstring obj) "\\P" nil))) ; Remove empty lines.
  (vla-put-textstring
    obj
    (strcat
      "\\pxt15;" ; Tab setting.
      (KGA_String_Join
        (append
          (list
            (car strLst)
            (cadr strLst)
          )
          (mapcar
            '(lambda (sub / lst)
              (strcat
                (last (vl-remove "NX" (KGA_String_SplitAll sub "\t" nil)))
                "\tNC"
              )
            )
            (if remove3rdP
              (cdddr strLst)
              (cddr strLst)
            )
          )
        )
        "\\P"
      )
    )
  )
)

(defun c:FixMtextKeep3dLine ( / doc ss)
  (setq doc (vla-get-activedocument (vlax-get-acad-object)))
  (vla-endundomark doc)
  (vla-startundomark doc)
  (if (setq ss (ssget '((0 . "MTEXT"))))
    (foreach obj (KGA_Conv_Pickset_To_ObjectList ss)
      (UpdateMtext obj nil)
      (vla-put-width obj 40.0) ; Required for AutoCAD.
    )
  )
  (vla-endundomark doc)
  (princ)
)

(defun c:FixMtextRemove3dLine ( / doc ss)
  (setq doc (vla-get-activedocument (vlax-get-acad-object)))
  (vla-endundomark doc)
  (vla-startundomark doc)
  (if (setq ss (ssget '((0 . "MTEXT"))))
    (foreach obj (KGA_Conv_Pickset_To_ObjectList ss)
      (UpdateMtext obj T)
      (vla-put-width obj 40.0) ; Required for AutoCAD.
    )
  )
  (vla-endundomark doc)
  (princ)
)

March 22, 2019

Thank you so much , i really appreciate your work

Sign In

To remove some specific text & rearrange words

Recommended Posts

amb2301

BIGAL

amb2301

BIGAL

BIGAL

Roy_043

amb2301

amb2301

Roy_043

amb2301

Roy_043

amb2301

amb2301

Roy_043

amb2301

amb2301

Roy_043

amb2301

Roy_043

amb2301

Join the conversation

Tutorials

Forums

Activity