Halo text on ttf lisp

[simon.connellRBKGZ]

I would like to make a lsp routine to make halo text for a ttf font. There are numerous posts about how it cant be done but I have worked out a way to make it work.

I have figured out how to do it manually but want to automate the process so others at work can do it also.

If some could whip up a lsp for me that would be amazing otherwise give me some direction as i have no idea how to start.

The list of events that needs to happen is:

select a mtext word in model space

copytolayer

G-HALO_TEXT

then select that copied mtext

TXPEXP

then select that exploded  mtext

REGION

then select that  mtext

UNION

then select that  mtext

EXPLODE

then select those shapes

EXPLODE

then select those lines

JOIN

then select those Polylines

give them a global width of 1 and send them behind the original text layer.

I think with time I might be able to work out a script that could do it to a whole layer but I want to be able to select the mtext to start.

And that should do it.

I am happy to take pointer and learn what I can but it's a fair bit to start with, all help greatly appreciated.

Cheerrs

Simon

[simon.connellRBKGZ]

Thank you, I really appreciate the notes in the code. Helps a lot when trying to figure out the lsp beast!

[roland.r71]

This thing is driving me nuts

I tested my latest code on 2015 and... not working.

Again i had to make some small changes that shouldn't even have an effect.

...and i added a bunch of comments, error handling & undo option.

Now i got it to work again, here, but it might fail again on other versions/configurations. 

Anyway, while testing i did notice the 'procedure' followed also isn't working properly at all.

It works for a simple font, but totally goes wrong with more complex shapes & lines.

It will reject polylines for the region for several reasons, to start.

on the other hand, it does work for any object, which isn't a single line and/or self-intersecting.

