AutoLisp for removing all linebreaks, and leave selection on

January 18

I modified a script i found so it removes linebreaks from all selected Text objects.

My problem is it only removes the first linebreak it finds. I would like it to remove all. AFAIK vl-string-subst quits after the first found instance.
I tried a loop with vl-string-search, but i'm pretty clueless.

Also i would like to have all the modified elements to remain selected.

This is my code:

;; Mtext: remove linebreak
(defun c:mbch ( / mtexts i txt newTxt ent)
  ;; 
  (setq mtexts (ssget (list (cons 0 "MTEXT") )) )  ;; User selects MText objects

  ;; go through all found objects
  (setq i 0)
  (repeat (sslength mtexts)
    (setq txt (cdr (assoc 1 (entget (setq ent (ssname mtexts i))))))

      ;; Substitute
    (setq newTxt (vl-string-subst " " "\\P" txt))
    (entmod (subst (cons 1 newTxt) (assoc 1 (entget ent)) (entget ent) ))
  
    (setq i (+ i 1))
  )
  
  (princ)
)

Thanks

January 18

@Highvoltage You're in luck. I just created a very similar routine for another poster. In addition to the problem with (vl-string-subst), one of other the problems with using DXF is sometimes the mtext string is separated into multiple DXF codes if the text is more than 250 chars. The additional codes use DXF code 3 instead of 1. It's better to get the full text string using ActiveX and parsing it. Try the following instead:

(defun c:mbch (/ _StrParse d obj ss 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)
        )
     )
   )
   
   (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) 1)
            (setq txt (apply 'strcat (cons (car tls)(mapcar '(lambda (x)(strcat " " x)) (cdr tls))))
                  obj (vla-put-textstring obj txt)
            )
         )
      )
   )
   (redraw)
   (vla-endundomark d)
   (princ)
)

January 19

You're in double luck.... I created a a similar routine in the same thread as pkenewell, an alternative method. Likewise, the same text length limit applies - can adjust these if that becomes an issue (for most things, 256 characters is usually enough except a notes block of text)

(defun c:TxtRemCR ( / MySS SSCountMyEnt MyEntGet Mytext TextList OrderList NewText n acount) ; txt remove carriage returns
;;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 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 MyEntGet (subst (cons 1 (LM:lst->str TextList " ")) (assoc 1 MyEntGet) MyEntGet))
    (entmod MyEntGet)                            ;; Modify the text
    (setq SSCount (+ SSCount 1))
  ) ; end while
); end function

January 20

Here is my attempt.

(defun c:Test (/ int sel ent get )
  ;;----------------------------------------------------;;
  ;;	Author : Tharwat Al Choufi			;;
  ;; website: https://autolispprograms.wordpress.com	;;
  ;;----------------------------------------------------;;
  (and (princ "\nSelect Mtexts to remove linebreaks entirely : ")
       (setq int -1 sel (ssget "_:L" '((0 . "MTEXT"))))
       (while (setq int (1+ int) ent (ssname sel int))
         (entmod (subst (cons 1 (vl-string-translate "\\P" " " (cdr (assoc 1 (setq get (entget ent))))))
                        (assoc 1 get)
                        get
                        )
                 )
         )
       )
  (princ)
  ) (vl-load-com)

January 22

On 1/20/2024 at 2:47 PM, Tharwat said:

Here is my attempt.

@Tharwat To be thorough, one problem with your code is that if the text is more than 250 chars, you also need to look at DXF code 3. There could also be multiple DXF code 3's so you need to look at all of them.

You need something more like this I think:

(defun c:Test (/ int sel ent )
  ;;----------------------------------------------------;;
  ;;	Author : Tharwat Al Choufi			;;
  ;; website: https://autolispprograms.wordpress.com	;;
  ;;----------------------------------------------------;;
  
   (and (princ "\nSelect Mtexts to remove linebreaks entirely : ")
       (setq int -1 sel (ssget "_:L" '((0 . "MTEXT"))))
       (while (setq int (1+ int) ent (ssname sel int))
          ; Change by pkenewell
         (entmod   
            (mapcar
               '(lambda (x / y)
                  (if (or (= (setq y (car x)) 3)(= y 1))
                     (cons y (vl-string-translate "\\P" " " (cdr x)))
                     x
                  )
                )
                (entget ent)
            )
         )
       )
   )
   (princ)
  ) (vl-load-com)

LOL that ends up being the shortest code between the both of us!

Edited January 22 by pkenewell

January 22

@Tharwat OOPS - Nope. I realized (vl-string-translate) only replaces each character for character! While is removes the line breaks - it leaves behind the "P" in the MTEXT! You still need a different way to parse the text string. Going back to the original string parse, but also using DXF codes (I also added undo marks):

(defun c:Test (/ _StrParse d int sel ent get )
  ;;----------------------------------------------------;;
  ;;	Author : Tharwat Al Choufi			;;
  ;; website: https://autolispprograms.wordpress.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)
        )
     )
   )
   
   (and (princ "\nSelect Mtexts to remove linebreaks entirely : ")
       (setq int -1 sel (ssget "_:L" '((0 . "MTEXT"))))
       (while (setq int (1+ int) ent (ssname sel int))
         (entmod   
            (mapcar
               '(lambda (x / y z)
                  (if (or (= (setq y (car x)) 3)(= y 1))
                     (progn
                        (setq z (_strparse (cdr x) "\\P"))
                        (cons y 
                           (apply 'strcat (cons (car z)(mapcar '(lambda (a)(strcat " " a)) (cdr z))))
                        )
                     )
                     x
                  )
                )
                (entget ent)
            )
         )
       )
   )
   (vla-endundomark d)
   (princ)
) (vl-load-com)

