Jump to content

Lisp for remove one line from mtext


gmmdinesh

Recommended Posts

Hi everyone.

I need one more help. Please anyone help me.in my dwg file have lots of Mtext like this.

for Ex.

123456789

Jobs:XXXXXXX,XXXXXXX,XXXXX,XXX

ABCDIEIJ

KJSDFUEWEF

12265889

i need to remove red color bold line from mtext (I want to remove the line starts with Jobs).

Manually it will take lots of time. so i hope lisp will reduce more time.

 

 

Thanks

Link to comment
Share on other sites

This should do it as is only 1 at a time but easy to add selection. Only hiccup is 1st line can not be "Job" a bit more time required. Big thanks to Lee as usual. Additional code is at bottom.

 

; remove s to make a variable
;; CSV -> List by -  Lee Mac
;; Parses a line from a CSV file into a list of cell values.
;; str - [str] string read from CSV file
;; sep - [str] CSV separator token
;; pos - [int] initial position index (always zero)

(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:mtfr ( / ent strent ans newline x)
(setq strent (vlax-ename->vla-object (car (entsel))))
(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)
)

Edited by BIGAL
Link to comment
Share on other sites

Hi Bigal,

Thanks for your quick reply.

This lisp working good, but it removed first line only, but i need remove second line.

How to remove second line, could you please made changes in this lisp.

Because i'm newbie for lisp programming.

Please help me.

 

Once again thanks Bigal and Lee.

Link to comment
Share on other sites

Hi Bigal,

Unfortunately this code doesn't remove anything, below error shown when i try to run this lisp.

Command: MTFR

 

Select object: nil

 

Thanks

Link to comment
Share on other sites

It has no error checking so its only working with Mtext being picked. Works ok for me just copied the code from Cadtutor at work and ran fine. made multiple mtexts just picked then enter then pick and so on.

Link to comment
Share on other sites

Hi Bigal,

Thanks for your kind information.

i have try as your instruction but i got same issue,

here i have attached the sample file, could you please check in this.

Sample.dwg

 

Thanks:)

Link to comment
Share on other sites

Hi, I had to do similar task today and luckily remembered this thread - so heres some quickly written solution:

 