(defun c:txthalo ( / txt ent wmf view pt1 pt2 edge ss i cmdecho msg oldver)

; --------------------------------------------------------------------------
   (defun *error* ( msg / )
      (if oldVer ; ACAD 2014 or older
         (command   "_.UNDO" "_End") ; End Undo - old version
         (command-s "_.UNDO" "_End") ; End Undo - new version
      )
      (setvar "CMDECHO" cmdecho) ; Restore initial value
      (if
         (or
            (= msg "Function cancelled")
            (= msg "quit / exit abort")
         )
         (princ)
         (progn (princ (strcat "\nerror: " msg))(princ))
      )
   )
; --------------------------------------------------------------------------

   ; init
   (setq cmdecho (getvar "CMDECHO")
         wmf     (strcat (getvar "tempprefix") "txthalo.wmf")
         txt     (entsel "\nSelect text or mtext: ")
         VIEW    (acet-geom-view-points)
         PT1     (acet-geom-midpoint (car view) (cadr view))
         PT2     (list (car PT1) (cadadr VIEW))
         i       0
         edge    1 ; Global width for polylines
   )
   (setvar "CMDECHO" 0)
   (setq oldVer nil)
   (if (< (atoi (getvar "acadver")) 20) ; ACAD 2014 or older
      (setq oldVer T)
   )
   (command "_.UNDO" "_Begin") ; Start Undo
; --------------------------------------------------------------------------

   ; Main
   (command "_.WMFOUT" wmf txt "")                                         ; export to wmf
   (command "_.-layer" "_M" "G-HALO_TEMP" "")                              ; create or activate temp layer
   (setq ss (acet-wmfin wmf))                                              ; import wmf
   (command "_region" ss "")                                               ; create regions
   (setq ss (ssget "X" (list '(0 . "REGION")(cons 8 "G-HALO_TEMP"))))      ; get selection
   (command "_union" ss "")                                                ; merge regions
   (command "_explode" "_last")                                            ; explode region
   (setq ss (ssget "X" (list '(0 . "REGION")(cons 8 "G-HALO_TEMP"))))      ; get selection
   (initcommandversion 2)                                                  ; use com.ver. 2 for explode
   (command "_explode" ss "")                                              ; explode selection
   (setq ss (ssget "X" (list '(0 . "LINE")(cons 8 "G-HALO_TEMP"))))        ; get selection
   (initcommandversion 2)                                                  ; use com.ver. 2 for join
   (command "_join" ss "")                                                 ; join lines
   (setq ss (ssget "X" (list '(0 . "LWPOLYLINE")(cons 8 "G-HALO_TEMP"))))  ; get selection
   (while (< i (sslength ss))                                              ; for all entities
      (setq ent (entget (ssname ss i)))                                    ; get entity
      (setq ent (subst (cons 43 edge)(assoc 43 ent) ent))                  ; set global width
      (setq ent (subst (cons 8 "G-HALO_TEXT")(assoc 8 ent) ent))           ; change layer
      (entmod ent)                                                         ; modify entity
      (setq i (1+ i))                                                      ; next
   )
   (command "_.draworder" txt "" "f")                                      ; bring text to front
   (princ "\nDone")

; --------------------------------------------------------------------------

   ; end
   (command "_.UNDO" "_End")  ; End Undo
   (setvar "CMDECHO" cmdecho) ; restore CMDECHO
   (princ)
)

[roland.r71]

Basicaly it comes down to:

(setq txt (entsel "\nSelect text or mtext: ") ; select text
(command "_.WMFOUT" wmf txt "")               ; export to wmf
(command "_.-layer" "_M" "G-HALO_TEXT" "")    ; create or activate text layer
(setq ss (acet-wmfin wmf))                    ; import wmf

as with dbroad version.

The rest of it is causing trouble.

& comparing the end results (between the above and the whole (region, explode, join) thing...

Why do all those steps?

With the entire thing you get: (note the missing parts near the cursor)

And the above is what you get with just an export & import of wmf data

[roland.r71]

---

@john.uhden wrote:

Might it be possible to pass arguments to the c:txtexp function by changing it into a command?

(vlax-add-cmd "TXTEXP" 'c:txtexp)

Then I think you can (command "txtexp" whatever)

BTW, lay off my buddy, Doug, lest I provide you an innocent looking lisp routine that sends 120V through your mouse wheel.  smileymad:

---

My acad doesn't swallow that well...

So, i'll have to go for dbroads solution of preselecting.

...at least, if i don't want to rewrite half the txtexp script inside my own, just to avoid it.

[dbroad]

@roland.r71 Thanks for explaining the need to set the text width factor for your method (WMFIN) to generate geometry vs text. I was wondering why it never worked for me but then I always keep all my text width factors set to 1 and always use TTF fonts to create text searchable PDF files.

The whole process seems inexact, probably because there seems to be some display flexibility between TTF fonts and other geometry.  Even on PDF files, I noted that as I zoomed printed results, there would be a shifting of the offsets between the geometry and TTF's.

@simon.connellRBKGZ Glad it worked for you.

@john.uhden  Interesting theory about getting LISP's to work as commands.  I've never gotten that to work so in the past I have resorted to using VBA to feed the commands to lisp functions. Thanks for the defense.  Just a bit of parrying though.

[john.uhden]

vlax-add-cmd seems to work as advertised

(defun C:MYLINE ( / *error* |cmd Doc)
  (gc)
  (vl-load-com)
  (prompt "\nMYLINE (c)2017, John F. Uhden")
  (prompt "\nJust to see how vlax-add-cmd works")
  (setq |cmd (getvar "cmdecho")
        Doc (vla-get-ActiveDocument (vlax-get-acad-object))
  )
  (defun *error* (error)
    (if (= (type |cmd) 'INT)(setvar "cmdecho" |cmd))
    (vla-endundomark Doc)
    (cond
      ((not error))
      ((wcmatch (strcase error) "*QUIT*,*CANCEL*"))
      (1 (princ (strcat "\nERROR: " error)))
    )
    (princ)
  )
  (vla-endundomark Doc)
  (vla-startundomark Doc)
  (setvar "dimzin" 1)
  (setvar "cmdecho" 0)
  (command "_.expert" (getvar "expert")) ;; dummy command
  (and
    (setq p1 (getpoint "\nFirst point: "))
    (setq p2 (getpoint p1 "\nSecond point: "))
    (vl-cmdf "_.line" "_non" p1 "_non" p2 "")
  )
  (*error* nil)
)
(vlax-add-cmd "MYLINE" 'c:myline)


Command: (setq p1 (getpoint) p2 (getpoint p1))
(2422.4 7451.07 0.0)
Command: (command "myline" p1 p2)
myline
MYLINE (c)2017, John F. Uhden
Just to see how vlax-add-cmd works
Command:

It worked.

[dbroad]

Thanks for the demo.

[roland.r71]

---

@Anonymous wrote:

@roland.r71 Thanks for explaining the need to set the text width factor for your method (WMFIN) to generate geometry vs text. I was wondering why it never worked for me but then I always keep all my text width factors set to 1 and always use TTF fonts to create text searchable PDF files.

The whole process seems inexact, probably because there seems to be some display flexibility between TTF fonts and other geometry.  Even on PDF files, I noted that as I zoomed printed results, there would be a shifting of the offsets between the geometry and TTF's.

---

Yeah, i usually do too, but the company i work for at the moment has it set to 0.8 & that's why it worked, there, but nowhere else i tried.

...and i managed to make your lisp (or "aproach") fail too

I got used to that greenish color from the wmf import, but it suddenly turned red... (the color i gave to my TEXT layer)

...and your lisp then failed on the point where it selects the lines by color. (which is now nil)

I'm not 100% sure yet, but it seems that if the layer is active & the object is on that layer, txtexp uses it & sets the color 'bylayer'.

Otherwise it all becomes greenish & on layer 0.

As for the inaccuracy: i think it might even be best to load the wmf data, again, and put that on top, instead of the original text/mtext to prevent a (future) mismatch between the ttf scaling & positioning and the halo geometry. [ edit: of course, the 'outlines' would need a solid hatch ]

As, knowing acad a little, i'm sure it's going to be off at some point.

[edit: This would however mean that the haloed text, is no longer available as text ]

[dbroad]

Thanks for pointing out the flaws.  I never understood why the results of TXTEXP would be sent to layer 0 and color 139.  Seemed really quirky to me.  It's even worse by making it arbitrary based on whether 0 is the current layer.  Of course, the fix would be to mark the last entity and then collect the newer entities wherever they ended up as I did elsewhere in the program. SSGET was just a cheat.  I also assumed that pickfirst would be on.  To make the program bullet proof, I would have to check all the relevant system variables, check and set layers, avoid ssget and so on.  Even the Undo begin and end don't work perfectly, probably because TXTEXP is messing with them as well.

[roland.r71]

Ok. This should work, but still not perfect. Most of the times it's good, but not with each font.

as you can see here:

Some of the lines on the right side did not get the global width assigned. If i do it by hand, it's ok.

Here's the code, which should at least work.

(vl-load-com)
(defun c:txthalo ( / txtEnt ent wmf view pt1 pt2 edge ss i colr cmdecho msg oldver ss2 mark)

   ; Function to create halo around text
   ; Requires: Express Tools

   ; Globals:
   ; *txthalo_gw (current global width)
   ; *txthalo_cl (current color)

; --- *error* ------------------------------------------------------------------

   (defun *error* ( msg / )
      (if oldVer ; ACAD 2014 or older
         (command   "_.UNDO" "_End") ; End Undo - old version
      ; else
         (command-s "_.UNDO" "_End") ; End Undo - new version
      )
      (setvar "CMDECHO" cmdecho) ; Restore initial value
      (if
         (or
            (= msg "Function cancelled")
            (= msg "quit / exit abort")
         )
         (princ)
         (progn (princ (strcat "\nerror: " msg))(princ))
      )
   )

; --- INIT ---------------------------------------------------------------------

   (setq cmdecho (getvar "CMDECHO")
         edge    1.0 ; Default global width
         colr    1 ; Default Color
   )
   (setvar "CMDECHO" 0)
   (setq oldVer nil)
   (if (< (atoi (getvar "acadver")) 20)(setq oldVer T)) ; ACAD 2014 or older
   (command "_.UNDO" "_Begin") ; Start Undo

; --- MAIN ---------------------------------------------------------------------

   ; User interaction: Get text, width for polylines & color
   ; -----------------
   ; Get text entity to process
   (while (= txtEnt nil) ; as it is easy to mis text ... ;)
      (setq txtEnt (entsel "\nSelect text or mtext to be haloed: "))
      (if (= txtEnt nil)(princ "\nNo object found"))
   )

   ; Set global width for polylines
   (setq *txthalo_gw
      (cond
         ((getreal (strcat "\nHalo size? <"
            (rtos (setq *txthalo_gw (cond (*txthalo_gw)(edge)))) ">: "))
         )
         (*txthalo_gw)
      )
   )

   ; Set color
   (princ "\nSelect color")
   (setq *txthalo_cl (acad_colordlg (cond (*txthalo_cl)(colr))))


   ; Process text entity
   ; -------------------
   ; determine bounding box for window selection
   (setq obj (vlax-ename->vla-object (car txtEnt))
         box (vlax-invoke-method obj 'getboundingbox 'pt1 'pt2)
         ll  (vlax-safearray->list pt1)
         ur  (vlax-safearray->list pt2)

         ; To be sure we get it all, enlarge the window by 2 points
         ul  (list (- (car ll) 2)(+ (cadr ur) 2) 0.0) ; Upper left corner
         lr  (list (+ (car ur) 2)(- (cadr ll) 2) 0.0) ; Lower right corner
   ) ; setq

   (command "_.-layer" "_M" "G-HALO_TEXT" "_c" (itoa *txthalo_cl) "" "") ; create or activate layer
   (command "_copytolayer" (car txtEnt) "" "G-HALO_TEXT" "0,0" "") ; copy the text for processing
   (setq mark (entlast))                                        ; mark entities position

   ; create text outlines
   (setq ss (ssadd))    ; create selection set
   (ssadd (entlast) ss) ; with copy
   (sssetfirst nil ss)  ; preselect, assuming pickfirst is on
   (c:txtexp)           ; run express tool command for exploding text
   (princ "\nSkip that ^^^ remark ^^^\n")

   ; Enhance the output
   ;-------------------
   (setq ss (ssget "w" ul lr))             ; get selection
   (command "_convertpoly" "_light" ss "") ; fix polyline results
   (setq ss (ssget "w" ul lr))             ; get selection
   (command "_region" ss "")               ; create regions
   (setq ss (ssget "w" ul lr))             ; get selection
   (command "_union" ss "")                ; merge regions
   (command "_explode" "_last")            ; explode region
   (setq ss (ssget "w" ul lr))             ; get selection
   (initcommandversion 2)                  ; use com.ver. 2 for explode
   (command "_explode" ss "")              ; explode selection
   (setq ss (ssget "w" ul lr))             ; get selection
   (initcommandversion 2)                  ; use com.ver. 2 for join
   (command "_join" ss "")                 ; join lines

   ; collect new entities
   (setq ss2 (ssadd))
   (while (setq mark (entnext mark))
      (ssadd mark ss2)
   )

   ; set the global width for the outlines
   (setq i 0)
   (while (< i (sslength ss2))                                   ; for all entities
      (setq ent (entget (ssname ss2 i)))                         ; get entity
      (setq ent (subst (cons 43 *txthalo_gw)(assoc 43 ent) ent)) ; set global width
      (setq ent (subst (cons 8 "G-HALO_TEXT")(assoc 8 ent) ent)) ; change layer
      (entmod ent)                                               ; modify entity
      (setq i (1+ i))                                            ; next
   )

; --- END ----------------------------------------------------------------------

   (command "_.draworder" txtEnt "" "f") ; bring text to front
   (princ "\nDone")
   (command "_.UNDO" "_End")             ; End Undo
   (setvar "CMDECHO" cmdecho)            ; restore CMDECHO
   (princ)
)

[roland.r71 · Accepted solution]

Try this version. Should work perfectly now. (it did become a full program by now, so its a bit big to post as code)

[simon.connellRBKGZ]

Thanks for your help, that program works well. There are a few little bugs but works well enough for me to use. AutoCAD definitely needs to incorporate this function into their program for the future!

[roland.r71]

Happy to help. It's been a challange

I noticed a bug myself, with the width setting. If you just hit enter it fails.

& sometimes the "bring to front" is not enough, some lines remain on top.

So i've made a small change to the width setting,

added a "send-to-back" & I've also added a notification for the current width & color at startup.

[simon.connellRBKGZ]

Hi again,

I have been asked if I can make this halo text able to select multiple texts at once instead of singularly selecting each text to do each time. I had a look at some script writing on how to do it but I fear this little text halo has evolved way past the point where I can make little changes and use as a learning tool.

Any chance someone can help out, possible make it so when the command is executed multiple texts can be selected?

Thanks

Simon

[roland.r71]

Sure. It was fun to do it last time and it should definately be possible.

[roland.r71]

To keep you informed:

Haven't had much time yet to look at it, but i already know i'll have to change the way the selection works. As i can't combine a "multi-select" with the menu options like i did here.

I'm still looking into the best way to do the selection & retain the options to set the width & color.

One way to do that is to let you pick each text, one by one, until you're ready to process.

Another way is to let you pre-select the text objects, or to select them using a window or crossing selection. For this last one i would need to create a different menu.

[simon.connellRBKGZ]

My preference if i was able to choose a selection method would be the second method. I think that would be easiest especially if having to select a lot of texts - chainages along a centreline for instance.
Good luck!

[roland.r71]

I'm thinking about using a method i used before. Giving the function 2 different ways to operate.

1: Select (multiple) text objects first, call the txthalo function second = process all selected text.

2: Call txthalo without selection = how it works now (select & process text one by one)

As the width & color are both global values, you could call the function set whatever you like & end the function without selecting & processing any text.

Then select a bunch of texts & process them using that width & color.

Of course, i could also build in a similar menu with these options & add a "process selection" option. But then you would always have to tell it what to do.

As i do want to keep the options to set width & color in there and want it to be available for the multiselect as well, i'm thinking about adding a "start process" option next to it (instead of just processing the selection using whatever is set at the time)

[roland.r71]

@simon.connellRBKGZ I finally have some time to spare again for the coming weeks, so I'm definately going to spend some on this as I said I would, AND add the ability to (properly) process SHX fonts as well.

In reply to @jmartt & posted here since this might be interesting for others too:

As there's no constraint with the original [edit:txtHalo.lsp] (it doesn't check if the selected text uses TTF, or not) I checked to see what it does (using standard values like a 2.5 font hight & default linewheight). The result was pretty much what I expected. Only parts of the text actually got 'haloed', due to the fact that there's no character 'outline'.

The method used basically comes down to: Exporting the text as a 'vector graphic' & import the resulting polyline's. Which in case of a TTF (which always has a certain thickness to each character) results in an 'outline' of each character. But in case of a SHX font, there's usually only the thin center line (which you assign a line width, to give the characters body).

So, I might have to come up with a slightly different approach to make it work for SHX fonts.

[roland.r71]

@jmartt, as for the shx fonts halo...

 Will this do?