Lee Mac, Matt,
I have the foggist idea as to how to get your programs to work.
Below is a program I got from Andrea at the swamp but it doesn't change true text to .shx text such as the Ariel to Romans. Any help will be appreciated.
; Replaces ALL text with Romans.shx TSR
;;theswamp.org Andrea 2:47 PM 9/16/2010
;;;TextStyleReplace
(defun c:TSR (/ Att ActDoc att Obj Blk n tot f)
(vl-load-com)
(setq ActDoc (vla-get-ActiveDocument (vlax-get-Acad-Object)) tot 0 n 0)
;_Unlock les couches
(vlax-for lay (vla-get-layers ActDoc)
(vla-put-Lock lay :vlax-false)
(vl-catch-all-apply 'vla-put-Freeze (list lay :vlax-false))
)
;; (vla-put-ActiveLayer ActDoc (vla-item (vla-get-layers ActDoc) "0"))
;;capture tous les block
(vlax-for Blk (vla-get-Blocks ActDoc)
(setq tot (+ tot (vla-get-count blk)))
)
;;CREATION DU STYLE ROMANS
(mapcar (function (lambda ( _font / text_style)
(setq text_style (vla-add (vla-get-textstyles ActDoc) _font))
(vla-put-fontfile text_style "ROMANS.SHX")
(vla-put-height text_style 0.0)
(vla-put-width text_style 1.0)
(vla-put-activetextstyle ActDoc text_style)))
'("ROMANS"))
(acet-ui-progress-init "Traitement" tot)
;;traitement des blocks
(vlax-for Blk (vla-get-Blocks ActDoc)
(vlax-for Obj Blk
(setq n (1+ n))
(acet-ui-progress-safe n)
(setq f (vla-get-layer Obj))
(vla-put-layer Obj "0")
(cond
((vlax-property-available-p Obj 'TextStyle) ;_DIMENSION
(vl-catch-all-apply 'vla-put-TextStyle (list Obj "ROMANS"))
)
((vlax-property-available-p Obj 'StyleName) ;_TEXT,MTEXT, ATTRIBUTE
(vl-catch-all-apply 'vla-put-stylename (list Obj "ROMANS"))
)
((and
(eq (vla-get-objectname Obj) "AcDbBlockReference")
(not (vlax-property-available-p Obj 'Path)) ;_Not Xref ???
(eq (vla-get-hasattributes Obj) :vlax-true)
)
(progn
(vla-put-layer Obj f)
(foreach Att (vlax-invoke Obj 'getattributes)
(vl-catch-all-apply 'vla-put-stylename (list Att "ROMANS"))
)
)
)
(t nil)
)
)
)
(setq ss1 (ssget "X" '((0 . "MTEXT,TEXT"))))
(if ss1
(progn
(setq sscount (sslength ss1))
(setq val1 (- sscount 1))
(repeat sscount
(setq ent (vlax-ename->vla-object (ssname ss1 val1)))
(vla-put-layer ent "TextLayer")
(setq val1 (- val1 1))
)
)
)
(vla-Regen ActDoc acActiveViewport)
(acet-ui-progress-done)
(princ)
)