AutoLisp for removing all linebreaks, and leave selection on

January 23

17 hours ago, Steven P said:

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

Tried this, i had to add pkenewell's mxv functions, and removed the non used linebreak filters, then in works perfectly!
Thanks so much !!

56 minutes ago, pkenewell said:

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

I tried this, and it removes all linebreaks, but the "defined width" seems to be super small at the end. Like 50 instead of a 9000 long text.

Thanks for this anyway

Love you all!

January 23

2 hours ago, pkenewell said:
@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)
)

Thanks - I have box text (source LISP for that part) always loaded so that didn't jump out as missing.

Edited the code above.

Edited January 23 by Steven P

January 23

41 minutes ago, Highvoltage said:

Tried this, i had to add pkenewell's mxv functions, and removed the non used linebreak filters, then in works perfectly!
Thanks so much !!

No problem, hoping it speeds things up a lot for you.

January 23

1 hour ago, Highvoltage said:

I tried this, and it removes all linebreaks, but the "defined width" seems to be super small at the end. Like 50 instead of a 9000 long text.

Thanks for this anyway

@Highvoltage I may have misinterpreted what you wanted. I set the defined width to the longest line of text BEFORE the line breaks were removed. I can alter it for you, if you want the defined width of the single line of text AFTER the line breaks are removed? Something else entirely? Please let me know.

Edited January 23 by pkenewell

January 23

1 hour ago, Steven P said:

Thanks - I have box text (source LISP for that part) always loaded so that didn't jump out as missing.

No problem

January 25

For completion and continuing the discussion from above, a very small change (added 8 lines) to include for long text (250+ characters)

(defun c:TxtRemCR ( / MySS SSCountMyEnt MyEntGet Mytext TextList OrderList NewText n p DXFCodes 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)
            )
        )
    )
  )

;;Initial setup
  (setq thisdrawing (vla-get-activedocument (vlax-get-acad-object)))  ;; for undo later
  (setq DXFCodes (list 1 3))                 ;;List of DXF codes that could contain mtext
  
;;Assess text
  (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
    (foreach p MyEntGet                      ;; Loop through mtext entity definition
      (if (= (member (car p) DXFCodes) nil)  ;; If DXF is in list, DXF codes...
        ()                                   ;; not a text code
        (progn                               ;; modify the texts
          (setq MyText (cdr (assoc (car p) MyEntGet)))
          (if (vl-string-search "\P" MyText) (setq del "\\P")) ;; new line character: Direct MText entry
          (if (vl-string-search "\p" MyText) (setq del "\\p")) ;; new line character: Direct MText entry
          (if (vl-string-search "\N" MyText) (setq del "\N"))  ;; new line character: Copied and pasted text
          (if (vl-string-search "\n" MyText) (setq del "\n"))  ;; new line character: Copied and pasted text
          (setq TextList (LM:str->lst MyText del)) ;; Convert the text string to a list,
          (setq MyEntGet (subst (cons (car p) (LM:lst->str TextList " ")) p MyEntGet)) ;; modify the entity
        ) ; end progn
      ) ; end if
    ) ; end foreach

    (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

January 27

On 1/23/2024 at 6:39 PM, pkenewell said:

@Highvoltage I may have misinterpreted what you wanted. I set the defined width to the longest line of text BEFORE the line breaks were removed. I can alter it for you, if you want the defined width of the single line of text AFTER the line breaks are removed? Something else entirely? Please let me know.

No, you understood correctly, i wanted it to set the width BEFORE. My problem was when i ran the script it removed the linebreaks, but didn't set any defined width, it stayed on 0.

January 29

On 1/27/2024 at 6:45 AM, Highvoltage said:

My problem was when i ran the script it removed the linebreaks, but didn't set any defined width, it stayed on 0.

Hmm - That's strange; it is working for me. I just tested it again and it defined a width after removing the line breaks. Could you send me an example drawing?

Did you use the code from THIS post?

Edited January 29 by pkenewell

January 29

2 hours ago, pkenewell said:

Hmm - That's strange; it is working for me. I just tested it again and it defined a width after removing the line breaks. Could you send me an example drawing?

Did you use the code from THIS post?

Yes i use that code.

It is defining a width now that i double checked. only the width is extremely short

it defined a 13 width for this box

https://prnt.sc/JfMKVJHlgs_r

when it should be more than 10k

https://prnt.sc/A5YhHG1GYcvb

January 29

4 minutes ago, Highvoltage said:

Yes i use that code.

It is defining a width now that i double checked. only the width is extremely short

it defined a 13 width for this box

https://prnt.sc/JfMKVJHlgs_r

when it should be more than 10k

https://prnt.sc/A5YhHG1GYcvb

It must be an annotative scaling issue. All my code does is literally measure the length of the string of the longest line of text. It must be at some kind of Annotative scale that is not reported by the (textbox) function. I'll have to look into how to scale it up based on the annotation scale. Again - an simple example drawing would be useful to me, since I don't use annotative scaling in my drawings.

January 29

Thanks so much, but the other code by Steven works perfectly for me, so i don't want to to steal your time.

Thanks for all the help

January 29

3 hours ago, Highvoltage said:

Thanks so much, but the other code by Steven works perfectly for me, so i don't want to to steal your time.

Thanks for all the help

@Highvoltage That's fine, but I need to fix it for my own satisfaction.

FWIW - try this version. It gets the width in a different way.

(defun c:mbch (/ _StrParse a b bb 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)
               bb  (vla-GetBoundingBox obj 'a 'b)   
               wid (- (car (vlax-Safearray->List b)) (car (vlax-Safearray->List a)))
               wid (+ wid (* wid 0.05)); add 5% to width, can be adjusted
               tls (_strparse txt "\\P")
               tls (apply 'append (mapcar '(lambda (x)(_strparse x "\\N")) tls))
               txt (if (> (length tls) 1)
                      (apply 'strcat (cons (car tls)(mapcar '(lambda (x)(strcat " " x)) (cdr tls))))
                      (car tls)
                   )
         )
         (vla-put-textstring obj txt)
         (if (= dw 0.0)(vla-put-width obj wid))
      )
   )
   (redraw)
   (vla-endundomark d)
   (princ)
)