; Remove Mtxt Rows
(defun C:test ( / e o s i L nL )
 (and 
   (setq e (car (entsel "\nPick Mtext: ")))
   (member '(0 . "MTEXT") (entget e))
   (vlax-write-enabled-p (setq o (vlax-ename->vla-object e)))
   (setq s (vla-get-TextString o))
   (setq i -1)
   (setq L 
     (mapcar 
       (function 
         (lambda (x) 
           (setq i (1+ i)) 
           (if (/= 0 i) (vl-string-left-trim "P" (vl-list->string x)) (vl-list->string x)) 
         )
       ) 
       (SplitList 92 (vl-string->list s)) ; _$ (ascii "\\P") -> 92
     )
   ); setq L
   (setq nL (LM:listbox "Choose rows to remove" L 3))
   (setq i -1)
   (setq L (mapcar (function (lambda (x) (setq i (1+ i)) (if (/= 0 i) (strcat "\\P" x) x) )) (RemoveNths L nL)))
   (vla-put-TextString o (vl-string-left-trim "\\P" (apply 'strcat L)))
 ); and
 (princ)
); defun C:test


; _$ (RemoveNths '("A" "B" "C" "D" "E") '(0 3)) -> ("B" "C" "E")
(defun RemoveNths ( L nths / i )
 (setq i -1)
 (apply 'append (mapcar (function (lambda (x) (setq i (1+ i)) (cond ((member i nths) nil) (T (list x))))) L))
); defun RemoveNths


; _$ (SplitList "A" '("A" "B" "A" "C" "D" "E" "A" "F" "G" "H")) -> (("B") ("C" "D" "E") ("F" "G" "H"))
(defun SplitList ( delim L / m r ) ; Lee Mac
 (foreach x L (if (= x delim) (if m (setq r (cons (reverse m) r) m nil)) (setq m (cons x m)) ) )
 (reverse (if m (cons (reverse m) r) r))
)


;; List Box  -  Lee Mac
;; Displays a DCL list box allowing the user to make a selection from the supplied data.
;; msg - [str] Dialog label
;; lst - [lst] List of strings to display
;; bit - [int] 1=allow multiple; 2=return indexes
;; Returns: [lst] List of selected items/indexes, else nil

(defun LM:listbox ( msg lst bit / dch des tmp rtn )
 (cond
   (   (not
     (and
       (setq tmp (vl-filename-mktemp nil nil ".dcl"))
       (setq des (open tmp "w"))
       (write-line
         (strcat "listbox:dialog{label=\"" msg "\";spacer;:list_box{key=\"list\";multiple_select="
           (if (= 1 (logand 1 bit)) "true" "false") ";width=50;height=15;}spacer;ok_cancel;}"
         )
         des
       )
       (not (close des))
       (< 0 (setq dch (load_dialog tmp)))
       (new_dialog "listbox" dch)
     )
   )
   (prompt "\nError Loading List Box Dialog.")
   )
   (   t     
     (start_list "list")
     (foreach itm lst (add_list itm))
     (end_list)
     (setq rtn (set_tile "list" "0"))
     (action_tile "list" "(setq rtn $value)")
     (setq rtn
       (if (= 1 (start_dialog))
         (if (= 2 (logand 2 bit))
           (read (strcat "(" rtn ")"))
           (mapcar '(lambda ( x ) (nth x lst)) (read (strcat "(" rtn ")")))
         )
       )
     )
   )
 )
 (if (< 0 dch)
   (unload_dialog dch)
 )
 (if (and tmp (setq tmp (findfile tmp)))
   (vl-file-delete tmp)
 )
 rtn
)

Link to comment
Share on other sites

Found the problem with my code I was looking for Pjob not PJob so I have changed the code to ignore the text case.

 

Re pick text will look at extra bit that asks for a convert to mtext then remove the line easier then removing the line and working out all the new line spacing.

Link to comment
Share on other sites

Hi Bigal,

Thank you very much,

Second code is working good.

but when i trying to run the command (MTFR) from first code getting below error,

Select object: ; error: bad argument type: stringp T

 

 

Thanks

Link to comment
Share on other sites

Here is version 2 its been tested on your dwg, let me know how it works. It will do text as well now.

 

; remove lines of mtext based on a word
; by Alan H April 2017

; sort on x or y
; by ccowgill @ AUGI
(defun sorttxtxy ( / count1 count ss ss1 ss4 )
(setq ss (ssget '((0 . "TEXT") ))) ;_ select all objects
 (setvar "osmode" 64)
 (setq    count1 (sslength ss)
   count  1
   ss1    (ssadd)
   ss4    (list (ssname ss (1- count)))
   ss6    (ssadd)
 ) ;_ end of setq
 (while (<= (1+ count) count1)        ;SORT LIST BY X COORD LOW TO HIGH
   (setq ss3 (list (ssname ss count)))
   (setq ss4 (append ss4 ss3))
   (setq count (1+ count))
 ) ;_ end of while
 (vl-sort ss4
   ; x cadr y caddr  
   ; (function (lambda (a b) (> (cadr (assoc 11 (entget a))) (cadr (assoc 11 (entget b))))))
     (function (lambda (a b) (> (caddr (assoc 11 (entget a))) (caddr (assoc 11 (entget b))))))
 ) ;_ end of vl-sort
 (setq    count 0 ) ;_ end of setq
 (foreach ss5 (reverse ss4)
   (setq ss6 (ssadd ss5 ss6))
 )
) ; defun

(defun AH:newtext (ss6 / pt1 txtht tlen newtxt x y)
(setq newtxt "")
(setq en (vlax-ename->vla-object (ssname ss6 0)))
(setq pt1 (vlax-safearray->list (vlax-variant-value (vla-get-insertionpoint en))))
(setq txtht (vla-get-height en))
(setq tlen (* txtht 10)) ; may need to play with this
(setq pt2 (polar pt1 5.0 tlen)) ; my need to add anti and zero angle
(setq y 0)
(repeat (sslength ss6)
(setq tstr (vla-get-textstring (vlax-ename->vla-object (ssname ss6 y))))
(setq y (+ y 1))
; check for all number strings
(setq x 1)
(repeat (strlen tstr)
(if (and (> (ascii (substr tstr x 1)) 47)(<  (ascii (substr tstr x 1)) 58))
(setq num "True")
) ; if
(setq x (+ x 1))
) ;repeat
(if (= num "True")
(setq newtxt (strcat newtxt tstr "\\P"))
;(progn
(if (= (wcmatch (strcase (nth x tstr))  "PJOB*") T)
(setq newtxt (strcat newtxt "\\P"))
) ; if 
 ; progn
) ; if
) ; repeat
(command "erase" ss6 "")
(command "mtext" pt1 pt2 newtxt "")
(c:mtfr)
) ; defun

(vl-load-com)
; remove s to make a variable
;; CSV -> List by -  Lee Mac
;; Parses a line from a CSV file into a list of cell values.
;; str - [str] string read from CSV file
;; sep - [str] CSV separator token
;; pos - [int] initial position index (always zero)

(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:mtfr ( / ent strent ans newline x)
(SETQ Angbase (GETVAR "Angbase"))
(SETQ ANGDIRR (GETVAR "ANGDIR"))
(SETQ AUNITSS (GETVAR "AUNITS"))
(SETVAR "ANGBASE" 0.0)
(SETVAR "ANGDIR" 0)
(SETVAR "AUNITS" 3)

(while (setq strent (vlax-ename->vla-object (car (entsel))))
(if (= (vla-get-ObjectName strent)  "AcDbMText")
(progn
(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)))
) ;if
(setq x (+ x 1))
(vla-put-textstring strent newline)
)
) ; progn
(progn
(alert "You have picked text\n\nPick all the text\n\nto be converted to mtext")
(sorttxtxy)
(AH:newtext ss6)
) ; progn
) ; if mtext
) ; while 
) ; defun

Link to comment
Share on other sites

Hi Bigal,

Thank you so much.. this is exactly what i want...

Can you make one change in lisp, this code needs to select all the mtext in automatically and remove line.

Because lot of mtext have in my dwg file..if i want to remove the lines as per this code i have to select mtext one by one, it will take some more time.

is it possible?

 

 

Thanks:D

Link to comment
Share on other sites

This is the clue to do as many as you want. (while (setq strent (vlax-ename->vla-object (car (entsel)))) this just loops asking for you to select an entity. If you want a pick all them you need a "ssget" which makes a list of objects then you use repeat to step through the list. Its a bit complicated because you ask for text as well which I did. The problem is if you window select mtext & text you will get multiline text entries and as I am converting the text lines to mtext for simplicity I will end up with errors as I search the entity list because it will look for text items that no longer exist. You probably need a different version for Mtext only. To do a auto text as well would require a lot more thought and some rules regarding what constitutes a group of text. The sort routine would be a lot more involved doing a double sort on Y then X , multiple rows of text as paragraphs would appear to be just one if each line has the same X value.

 

; remove a line of mtext looking for a word in a line
; mtext version only
; By Alan H April 2017


; remove s to make a variable
;; CSV -> List by -  Lee Mac
;; Parses a line from a CSV file into a list of cell values.
;; str - [str] string read from CSV file
;; sep - [str] CSV separator token
;; pos - [int] initial position index (always zero)

(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:mtfr2 ( / ent strent ans newline x k ssmtxt)
(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
)

Link to comment
Share on other sites

Hi..Bigal,

Thank you so much...

I cant believe this...this code is working good.

thanks for your clue and i'll make changes as i want.

 

Thanks once again:D

Link to comment
Share on other sites

  • 4 years later...
Quote

 

Hello Bigal. thanks for the code. can you please make a code where it asks us for what we want to search for? because if we want to search for something other than "job" we have to edit the lsp file. it takes too much time. Thanks

Link to comment
Share on other sites

8 hours ago, kamal-issa said:

Hello Bigal. thanks for the code. can you please make a code where it asks us for what we want to search for? because if we want to search for something other than "job" we have to edit the lsp file. it takes too much time. Thanks

 

 

; remove a line of mtext looking for a word in a line
; mtext version only
; By Alan H April 2017


; remove s to make a variable
;; CSV -> List by -  Lee Mac
;; Parses a line from a CSV file into a list of cell values.
;; str - [str] string read from CSV file
;; sep - [str] CSV separator token
;; pos - [int] initial position index (always zero)

(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:mtfr2 ( / ent strent ans newline x k ssmtxt removetxt)
(setq ssmtxt (ssget (list (cons 0 "Mtext"))))
(setq removetxt (getstring t "\Input text to remove : "))
(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))  (strcat (strcase removetxt) "*") ) T)
(princ)
(setq newline (strcat newline "\\" (nth x ans)))
)
(setq x (+ x 1))
)
(vla-put-textstring strent newline)
) ; repeat
)

 

 

like this? 

 

options 

 

if you want not allow space bar in text to find  (can execute by space bar)

(setq removetxt (getstring t "\Input text to remove : "))

-> (setq removetxt (getstring "\Input text to remove : "))

 

if you want to double wild card

(if (= (wcmatch (strcase (nth x ans))  (strcat (strcase removetxt) "*") ) T)

-> (if (= (wcmatch (strcase (nth x ans))  (strcat "*" (strcase removetxt) "*") ) T)

 

 

 

 

this routine is great, but I found that cannot delete first row of mtext.

I don't know why, that's too difficult for me

 

Edited by exceed
  • Like 1
Link to comment
Share on other sites

3 hours ago, exceed said:

this routine is great, but I found that cannot delete first row of mtext.

I don't know why, that's too difficult for me

 

update the following.

(setq newline (nth 0 ans)) ;would automaticly add first line back in
(setq x 1) ;starts @ 2nd item in list
(repeat (- (length ans) 1)

to

(setq newline "")  ;now blank to start
(setq x 0) ;starts at first item in list
(repeat (length ans) ;repeats/checks the whole list

... also add this
(if (eq (vl-string-search "\\P" newline) 0) ;if first line is replaced.
  (setq newline (substr newline 3))         ;you need to remove //P from string or first line will be blank 
  (setq newline (substr newline 2))	    ;it will still have // in front and needs to be removed.
)
(vla-put-textstring strent newline)

 

--Edit--

You could also just ask what line to remove like this. Searching for words has the potential to delete more then just the line you want.

 

(setq removetxt (getstring t "\Input text to remove : "))
  replace above with
(setq x (getint "\nRemove Line: ")) 


(setq ans (LM:csv->lst str "\\" 0))
(setq removetxt (nth (- x 1) ans)) ;add this line afetr ans is defined.

 

 

Edited by mhupp
  • Like 1
Link to comment
Share on other sites

57 minutes ago, mhupp said:

 

update the following.


(setq newline (nth 0 ans)) ;would automaticly add first line back in
(setq x 1) ;starts @ 2nd item in list
(repeat (- (length ans) 1)

to

(setq newline "")  ;now blank to start
(setq x 0) ;starts at first item in list
(repeat (length ans) ;repeats/checks the whole list

... also add this
(if (eq (vl-string-search "\\P" newline) 0) ;if first line is replaced.
  (setq newline (substr newline 3))         ;you need to remove //P from string or first line will be blank 
  (setq newline (substr newline 2))	    ;it will still have // in front and needs to be removed.
)
(vla-put-textstring strent newline)

 

--Edit--

You could also just ask what line to remove like this. Searching for words has the potential to delete more then just the line you want.

 


(setq removetxt (getstring t "\Input text to remove : "))
  replace above with
(setq x (getint "\nRemove Line: ")) 


(setq ans (LM:csv->lst str "\\" 0))
(setq removetxt (nth (- x 1) ans)) ;add this line afetr ans is defined.

 

 

 

 

It's cool!  it works on first line. then solve // problem

thank you for great answer:thumbsup: 

 

; remove a line of mtext looking for a word in a line
; mtext version only
; By Alan H April 2017


; remove s to make a variable
;; CSV -> List by -  Lee Mac
;; Parses a line from a CSV file into a list of cell values.
;; str - [str] string read from CSV file
;; sep - [str] CSV separator token
;; pos - [int] initial position index (always zero)

(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:mtfr2 ( / ent strent ans newline x k ssmtxt removetxt)
(setq ssmtxt (ssget (list (cons 0 "Mtext"))))
(setq removetxt (getstring t "\Input text to remove : "))
(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 "")  ;now blank to start
(setq x 0) ;starts at first item in list
(repeat (length ans) ;repeats/checks the whole list

(if (= (wcmatch (strcase (nth x ans))  (strcat "*" (strcase removetxt) "*") ) T)
;(if (= (wcmatch (strcase (nth x ans))  (strcase removetxt) ) T)
(princ)
(setq newline (strcat newline "\\" (nth x ans)))
)
(setq x (+ x 1))
)
(if (eq (vl-string-search "\\P" newline) 0) ;if first line is replaced.
  (setq newline (substr newline 3))         ;you need to remove //P from string or first line will be blank 
  (setq newline (substr newline 2))	    ;it will still have // in front and needs to be removed.
)

(vla-put-textstring strent newline)
) ; repeat
)

 

 

 

 

 

but I fail to apply 2nd one. 

it deletes too much and randomly.😅 

; remove a line of mtext looking for a word in a line
; mtext version only
; By Alan H April 2017


; remove s to make a variable
;; CSV -> List by -  Lee Mac
;; Parses a line from a CSV file into a list of cell values.
;; str - [str] string read from CSV file
;; sep - [str] CSV separator token
;; pos - [int] initial position index (always zero)

(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:mtfr1 ( / ent strent ans newline x k ssmtxt removetxt)
(setq ssmtxt (ssget (list (cons 0 "Mtext"))))
(setq x (getint "\nRemove Line: ")) 
(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 removetxt (nth (- x 1) ans))
(setq newline (nth 0 ans))
(setq x 1)

(repeat (- (length ans) 1)

(if (= (wcmatch (strcase (nth x ans))  (strcat "*" (strcase removetxt) "*") ) T)
;(if (= (wcmatch (strcase (nth x ans))  (strcase removetxt) ) T)
(princ)
(setq newline (strcat newline "\\" (nth x ans)))
)
(setq x (+ x 1))
)
(if (eq (vl-string-search "\\P" newline) 0) ;if first line is replaced.
  (setq newline (substr newline 3))         ;you need to remove //P from string or first line will be blank 
  (setq newline (substr newline 2))	    ;it will still have // in front and needs to be removed.
)
(vla-put-textstring strent newline)
) ; repeat
)

 

Link to comment
Share on other sites

26 minutes ago, exceed said:

but I fail to apply 2nd one. 

it deletes too much and randomly.😅

 

Updating to asking for the line # instead of text also needs the first changes done as well.

; mtext find remove
(defun C:mtfr2 (/ ent strent ans newline x k ssmtxt removetxt)
  (setq ssmtxt (ssget '((0 . "Mtext"))))
  (setq x (getint "\nLine To Remove: "))
  (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 removetxt (nth (- x 1) ans))
    (setq newline "")
    (setq x 0)
    (repeat (length ans)
      (if (= (wcmatch (strcase (nth x ans)) (strcase removetxt)) T) ;doesn't need a wild card.
        (princ)
        (setq newline (strcat newline "\\" (nth x ans)))
      )
      (setq x (+ x 1))
    )
    (if (eq (vl-string-search "\\P" newline) 0) 
      (setq newline (substr newline 3))
      (setq newline (substr newline 2))
    )
    (vla-put-textstring strent newline)
  )  ; repeat
  (princ)
)

 

Edited by mhupp
  • Like 2
Link to comment
Share on other sites

5 minutes ago, mhupp said:

 

Updating to asking for the line # instead of text also needs the first changes done as well.

 

 

 

oh that's what I missed, Thanks a lot 😆

  • Like 1
Link to comment
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
×
  • Create New...