gmmdinesh Posted April 16, 2017 Share Posted April 16, 2017 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 Quote Link to comment Share on other sites More sharing options...
BIGAL Posted April 17, 2017 Share Posted April 17, 2017 (edited) 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 April 22, 2017 by BIGAL Quote Link to comment Share on other sites More sharing options...
gmmdinesh Posted April 17, 2017 Author Share Posted April 17, 2017 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. Quote Link to comment Share on other sites More sharing options...
BIGAL Posted April 17, 2017 Share Posted April 17, 2017 Fixed the 1st line problem changed it to look for a job or JOB updated code above. Quote Link to comment Share on other sites More sharing options...
gmmdinesh Posted April 17, 2017 Author Share Posted April 17, 2017 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 Quote Link to comment Share on other sites More sharing options...
BIGAL Posted April 18, 2017 Share Posted April 18, 2017 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. Quote Link to comment Share on other sites More sharing options...
gmmdinesh Posted April 18, 2017 Author Share Posted April 18, 2017 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:) Quote Link to comment Share on other sites More sharing options...
Grrr Posted April 21, 2017 Share Posted April 21, 2017 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 ) Quote Link to comment Share on other sites More sharing options...
BIGAL Posted April 22, 2017 Share Posted April 22, 2017 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. Quote Link to comment Share on other sites More sharing options...
gmmdinesh Posted April 22, 2017 Author Share Posted April 22, 2017 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 Quote Link to comment Share on other sites More sharing options...
BIGAL Posted April 22, 2017 Share Posted April 22, 2017 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 Quote Link to comment Share on other sites More sharing options...
gmmdinesh Posted April 22, 2017 Author Share Posted April 22, 2017 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 Quote Link to comment Share on other sites More sharing options...
BIGAL Posted April 23, 2017 Share Posted April 23, 2017 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 ) Quote Link to comment Share on other sites More sharing options...
gmmdinesh Posted April 23, 2017 Author Share Posted April 23, 2017 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 Quote Link to comment Share on other sites More sharing options...
kamal-issa Posted December 16, 2021 Share Posted December 16, 2021 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 Quote Link to comment Share on other sites More sharing options...
exceed Posted December 17, 2021 Share Posted December 17, 2021 (edited) 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 December 17, 2021 by exceed 1 Quote Link to comment Share on other sites More sharing options...
mhupp Posted December 17, 2021 Share Posted December 17, 2021 (edited) 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 December 17, 2021 by mhupp 1 Quote Link to comment Share on other sites More sharing options...
exceed Posted December 17, 2021 Share Posted December 17, 2021 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 ; 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 ) Quote Link to comment Share on other sites More sharing options...
mhupp Posted December 17, 2021 Share Posted December 17, 2021 (edited) 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 December 17, 2021 by mhupp 2 Quote Link to comment Share on other sites More sharing options...
exceed Posted December 17, 2021 Share Posted December 17, 2021 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 1 Quote Link to comment Share on other sites More sharing options...
Recommended Posts
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.