EDIT: I Realized I could shorten it even more because I had some unnecessary conditional statements, and tested MTEXT with various codes, determining that the only other common string code that creates a return in MTEXT is "\N" in uppercase. lowercase "\p" and "\n" codes are not accepted as returns. Nor does "\X" work in MTEXT like it does in a Dimension.

Edited January 29 by pkenewell

January 29

1 hour ago, pkenewell said:

@Highvoltage That's fine, but I need to fix it for my own satisfaction.

FWIW - try this version. It gets the width in a different way.

(defun c:mbch (/ _StrParse a b bb 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)
               bb  (vla-GetBoundingBox obj 'a 'b)
               a   (vlax-Safearray->List a)
               b   (vlax-Safearray->List b)
               wid (- (car b) (car a))
         )
         (if (> (length (setq tls (_strparse txt "\\P"))) 1)
            (setq tls
               (apply 'append
                  (mapcar
                     '(lambda (x / y)
                        (if (> (length (setq y (_strparse x "\\n"))) 1) y (list x))
                      )
                     tls
                  )
               )
               txt (apply 'strcat (cons (car tls)(mapcar '(lambda (x)(strcat " " x)) (cdr tls))))
            )
         )
         (vla-put-textstring obj txt)
         (if (= dw 0.0)(vla-put-width obj wid))
      )
   )
   (redraw)
   (vla-endundomark d)
   (princ)
)

Yeah it works now!

January 29

8 minutes ago, Highvoltage said:

Yeah it works now!

Thanks!

May 10

Hi guys!
Been using your scripts, and it made my life sooo much easier. Thanks again.

I'd like to make a script that selects all text items that only has numbers in it. I want to temporarily hide those elements while working. The problem is that there are all kinds of number occurances, sometimes with a "+" or "-" sign, sometimes decimal points, and sometimes percentages. https://prnt.sc/mgbfwS3x8XU0
So i don't know how hard is to make a (regex?) selection criteria that selects all layers that have only numbers and maybe plus two other any kind of characters only.

May 11

Maybe look at ssget filters play with some of these, look at last one in particular.

(ssget (list (cons 0 "TEXT")(cons 1 "#")))
(ssget (list (cons 0  "TEXT")(cons 1 "-#")))
(ssget (list (cons 0  "TEXT")(cons 1 "-#*")))
(ssget (list(cons 0  "TEXT")(cons 1 "-#.#*")))
(ssget (list(cons 0  "TEXT")(cons 1 "*-#*")))
(ssget (list(cons 0  "TEXT")(cons 1 "*#*")))

May 11

The filter will go modify a line similar to these in the codes above:

 (setq MySS (ssget '((0 . "MTEXT"))))

or

 (setq SS (ssget '((0 . "MTEXT"))))

May 11

Make a dump selection set of text then use wcmatch to process them if they have a number in them skip if not remove from the selection set.

then a final check to see if anything is left in the selection set. if so process it again and turn them all invisible.

HideTextwNumbers.lsp

Edited May 12 by mhupp

May 13

On 5/11/2024 at 8:16 PM, mhupp said:

Make a dump selection set of text then use wcmatch to process them if they have a number in them skip if not remove from the selection set.

then a final check to see if anything is left in the selection set. if so process it again and turn them all invisible.

HideTextwNumbers.lsp 1.12 kB · 1 download

Thanks but this does not work on my documents, if i run it, it hides ALL selected text items.

May 13

My problem is that i cant even start.

I can't even make a code to select all numbers. I tried this, but this selects every single text object:
If i replace "*#* to an exact number, it won't even select those in the document.

Quote

(defun c:selnumb( / mtexts) ;;selec all numbers
(sssetfirst nil (ssget "_X" (list '(0 . "TEXT,MTEXT") '(1 . "*#*") (cons 410 (getvar 'ctab)))))
(princ)
)

But if i use this, it correctly selects all objects woth a line-break:

"*\\P*"

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

Steven P

Steven P

pkenewell

pkenewell

Steven P

Highvoltage

pkenewell

Highvoltage

pkenewell

Highvoltage

pkenewell

Highvoltage

pkenewell

Highvoltage

BIGAL

Steven P

mhupp

Highvoltage

Highvoltage

Join the conversation

pkenewell

Steven P

Tharwat

Tutorials

Forums

Activity