trb426 Posted January 17 Share Posted January 17 Hello brilliant, good an kind folks. I have a bunch of MTEXT labels that my !@#$% drafter entered the text in the wrong order (and he only spent 47 hours doing it). For example: N/F 82-146 ANDREW ANAGNOST DEED BK 1213 PG 567 should actually read N/F ANDREW ANAGNOST 82-146 DEED BK 1213 PG 567 It seems like it would be prettty easy... but it's beyond my rudimentary lisp capabilities. Quote Link to comment Share on other sites More sharing options...
BIGAL Posted January 18 Share Posted January 18 Post sample need to look at the actual Mtext as it may have hidden mtext controls, like Bold. Quote Link to comment Share on other sites More sharing options...
Steven P Posted January 18 Share Posted January 18 Which parts of the mtext are the same for all labels and which parts change? I guess line 2 will always be their name? line 3, the 82-146 does this change? (if they are fixed could do a 3 step find and replace, find "name" and replace with something temporary, find "82-146" and replace with "name" and then replace the temporary with "82-146" - no LISP required. Suspect that the 82-146 is a reference number and will change? Quote Link to comment Share on other sites More sharing options...
trb426 Posted January 18 Author Share Posted January 18 So the "N/F" in the first line is always the same, but all the other lines will be different every time. I was picturing smething similar to the following (which I actually used to add the "N/F" )with the addtion an input of the source line location and detination line location, such as Source line? 3, Destination line? 2 We generally don't do any formatting within the MTEXT if at all possible, at least not for these abutter labels. (defun c:MTPrefix ( / ss in en st) (if (setq ss (ssget "_:L" '((0 . "MTEXT")))) (repeat (setq in (sslength ss)) (setq en (entget (ssname ss (setq in (1- in)))) st (assoc 1 en)) (entmod (subst (cons 1 (strcat "N/F\\P" (cdr st) )) st en)) ) ) (princ) ) ABUT LABEL FIX.dwg Quote Link to comment Share on other sites More sharing options...
pkenewell Posted January 18 Share Posted January 18 (edited) @trb426 Try this - It's pretty rudimentary, working by parsing the string and swapping lines 2 and 3. Won't handle anything that is not EXACTLY the string pattern you mention: (defun c:SWAPMT (/ d _listswap obj ss _StrParse tls txt) (vl-load-com) (vla-StartUndoMark (setq d (vla-get-activedocument (vlax-get-acad-object)))) (defun _StrParse (str del / pos) (if (and str del) (if (setq pos (vl-string-search del str)) (cons (substr str 1 pos) (_StrParse (substr str (+ pos 1 (strlen del))) del)) (list str) ) ) ) (defun _listswap (nth1 nth2 lst / cnt) (if (and (/= nth1 nth2)(>= nth1 0)(>= nth2 0)(< nth1 (length lst))(< nth2 (length lst))) (mapcar (function (lambda (x) (setq cnt (if cnt (1+ cnt) 0)) (cond ((= cnt nth1) (nth nth2 lst)) ((= cnt nth2) (nth nth1 lst)) (T x) ) ) ) lst ) ) ) (princ "\nSelect MTEXT Objects: ") (if (setq ss (ssget '((0 . "MTEXT")))) (repeat (setq n (sslength ss)) (setq obj (vlax-ename->vla-object (ssname ss (setq n (1- n)))) txt (vla-get-textstring obj) tls (_strparse txt "\\P") ) (if (> (length tls) 2) (setq tls (_listswap 1 2 tls) txt (apply 'strcat (cons (car tls) (mapcar '(lambda (x)(strcat"\\P" x)) (cdr tls)))) obj (vla-put-textstring obj txt) ) ) ) ) (redraw) (vla-endundomark d) (princ) ) Edited January 18 by pkenewell Edit - Simplified the reconstitution of the text string. 1 Quote Link to comment Share on other sites More sharing options...
trb426 Posted January 18 Author Share Posted January 18 That did the trick. Thanks!! Just in case I need it again, is it the 1 & 2 in the following line that control the source and destination lines? (setq tls (_listswap 1 2 tls) 1 Quote Link to comment Share on other sites More sharing options...
pkenewell Posted January 18 Share Posted January 18 8 minutes ago, trb426 said: That did the trick. Thanks!! Just in case I need it again, is it the 1 & 2 in the following line that control the source and destination lines? (setq tls (_listswap 1 2 tls) @trb426 Yes that's correct. The parsed list is based on 0, so 0=line1, 1=line2, 2=line3, etc. Quote Link to comment Share on other sites More sharing options...
pkenewell Posted January 18 Share Posted January 18 (edited) FYI. I updated the function in my original post to add undo marks. I noticed if you undo, it can eat the previous command as well. I also simplified the reconstitution of the text string a little bit. Edited January 18 by pkenewell 1 Quote Link to comment Share on other sites More sharing options...
Steven P Posted January 19 Share Posted January 19 (edited) Going to add a slight different one here, it asks the user for input to select the text and the new order. If you don't enter a line number that line is deleted. Works with up to 256 characters in the text (including the new line reference and any other formatting)/ 256 Characters -should- be plenty for the OPs example I think. EDIT Edited the code to select many mtext strings and do the same change to them all, and some annotations in the code. (defun c:swapmt ( / MySS SSCountMyEnt MyEntGet Mytext TextList OrderList NewText n acount) ;;Sub Functions: ;;Starting with LM: Refer to Lee Macs website (defun LM:str->lst ( str del / pos ) (if (setq pos (vl-string-search del str)) (cons (substr str 1 pos) (LM:str->lst (substr str (+ pos 1 (strlen del))) del)) (list str) ) ) (defun LM:lst->str ( lst del ) (if (cdr lst) (strcat (car lst) del (LM:lst->str (cdr lst) del)) (car lst) ) ) (princ "\nSelect MText") ;; Note in command line "Select text" (setq MySS (ssget '((0 . "MTEXT")))) ;; Select objects with a selection set, filtered to 'MTEXT' entity type (setq OrderList (LM:str->lst (getstring "Enter Order with spaces (x y z)" t) " ")) ;; Create a list from a user inputted string ;;There is a better way to do the above linie I think, loop with get int till user presses enter (setq SSCount 0) ;; Just a counter set to 0 (while (< SSCount (sslength MySS)) ;; loop through length or selection set using SSCount (setq MyEnt (ssname MySS SSCount)) ;; get the nth item in the selection set entity name (setq MyEntGet (entget MyEnt)) ;; get the entity definition from the above (setq MyText (cdr (assoc 1 MyEntGet))) ;; get the text from the entity (first 256 characters) (setq TextList (LM:str->lst MyText "\n")) ;; Convert the text string to a list, deliminator \n (new line) (setq NewText (list)) ;; Create a blank list to append to later (if (or (< (length OrderList) (length TextList)) ;; If the order list from above is longer (= (length OrderList) (length TextList)) ;; or equal to the number of lines in the text string ) ; endor (foreach n OrderList (setq NewText (append NewText (list (nth (- (atoi n) 1) TextList))) ) ;; Create a new list according to the order list order ) ; end foreach (progn ;; Text list is longer than the order list (setq acount 0) ;; A Counter (while (< acount (length TextList)) ;; Loop through for the length of the text list (done this way so always smething to look at) (setq NewText (append NewText (list (nth (- (atoi (nth acount OrderList)) 1 ) TextList))) ) ;; create a new list as above (setq acount (+ acount 1)) ) ; end while ) ; end progn ) ; end if (setq MyEntGet (subst (cons 1 (LM:lst->str NewText "\n")) (assoc 1 MyEntGet) MyEntGet)) ;; Create a new entity definiton replacing text (entmod MyEntGet) ;; Modify the text (setq SSCount (+ SSCount 1)) ) ; end while ); end function Edited January 19 by Steven P 1 Quote Link to comment Share on other sites More sharing options...
Tharwat Posted January 19 Share Posted January 19 Alternatively you can use my dynamic function which works with three lines of strings or more with open limits. (defun c:Test ( / int sel ent get str rtn run new fnd lft ) ;;----------------------------------------------------;; ;; Author : Tharwat Al Choufi ;; ;; website: https://autolispprograms.wordpress.com ;; ;;----------------------------------------------------;; (and (princ "\nSelect Mtexts to reverse second string line with third line : ") (setq int -1 sel (ssget "_:L" '((0 . "MTEXT"))) ) (while (setq int (1+ int) ent (ssname sel int) ) (and (setq get (entget ent) str (cdr (assoc 1 get)) ) (setq run -1 new "" rtn (_peelstring str "\\P")) (> (length rtn) 2) (or (and (setq lft (reverse (cdddr rtn))) (while (and (setq run (1+ run)) (setq fnd (nth run lft)) ) (setq new (strcat fnd "\\P" new)) ) ) new) (entmod (subst (cons 1 (strcat (car rtn) "\\P" (caddr rtn) "\\P" (cadr rtn) "\\P" new)) (assoc 1 get) get)) ) ) ) (princ) ) (vl-load-com) ;; ;; (defun _peelstring (string del / str pos lst) ;; Tharwat - date: 07.Oct.2015 ;; (while (setq pos (vl-string-search del string 0)) (setq str (substr string 1 pos) string (substr string (+ pos (1+ (strlen del)))) ) (and str (/= str "") (setq lst (cons str lst))) ) (and string (/= string "") (setq lst (cons string lst))) (reverse lst) ) Quote Link to comment Share on other sites More sharing options...
BIGAL Posted January 20 Share Posted January 20 (edited) If working with limited mtext like suggested 4 lines and each line is reasonably short this may be useful. Make sure you save multi getvals in a support path.Multi GETVALS.lsp ; thanks to Lee-mac for the csv-lst (defun _csv->lst126 ( str / pos ) (if (setq pos (vl-string-position 126 str)) (cons (substr str 1 pos) (_csv->lst126 (substr str (+ pos 2)))) (list str) ) ) (defun c:mtord ( / obj str lst lst2 len ans ) (setq obj (vlax-ename->vla-object (car (entsel "Pick Mtext ")))) (setq str (vlax-get obj 'textstring)) (while (wcmatch str "*\\P*") (setq str (vl-string-subst "~" "\\P" str)) ) (setq lst (_csv->lst126 str)) (setq len 1) (foreach txt lst (if (> (strlen txt) len)(setq len (strlen txt))) ) (if (> len 25 )(setq len 25)) (setq lst2 '() x 0) (setq lst2 (cons "Please select order" lst2)) (foreach val lst (setq lst2 (cons val lst2)) (setq lst2 (cons len lst2)) (setq lst2 (cons (- len 1) lst2)) (setq lst2 (cons (rtos (setq x (1+ x)) 2 0) lst2)) ) (setq lst2 (reverse lst2)) (if (not AH:getvalsm)(load "Multi Getvals.lsp")) (setq ans (AH:getvalsm lst2)) (setq str "") (foreach num ans (setq str (strcat str (nth (- (atoi num) 1) lst) "\\P")) ) (vlax-put obj 'textstring str) (princ) ) Edited January 20 by BIGAL 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.