Edited January 22 by pkenewell

January 22

Thanks you all guys, you are legends.

Tried both pkenewell's and Steven P's and works great.

I had to replace "\n" to "\\P" in Steven's code, cause Autocad uses that as a line break.

After the script runs, I would like to have the selection remain. Or have a selection of the objects that has been changed in other words

January 22

I noticed that - it all depends how the mtext was created, if it was typed in probably needs \\P, if it was copied in from a note pad, word or whatever, probably needs \n - I was just copying blocks of text from notepad in my testing - I'll update my code later today.

What do you want to do with the selection at the end of the LISP - is it so you can work in AutoCAD after or is it to run another LISP (what we leave you with depends on that)

January 22

This is gonna be long so fel free to ignore it

I have to replace translated text on a SHITLOAD of DWGs. I mean in the hundreds. And each plan has 100+ strings.

I use Lee Macs BFind script which is a godsend.

But i first need to extract data for the translators.
Which is pretty hard, cause the writings are all over the place. And there are a lot of useless data for them like numbers.
There are some multi line elements, there are a lot of text that has no "defined width" they just used a line break.

There are writings that should be one box, but in 3 separate... I can't do much with those.

I made a script that inserts a special character at the end of each Mtext "╚", then i combine them all with Txt2mtxt.
Then i insert it into Google sheets, where i can separate the data with the "╚" character.

Then in google sheets, i made a regex equation that searches for 3 consecutive letters, and ignores the rest, and removes duplicates. That works quite well to remove noise from data

The point is i need to remove linebreaks from all the text, and turn them into proper text boxes, cause the search and replace script only recognises strings up to the linebreak, and i can't send unrelated half-lines to the translators.

Problem is, that a lot of the Mtext is not in "defined width" boxes, so when i remove the linebreaks, they form long lines.

I need to manually define a width to them so they break into multiple lines as before.

So after running the remove linebreak script, i would like all the objects to remain selected, so i can apply an arbitary width to all of them at once as a starting point.

The perfect scenario would be if a script somehow could recognise the horizontal width of the text that has no "defined width", and apply that "defined width" to them.

That sounds very complicated so i'm doing that part by hand.

Edited January 22 by Highvoltage

January 22

Why didn't you say so before!!

While we are taking out the line breaks adjusting the mtext width is able to be done at the same time

The methods use above are using "entmod" to adjust the text, also in the entity definition is the code 41 which is the mtext width code something like:

(if (= (cdr (assoc 41) 0)

will find out if they are 0 width, and we can set a nominal width or calculate a width according to the font and number of characters used in each line

I am going out this evening but might have a look at this later

January 22

16 minutes ago, Steven P said:

Why didn't you say so before!!

While we are taking out the line breaks adjusting the mtext width is able to be done at the same time

The methods use above are using "entmod" to adjust the text, also in the entity definition is the code 41 which is the mtext width code something like:

(if (= (cdr (assoc 41) 0)

will find out if they are 0 width, and we can set a nominal width or calculate a width according to the font and number of characters used in each line

I am going out this evening but might have a look at this later

If this can be done, it would save me incredible amount of time in the long run.
But i'm already grateful for the help.

Every little script exponentially speeds up my workflow.

January 22

Meanwhile , i have found this function, that does exactly what i want, it resizes the mtext to the smallest possible width:

https://www.theswamp.org/index.php?topic=38691.msg438005#msg438005

Now i only need to somehow integrate it, but running the 2 scripts after each other is already plenty good.

Edited January 22 by Highvoltage

January 22

@pkenewell Please don't use my codes with yours nor modifying them.

January 22

@Tharwat My apologies. I was not in anyway trying to take credit for your code, nor did I ever remove your comments. I simply pointed out the fact that your code did not work completely, and how it would be altered to make it work.

January 22

36 minutes ago, pkenewell said:

I simply pointed out the fact that your code did not work completely,

That's what the OP should judge on although that I did try it and worked flawlessly.

I did not write the codes as commercial program to cover all scenarios so that's why the GC of 3 in Mtext was not taken into consideration in this case.

January 22

8 minutes ago, Tharwat said:

I did try it and worked flawlessly

@Tharwat Are you sure? I tested your exact original code, and it left behind a "P" where every line break was. Am I missing something? Just did it again to be sure. That's why I did the 2nd post afterwards.

Edited January 22 by pkenewell

January 22

Try this to adjust the text box width:

The parts I added aren't indented for clarity of the changes, and I borrowed some code from Lee Macs Box Text LISP.

The width used is a little bit wider than the widest line in the existing text - just as a starting point. Also corrected as above for //P and /n new line references. Not corrected today anything for long text strings as discussed above (that bit wasn't working right for 500+ characters).

(defun c:TxtRemCR ( / MySS SSCountMyEnt MyEntGet Mytext TextList OrderList NewText n acount) ; txt remove carriage returns
;;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)
    )
  )
  ;; From Box Text LISP
  ;; Text Box  -  gile / Lee Mac
  ;; Returns an OCS point list describing a rectangular frame surrounding
  ;; the supplied text or mtext entity with optional offset
  ;; enx - [lst] Text or MText DXF data list
  ;; off - [rea] offset (may be zero)
  (defun text-box-off ( enx off / bpt hgt jus lst ocs org rot wid )
    ;;; VXV Returns the dot product of 2 vectors
    (defun vxv (v1 v2) (apply '+ (mapcar '* v1 v2)) )
    ;; MXV Apply a transformation matrix to a vector -Vladimir Nesterovsky-
    (defun mxv (m v) (mapcar '(lambda (r) (vxv r v)) m) )
    (cond
        (   (= "TEXT" (cdr (assoc 00 enx)))
            (setq bpt (cdr (assoc 10 enx))
                  rot (cdr (assoc 50 enx))
                  lst (textbox enx)
                  lst
                (list
                    (list (- (caar  lst) off) (- (cadar  lst) off)) (list (+ (caadr lst) off) (- (cadar  lst) off))
                    (list (+ (caadr lst) off) (+ (cadadr lst) off)) (list (- (caar  lst) off) (+ (cadadr lst) off))
                )
            )
        )
        (   (= "MTEXT" (cdr (assoc 00 enx)))
            (setq ocs  (cdr (assoc 210 enx))
                  bpt  (trans (cdr (assoc 10 enx)) 0 ocs)
                  rot  (angle '(0.0 0.0) (trans (cdr (assoc 11 enx)) 0 ocs))
                  wid  (cdr (assoc 42 enx))
                  hgt  (cdr (assoc 43 enx))
                  jus  (cdr (assoc 71 enx))
                  org  (list (cond ((member jus '(2 5 8)) (/ wid -2.0)) ((member jus '(3 6 9)) (- wid))      (0.0))
                             (cond ((member jus '(1 2 3)) (- hgt))      ((member jus '(4 5 6)) (/ hgt -2.0)) (0.0))
                       )
                  lst
                (list
                    (list (- (car org) off)     (- (cadr org) off))     (list (+ (car org) wid off) (- (cadr org) off))
                    (list (+ (car org) wid off) (+ (cadr org) hgt off)) (list (- (car org) off)     (+ (cadr org) hgt off))
                )
            )
        )
    )
    (if lst
        (   (lambda ( m ) (mapcar '(lambda ( p ) (mapcar '+ (mxv m p) bpt)) lst))
            (list
                (list (cos rot) (sin (- rot)) 0.0)
                (list (sin rot) (cos rot)     0.0)
               '(0.0 0.0 1.0)
            )
        )
    )
  )


  (setq thisdrawing (vla-get-activedocument (vlax-get-acad-object)))
  
  (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 SSCount 0)                           ;; Just a counter set to 0
  (while (< SSCount (sslength MySS))         ;; loop through length or selection set using SSCount

(vla-startundomark thisdrawing)              ;;Undo mark start for each text

    (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 MTextCoords (text-box-off MyEntGet 1)) ;;Use sub function above to get text coordinates

    (setq MyText (cdr (assoc 1 MyEntGet)))   ;; get the text from the entity (first 256 characters)
    (if (vl-string-search "\P" MyText) (setq del "\\P")) ; adjust depends on new line character used
    (if (vl-string-search "\p" MyText) (setq del "\\p")) ; adjust depends on new line character used
    (if (vl-string-search "\N" MyText) (setq del "\N"))  ; adjust depends on new line character used
    (if (vl-string-search "\n" MyText) (setq del "\n"))  ; adjust depends on new line character used
    (setq TextList (LM:str->lst MyText del)) ;; Convert the text string to a list,
    (setq MyEntGet (subst (cons 1 (LM:lst->str TextList " ")) (assoc 1 MyEntGet) MyEntGet))

(setq MTextWidth (Distance (car MTextCoords) (cadr MTextCoords)))         ;; Existing text width
(setq MyEntGet (subst (cons 41 MTextWidth) (assoc 41 MyEntGet) MyEntGet)) ;; Adjust modified text width

    (entmod MyEntGet)                        ;; Modify the text

(vla-endundomark thisdrawing)                ;;End undo mark for this text string

    (setq SSCount (+ SSCount 1))
  ) ; end while


  (princ)
); end function

Edited January 23 by Steven P
Updated code, missed 2 sub functions

January 22

1 hour ago, pkenewell said:

@Tharwat Are you sure? I tested your exact original code, and it left behind a "P" where every line break was. Am I missing something? Just did it again to be sure. That's why I did the 2nd post afterwards.

Likewise, I guess it will be corrected shortly.

January 23

@Steven P FYI - your missing sub-functions in (text-box-off) called "mxv" and "vxv". They are vector functions. I have these in my library.

;;; VXV Returns the dot product of 2 vectors
(defun vxv (v1 v2)
   (apply '+ (mapcar '* v1 v2))
)

