LSP to swap lines of a multi-line MTEXT?

[trb426]

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.

[BIGAL]

Post sample need to look at the actual Mtext as it may have hidden mtext controls, like Bold. 

[Steven P]

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?

[trb426]

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

[pkenewell]

@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.

[trb426]

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)

[pkenewell]

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.

[pkenewell]

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

[Steven P]

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

[Tharwat]

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

 

[BIGAL]

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