Create new text style in vlisp using true type fonts?

[arubus1977]

Hi, can anyone help.....

 

I am trying to create a new text style using visual lisp, the new text style is to have the arial true type font, here is the code:

 

(vl-load-com)
(setq doc (vla-get-activedocument (vlax-get-acad-object)))
(setq styleCol (vla-get-textstyles doc))
(setq myStyle (vla-add styleCol "theStyle"))
(vla-setfont myStyle "ARIAL.TTF" :vlax-False :vlax-False 0 32)

I get the error 'Automation Error. Invalid input'. The problem being the vla-setfont method, but it looks fine according to the vlisp help. I have no problem creating a new text style using an .shx font and the vla-put-fontfile method but cannot use ttf's???

 

Many Thanks

[VVA]

Try it

(setq *kpblc-activedoc* (vla-get-activedocument (vlax-get-acad-object))) 
(mapcar (function
         (lambda (mip_style font_file / text_style tmp)
           (if (or (setq tmp (findfile font_file))
                   (setq tmp (findfile (strcat
                                         (mip-get-special-folder "Fonts")
                                         "\\"
                                         font_file
                                       ) ;_ end of strcat
                             ) ;_ end of findfile
                   ) ;_ end of setq
               ) ;_ end of or
             (setq font_file tmp)
             (setq font_file nil)
           ) ;_ end of if
           (if font_file
             (if (not (tblsearch "STYLE" mip_style))
               (progn
                 (setq text_style
                        (vla-add (vla-get-textstyles *kpblc-activedoc*)
                                 mip_style
                        ) ;_ end of vla-add
                 ) ;_ end of setq
                 (vla-put-fontfile text_style font_file)
                 (vla-put-width text_style 1.1)
                 (vla-put-height text_style 0.0)
               ) ;_ end of progn
               (progn
                 (setq text_style
                        (vla-item (vla-get-textstyles *kpblc-activedoc*)
                                  mip_style
                        ) ;_ end of vla-item
                 ) ;_ end of setq
                 (vla-put-fontfile text_style (findfile font_file))
                 (vla-put-height text_style 0.0)
                 (vla-put-obliqueangle text_style 0)
                 (vla-put-width text_style 1.1)
               ) ;_ end of progn
             ) ;_ end of if
           ) ;_ end of if
         ) ;_ end of lambda
       ) ;_ end of function
       '("Linetype" "standard" "MyFont")
       '("isocpeur.ttf" "isocpeur.ttf" "arial.ttf")
) ;_ end of mapcar


(defun mip-get-special-folder (folder / WS ret)
;;; Function to determine one of the "special folders" Windows
;;; folder may be:
;;; "AllUsersDesktop" - Windows 2000, Windows XP
;;; "AllUsersStartMenu" - Windows 2000, Windows XP
;;; "AllUsersPrograms" - Windows 2000, Windows XP
;;; "AllUsersStartup" - Windows 2000, Windows XP
;;; "Desktop" - Windows 98/ME, Windows 2000, Windows XP
;;; "Favorites" - Windows 98/ME, Windows 2000, Windows XP
;;; "Fonts" - Windows 98/ME, Windows 2000, Windows XP
;;; "MyDocuments" - Windows 98/ME, Windows 2000, Windows XP
;;; "NetHood" - Windows 98/ME, Windows 2000, Windows XP
;;; "PrintHood" - Windows 98/ME, Windows 2000, Windows XP
;;; "Programs" - Windows 98/ME, Windows 2000, Windows XP
;;; "Recent" - Windows 98/ME, Windows 2000, Windows XP
;;; "SendTo" - Windows 98/ME, Windows 2000, Windows XP
;;; "StartMenu" - Windows 98/ME, Windows 2000, Windows XP
;;; "Startup" - Windows 2000, Windows XP
;;; "Templates" - Windows 2000, Windows XP
;;; Use:
;;;  (mip-get-special-folder "Startup")
(vl-load-com)
 (and
   (setq WS (vlax-get-or-create-object "WScript.Shell"))
   (setq folder (vl-princ-to-string  folder))
   (setq ret (vlax-invoke-method (vlax-get-property WS "SpecialFolders") "Item" folder))
   (vlax-release-object ws)
   )
 (vl-princ-to-string ret)
);defun

[arubus1977]

Excellent

 

Works a treat. Much appreciated.