SHX to TTF

Code Red > AutoLISP (Vanilla / Visual)

SHX to TTF

(1/2) > >>

cmwade77:
We now have several projects that require us to hyperlink all of our detail callouts in our PDFs, manually doing this takes forever. I have found that with Bluebeam I can make the links automatically if the text uses TTF fonts, unfortunately we have been using SHX fonts forever, including RomanS. As many undoubtedly know, the RomanS TTF doesn't plot very nicely; however, I was able to make a version of it that does work.

Now we have tons of drawings that need to be converted over, some projects have 100+ sheets in them, so I have turned to LISP to automate changing it over.

For my fist stab, I setup a routine that changes based on the stylename:

--- Code: ---(defun C:FontReMap ()
(changefont "Callout" "Helvetica Bold.ttf")
(changefont "RAH_PE" "Helvetica Bold.ttf")
(changefont "SHTITLE" "Helvetica Bold.ttf")
(changefont "Arch-Dim" "RomanS_New.ttf")
(changefont "IT-B" "RomanS_New.ttf")
(changefont "PAPER_SPACE_TABLE_TEXT_TYPE_PS_TABLE_ROMANS" "RomanS_New.ttf")
(changefont "ROMAND" "RomanS_New.ttf")
(changefont "ROMANS" "RomanS_New.ttf")
(changefont "ROMANSTTF" "RomanS_New.ttf")
(changefont "Standard" "RomanS_New.ttf")
(changefont "Style1" "RomanS_New.ttf")
(changefont "TEXTS" "RomanS_New.ttf")
(changefont "-30" "RomanS_New.ttf")
(changefont "C-Font" "RomanS_New.ttf")
(changefont "CALLOUTS" "RomanS_New.ttf")
(changefont "S-TEXT" "RomanS_New.ttf")
(changefont "Table_ROMANS" "RomanS_New.ttf")
(changefont "$0$ROMANS" "RomanS_New.ttf")
(changefont "S1" "RomanS_New.ttf")
(changefont "conduit" "RomanS_New.ttf")
(changefont "Titles" "Helvetica Bold.ttf")
(changefont "TEXT" "RomanS_New.ttf")
(changefont "SIMPLEX" "RomanS_New.ttf")
(changefont "SANSSERIF" "RomanS_New.ttf")
(changefont "ROMANSSOV" "RomanS_New.ttf")
(changefont "note" "RomanS_New.ttf")
(changefont "conduit-it3" "RomanS_New.ttf")
(changefont "cleader" "RomanS_New.ttf")
(changefont "BEI_TITLES" "Helvetica Bold.ttf")
(changefont "Annotative" "RomanS_New.ttf")
(changefont "AA-ROMANS" "RomanS_New.ttf")
(changefont "ATT_ROMANS" "RomanS_New.ttf")
(command "._regenall")
)

(defun changefont (StyleName NewFont / Doc sty sname FntPth FntNoExt TypeFace cBold cItalic CharSet P&Fam FontExt ChangeFont)
(vl-load-com)
(setq doc (vla-get-activedocument
(vlax-get-acad-object)
)
)
(vla-startundomark doc)
(if (wcmatch (strcase (getvar "platform")) "*WINDOWS*")
(if (findfile (strcat (getenv "WINDIR") "\\fonts\\" NewFont))
(setq FntPth (strcat (getenv "WINDIR") "\\fonts\\" NewFont))
(setq FntPth (findfile NewFont))
)
(setq FntPth (findfile NewFont))
)
(setq FntNoExt (vl-filename-base FntPth))
(if (= Bold T)
(setq Bold :vlax-true)
(setq Bold :vlax-false)
)
(if (= Italic T)
(setq Italic :vlax-true)
(setq Italic :vlax-false)
)
(setq sty (vla-get-textstyles doc))
(vlax-for s sty
(setq sname (vla-get-name s))
(if (= (strcase sname) (strcase StyleName))
(progn
(setq cFontFile (vla-get-fontfile s)
FontExt (vl-filename-extension cFontFile)
ChangeFont T
)
(if (/= FontExt nil)
(if (= (strcase FontExt) (strcase ".ttf"))
(setq ChangeFont nil)
)
)
(if (/= ChangeFont nil)
(progn
(vla-put-fontfile s FntPth)
)
)
)
)
)
(vla-endundomark doc)
(princ)
)
--- End code ---
This approach does work; however, there are some issues that need to be addressed:

* Depending on the number styles and amount of text in the drawing, it can take quite some time
* This means you have to specify every individual style seperately
Item 2 is the most problematic, as I am sure we could all put our heads together and solve problem 1, so I figured I would take a crack at making it where I would substitute based on the font name used instead of based on style name:

