Text Modification Routine Needed

[Mitch Mermel]

A major client wants searchable PDFs for our deliverables. Unfortunately, we're still using SHX fonts, some of which do not have a width of 1.
I desperately need something I can add to my Accaddoc.lsp that will automatically, upon opening a drawing:

1) Select all Model Space text (not in attributes) and set the width to a value of 1
2) Create the text style Arial, created with font Arial.ttf, width 1
3) Change all the selected Model Space text to style Arial
4) Immediately do a save

If anyone can whip up something like this it would be greatly appreciated (and it will be added to the accaddoc with your at the head of the routine).

Thanks

[pbejse]

A major client wants searchable PDFs for our deliverables. Unfortunately, we're still using SHX fonts, some of which do not have a width of 1.
I desperately need something I can add to my Accaddoc.lsp that will automatically, upon opening a drawing:

1) Select all Model Space text (not in attributes) and set the width to a value of 1
2) Create the text style Arial, created with font Arial.ttf, width 1
3) Change all the selected Model Space text to style Arial
4) Immediately do a save

If anyone can whip up something like this it would be greatly appreciated (and it will be added to the accaddoc with your at the head of the routine).

Thanks



(defun c:AllArial (/ AllText i e l)
;;; pBe 17Dec2013 ;;;
(if (not (tblsearch "STYLE" "ARIAL"))
(entmake
'((0 . "STYLE")
(100 . "AcDbSymbolTableRecord")
(100 . "AcDbTextStyleTableRecord")
(2 . "ARIAL")
(70 . 0)
(40 . 0.0)
(41 . 1.0)
(50 . 0.0)
(71 . 0)
(42 . 0.2)
(3 . "ARIAL.TTF")
(4 . "")
)
)
)
(if (setq AllText
(ssget "_X"
'((0 . "*TEXT") (410 . "Model"))))
(repeat (setq i (sslength AllText))
(setq e (entget (ssname AllText (setq i (1- i))))
l (assoc -1 e))
(setq e (entmod (list (cons 7 "ARIAL") l)))
(entmod (list (cons 41 1.0) l))
)
)
(princ)
)


EDIT: forgot about the width