;; MXV Apply a transformation matrix to a vector -Vladimir Nesterovsky-
(defun mxv (m v)
   (mapcar '(lambda (r) (vxv r v)) m)
)

Edited January 23 by pkenewell

January 23

@Highvoltage Here is my humble submission for adding defining the width - based on the longest line of the mtext. It may not be a perfect solution. I don't think standard mtext entered by a user would have "\n", but if this is the case I can do more parsing if needed. I also only define the width if it does not already have a width defined. I can change this as well if you would always want the width changed.

(defun c:mbch (/ _StrParse d dw obj ss tls txt wid)
   (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)
        )
     )
   )
   
   (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)
               dw (vla-get-width obj)
         )
         (if (> (length (setq tls (_strparse txt "\\P"))) 1)
            (setq txt (apply 'strcat (cons (car tls)(mapcar '(lambda (x)(strcat " " x)) (cdr tls)))))
         )
         ;; get the width of the longest text string
         (setq wid (apply 'max (mapcar '(lambda (x / y)(setq y (textbox (list (cons 1 x))))(- (car (cadr y)) (car (car y)))) tls)))
         (vla-put-textstring obj txt)
         (if (= dw 0.0)(vla-put-width obj wid))
      )
   )
   (redraw)
   (vla-endundomark d)
   (princ)
)

Edited January 23 by pkenewell

Sign In

AutoLisp for removing all linebreaks, and leave selection on

Recommended Posts

Highvoltage

Top Posters In This Topic

Popular Days

Top Posters In This Topic

Popular Days

Popular Posts

pkenewell

Steven P

Tharwat

Posted Images

pkenewell

Steven P

Tharwat

pkenewell

pkenewell

Highvoltage

Steven P

Highvoltage

Steven P

Highvoltage

Highvoltage

Tharwat

pkenewell

Tharwat

pkenewell

Steven P

Steven P

pkenewell

pkenewell

Join the conversation

pkenewell

Steven P

Tharwat

Tutorials

Forums

Activity