--- Code: ---(defun subfont (OldFont NewFont / FntPth cFont CFontBase)
(if (wcmatch (strcase (getvar "platform")) "*WINDOWS*")
(if (findfile (strcat (getenv "WINDIR") "\\fonts\\" NewFont))
(setq FntPth (strcat (getenv "WINDIR") "\\fonts\\" NewFont))
(setq FntPth (findfile NewFont))
)
(setq FntPth (findfile NewFont))
)
(vlax-for st (vla-get-textstyles (vla-get-activedocument (vlax-get-acad-object)))
(setq cFont (vla-get-fontfile st))
(if (= (strcase cFont) (strcase OldFont))
(progn
(vla-put-fontfile st FntPth)
)
)
)
)

(defun C:FontSub ()
(subfont "helvbld" "Helvetica Bold.ttf")
(subfont "hlvm1d" "Helvetica Bold.ttf")
(subfont "helvm2" "Helvetica Bold.ttf")
(subfont "romans" "RomanS_New.ttf")
(subfont "romand" "RomanS_New.ttf")
(subfont "romans_struc" "RomanS_New.ttf")
(subfont "simplex" "RomanS_New.ttf")
(subfont "x-hlvm1d" "Helvetica Bold.ttf")
(subfont "osafrac" "RomanS_New.ttf")
(subfont "txt" "RomanS_New.ttf")
(command "._regenall")
(princ)
)
--- End code ---

For some reason this method doesn't seem to work, so I am turning to all of you here to see if anyone has any good suggestions? Also, just to be safe, I did check Lee-Mac's site to make sure he didn't already have something, as 9 times out of 10 he at least already has something I can use as a starting point.

tombu:
I've used many versions of T.Willey's Merge text styles (or change text styles) for many years: http://www.theswamp.org/index.php?topic=17659.0
Mostly to clean up drawings from consultants. I haven't used an shx font 15 years at least.

cmwade77:

--- Quote from: tombu on September 13, 2019, 07:34:42 PM ---I've used many versions of T.Willey's Merge text styles (or change text styles) for many years: http://www.theswamp.org/index.php?topic=17659.0
Mostly to clean up drawings from consultants. I haven't used an shx font 15 years at least.

--- End quote ---
While that could certainly work, that is way more complex than I want, I want to be able to specify the old font and what new font it will map to, then run with a single command. I want to set this up once and have it work on all of our drawings.

MP:
I can’t post the work I’ve done with text styles and fonts but I can share that it’s very do-able via objectdbx (fast) and we’ve found the Consolas true type font is a good alternate for RomanS. Cheers.

cmwade77:
Ok, I have managed to make this change that works:

--- Code: ---(defun subfont (OldFont NewFont / Doc sty sname FntPth FntNoExt TypeFace cBold cItalic CharSet P&Fam FontExt ChangeFont)
(vl-load-com)
(setq doc (vla-get-activedocument
(vlax-get-acad-object)
)
)
(vla-startundomark doc)
(if (wcmatch (strcase (getvar "platform")) "*WINDOWS*")
(if (findfile (strcat (getenv "WINDIR") "\\fonts\\" NewFont))
(setq FntPth (strcat (getenv "WINDIR") "\\fonts\\" NewFont))
(setq FntPth (findfile NewFont))
)
(setq FntPth (findfile NewFont))
)
(setq FntNoExt (vl-filename-base FntPth))
(if (= Bold T)
(setq Bold :vlax-true)
(setq Bold :vlax-false)
)
(if (= Italic T)
(setq Italic :vlax-true)
(setq Italic :vlax-false)
)
(setq sty (vla-get-textstyles doc))
(vlax-for s sty
(setq cFontFile (vla-get-fontfile s)
FontExt (vl-filename-extension cFontFile)
ChangeFont T
)
(if (= (strcase cFontFile) (strcase OldFont))
(progn
(vla-put-fontfile s FntPth)
)
)

)
(vla-endundomark doc)
(princ)
)

(defun C:FontSub ()
(subfont "helvbld.shx" "Helvetica Bold.ttf")
(subfont "hlvm1d.shx" "Helvetica Bold.ttf")
(subfont "helvm2.shx" "Helvetica Bold.ttf")
(subfont "romans.shx" "RomanS_New.ttf")
(subfont "romand.shx" "RomanS_New.ttf")
(subfont "romans_struc.shx" "RomanS_New.ttf")
(subfont "simplex.shx" "RomanS_New.ttf")
(subfont "x-hlvm1d.shx" "Helvetica Bold.ttf")
(subfont "osafrac.shx" "RomanS_New.ttf")
(subfont "txt.shx" "RomanS_New.ttf")
(command "._regenall")
(princ)
)
--- End code ---

Navigation

[0] Message Index

[#] Next page

Go to full version