Topic: Text Underline Tool

[CAB]

Here is another idea on my To Do List
Routine to add or remove text underline.

Plain text: pick the text and if no underline add it, else remove it.

Mtext, a bit more complicated. Ideas welcome.
1. Same as above, add & remove underline
2. Detect the line of text picked & the underline/remove UL for that line only (rather complicated)


Comments & code welcome

[Lee Mac]

Quick and crude:

Code: [Select]

(defun c:tu ( / e s )
  (while (setq e (ssget "_+.:E:S:L" '((0 . "TEXT"))))
    (entmod
      (list
        (cons -1 (setq e (ssname e 0)))
        (cons  1
          (if (vl-string-search "%%U" (strcase (setq s (cdr (assoc 1 (entget e))))))
            (LM:StringSubst "" "%%U" (LM:StringSubst "" "%%u" s))
            (strcat "%%U" s)
          )
        )
      )
    )
  )
  (princ)
)

(defun LM:StringSubst ( new old string / l i ) (setq l (strlen new) i 0)
  (while (setq i (vl-string-search old string i))
    (setq string (vl-string-subst new old string i) i (+ i l))
  )
  string
)
I'll leave the MText one for someone clevererer 

Fun stuff Alan 

[CAB]

Thanks for playing.

I think I remember Tim Willey had a routine that would select within Mtext.
Can't remember what he was doing but it may come back to me.

[T.Willey]

It selects within regular text, not mtext, because of how much mtext could be customized within the string.  I think it could be done, but it would take a lot of code, and a good/great understanding of all the escaped characters within mtext, and how they work.  Not sure if it would be worth it.

[ http://www.theswamp.org/index.php?topic=35610.0 ] Edit section of text.  I think this is what you are thinking of Alan.

[CAB]

Yes, that was it Tim. Thanks for the link.
I don't underline in mtext because of the 2000 bug so not high on my list.
Now that I'm using 2006 I may start using it again.

[A_LOTA_NOTA]

Here is the one I use.

Code: [Select]

(defun C:Ul ( / TXT_String LOC ELIST EntType Old_TXT Chk_TXT EntType SUB Sub_Ent)
  (while (= TXT_String nil); checks to make sure something was selected
    (setq TXT_String (entsel "\nPick the text you would like to underline :"); if nothing was selected try again
  Loc (cadr TXT_String); stores the point picked
  TXT_String (car TXT_String)); stores the entity name
    (if(= TXT_String nil)
      (princ "Nothing Picked"); tell user nothing has been selected
      ); end if
    ); end while
  (setq ELIST (entget TXT_String))
  (setq EntType (cdr (assoc 0 elist))); stores the entity type

  (cond

    ((= EntType "TEXT")
     (setq Old_TXT (cdr (assoc 1 elist)); gets the text from the string
   Chk_TXT  (substr Old_TXT 1 3); gets the 1st 3 characters of the string for testing
     ); end setq
     (if
       (or (= Chk_TXT "%%u") (= Chk_TXT "%%U"))
(progn
  (setq New_Txt (substr Old_TXT 4); removes the underline if it exists
ELIST (subst (cons 1 New_TXT) (assoc 1 ELIST) ELIST); replaces the existing string
  ); end setq
); end progn
(progn
  (setq New_TXT (strcat "%%u"Old_TXT); adds the underline
ELIST (subst (cons 1 New_TXT) (assoc 1 ELIST) ELIST);replaces the existing string
  ); end setq
); end Progn
     ); end if
    )

    ((= EntType "MTEXT")
     (setq Old_TXT (cdr (assoc 1 elist))
   Chk_TXT  (substr Old_TXT 1 3); gets the 1st 3 characters of the string for testing
     ); end setq
     (if
       (= Chk_TXT "{\\L")
(progn
  (setq Strg_Lngh (- (strlen Old_TXT) 4); checks the string length - the underline
New_TXT   (substr Old_TXT 4 Strg_Lngh); removes the underline if it exists
ELIST   (subst (cons 1 New_TXT) (assoc 1 ELIST) ELIST); replaces the existing string
  ); end setq
); end progn
(progn
  (setq New_TXT (strcat "{\\L"Old_TXT"}");adds the underline
ELIST (subst (cons 1 New_TXT) (assoc 1 ELIST) ELIST);replaces the existing string
  ); end setq
); end Progn
     ); end if
    )

    ((= EntType "DIMENSION")
     (setq Old_TXT (cdr (assoc 1 elist)); gets the text from the string
   Chk_TXT (substr Old_TXT 1 3); gets the 1st 3 characters of the string for testing
     );end setq
     (if
       (= Old_TXT "")
(setq Old_TXT "<>")
     ); end if     
     (if
       (= Chk_TXT "{\\L")
(progn
  (setq Lngh (strlen old_txt)
New_Lngh (- Lngh 4)
New_TXT (substr Old_TXT 4 New_Lngh); removes the underline if it exists
ELIST (subst (cons 1 New_TXT) (assoc 1 ELIST) ELIST); replaces the existing string
  ); end setq
); end progn
(progn
  (setq New_TXT (strcat "{\\L"Old_TXT"}") ; adds the underline
ELIST (subst (cons 1 New_TXT) (assoc 1 ELIST) ELIST); replaces the existing string
  ); end setq
); end Progn
     ); end if
    )

    ((= EntType "INSERT")
     (setq SUB    (nentselp LOC); Use pick point to select subentity
   Sub_Ent (car SUB); Store entity name
   Old_TXT (cdr (assoc 1 (entget Sub_Ent))); Retrieve value
   Chk_TXT  (substr Old_TXT 1 3); gets the 1st 3 characters of the string for testing
     ); end setq
     (if
       (or (= Chk_TXT "%%u") (= Chk_TXT "%%U"))
(progn
  (setq ELIST (entget Sub_Ent)
New_Txt (substr Old_TXT 4)
ELIST (subst (cons 1 New_TXT) (assoc 1 ELIST) ELIST)
  ); end setq
); end progn
(progn
  (setq ELIST (entget Sub_Ent)
New_TXT (strcat "%%u"Old_TXT)
ELIST (subst (cons 1 New_TXT) (assoc 1 ELIST) ELIST)
  ); end setq
); end Progn
     ); end if
    )
    ((princ "\nSelected object is not text"))
  ); end COND

  (entmod ELIST)
  (entupd TXT_String)
  (princ)
);end defun

[CAB]

That one works very well in my test. 
Thanks

[andrew_nao]

maybe not as nice as others but for what its worth here is my offering

Code: [Select]

(DEFUN C:UL ()
(PROMPT "\nSELECT TEXT TO BE UNDERLINED")
(SETQ NAM (CAR (ENTSEL)))
(SETQ ENT (ENTGET NAM))
(SETQ LY (CDR (ASSOC 1 ENT)))
(SETQ ET (CDR (ASSOC 0 ENT)))
;
; IF TEXT
;
(IF (or (WCMATCH LY "*%%U*") (WCMATCH LY "*%%u*"))
 (PROGN
(SETQ CNTA1 1)
(SETQ NT LY)
(SETQ SC1 nil)
(WHILE (/= SC1 "")
(SETQ SC1 (SUBSTR NT CNTA1 3))
(IF (or (= SC1 "%%U") (= SC1 "%%u")) (SETQ NT (STRCAT (SUBSTR NT 1 (- CNTA1 1)) (SUBSTR NT (+ CNTA1 3)))))
(IF (or (= SC1 "%%U") (= SC1 "%%u")) (SETQ CNTA1 (- CNTA1 1)))
(SETQ CNTA1 (+ CNTA1 1))
);CLOSE WHILE
)
(IF (= ET "TEXT")(SETQ NT (STRCAT "%%U" LY)))
)

;
; IF MTEXT
;
(IF (WCMATCH LY "\\L*") (PROGN
(SETQ CNTA1 1)
(SETQ NT LY)
(SETQ SC1 nil)
(WHILE (/= SC1 "")
(SETQ SC1 (SUBSTR NT CNTA1 2))
(IF (= SC1 "\\L") (SETQ NT (STRCAT (SUBSTR NT 1 (- CNTA1 1)) (SUBSTR NT (+ CNTA1 2)))))
(IF (= SC1 "\\L") (SETQ CNTA1 (- CNTA1 1)))
(SETQ CNTA1 (+ CNTA1 1))
);CLOSE WHILE
)
(IF (= ET "MTEXT")(SETQ NT (STRCAT "\\L" LY)))
)

;
;
;
(SETQ ENT (SUBST (CONS 1 NT) (ASSOC 1 ENT) ENT))
(ENTMOD ENT)
(REDRAW)
(PRINC)
(setvar "cmdecho" 0)
(COMMAND "EXPLODE" "")
(PRINC)
)


[deegeecees]

Here's a nasty one I did some years back.

Code: [Select]

(defun c:underliner ()
(setq en1 (nentsel "\nPlease choose an object:" ))
(setq en1-2 (car en1))
(setq en3 (entget (car En1)))
(setq en4 (cdr (assoc 1 en3)))
(setq txt1 (strcat "%%u" en4))

   (setq en3
                   (subst(cons 1 txt1)
                         (assoc 1 en3)
                         en3))
       (entmod en3)
        (entupd en1-2)
(command "regen")
(princ)

)

[GDF]

Quick and crude:

But still sexy..........

 

[CAB]

Good job guys.

Here is what I am using. Only does text & mtext.

Code: [Select]

;;  CAB version
(defun C:Ul ( / ent elst str etype pos)
  (setvar "ERRNO" 0)
  (while
    (cond
      ((and (null (setq ent (car (entsel "\nPick the text you would like to underline :"))))
            (= (getvar "ERRNO") 52))
       (prompt "\nUser Quit.")
      )
      ((null ent) (princ "\nNothing selected, Try again."))
      ((/= (type (setq str (cdr (assoc 1 (setq elst (entget ent)))))) 'STR)
       (princ "\nNo text found, Try again.")
      )
      ((not (vl-position (setq etype (cdr (assoc 0 elst))) '("TEXT" "MTEXT")))
       (princ "\nWrong object type, Try again."))
      ((= "TEXT" etype)
       (if (vl-string-search "%%U" (strcase str)) ; already underlined
         ;;  remove uderlines
         (while (setq pos (vl-string-search "%%U" (strcase str)))
           (setq str (strcat (substr str 1 pos)(substr str (+ 4 pos)))))
         ;; Else add the %%U
         (setq str (strcat "%%U" str))
       )
       (entmod (subst (cons 1 str) (assoc 1 elst) elst))
      )


      ;;  Mtext underline, turn on = "\\L"  turn off = "\\l"
      ((= "MTEXT" etype)
       (if (vl-string-search "\\L" (strcase str)) ; already underlined
         ;;  remove uderlines
         (while (setq pos (vl-string-search "\\L" (strcase str)))
           (setq str (strcat (substr str 1 pos)(substr str (+ 3 pos)))))
         ;; Else add the \\L to entire string
         (setq str (strcat "\\L" str))
       )
       (entmod (subst (cons 1 str) (assoc 1 elst) elst))
      )

   )
  ) ; while

  (princ)
);end defun

[alanjt]

Here's a nasty one I did some years back.

Code: [Select]

(defun c:underliner ()
(setq en1 (nentsel "\nPlease choose an object:" ))
(setq en1-2 (car en1))
(setq en3 (entget (car En1)))
(setq en4 (cdr (assoc 1 en3)))
(setq txt1 (strcat "%%u" en4))

   (setq en3
                   (subst(cons 1 txt1)
                         (assoc 1 en3)
                         en3))
       (entmod en3)
        (entupd en1-2)
(command "regen")
(princ)

)

LoL, yours actually acts as a toggle for DText. It will have multiple %%u codes prefixing the text, but if there's an even number, it cancels all out. Just thought that was interesting.

[deegeecees]

I had no idea.

I'm such a hack.

 

[alanjt]

I had no idea.

it's such a hack.

 

That's what makes it so funny.

[deegeecees]

Funny how... like a clown? Am I here to amuse you?

 

Actually, this was probably 'borrowed' from somewhere:

Code: [Select]

   (setq en3
                   (subst(cons 1 txt1)
                         (assoc 1 en3)
                         en3))
       (entmod en3)
        (entupd en1-2)
...but the rest was pretty much on the fly.