LSP to swap lines of a multi-line MTEXT?

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.

January 18

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

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?

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

January 18

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

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)

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.

January 18

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

January 19

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

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

January 20

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

Sign In

LSP to swap lines of a multi-line MTEXT?

Recommended Posts

trb426

BIGAL

Steven P

trb426

pkenewell

trb426

pkenewell

pkenewell

Steven P

Tharwat

BIGAL

Join the conversation

Tutorials

Forums

Activity