To remove some specific text & rearrange words

[amb2301]

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

[BIGAL]

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)

 

 

 

 

[amb2301]

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

 

[BIGAL]

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

[BIGAL]

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

[Roy_043]

(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)
)

 

[amb2301]

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.

 

 

[amb2301]

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

[Roy_043]

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.

[amb2301]

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)

[Roy_043]

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)
)

 

[amb2301]

Thank you so much Roy, its working as expected.

i am so thankfull to you

[amb2301]

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

[Roy_043]

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)
)

 

[amb2301]

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

[amb2301]

 

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

[Roy_043]

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?

[amb2301]

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.

[Roy_043]

(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)
)

 

[amb2301]

Thank you so much , i really appreciate your work