Results 1 to 5 of 5

Thread: Font availability check

  1. #1
    I could stop if I wanted to
    Join Date
    2001-01
    Posts
    257
    Login to Give a bone
    0

    Default Font availability check

    Hi Everyone-

    I am looking for help with a routine that will check to see if a font in either .shx or .ttf is available on your system. I have a routine that creates numerous default text styles but it bombs out when it cannot find a specified font. Thanks in advance.

    Manuel A. Ayala

  2. #2
    AUGI Addict kennet.sjoberg's Avatar
    Join Date
    2002-05
    Posts
    1,707
    Login to Give a bone
    0

    Default Re: Font availability check

    Hi Manuel, I do not use .ttf my self but maybe You can find help with this code
    Code:
    (defun c:ChkFontStyles ( / FontList )
      (setq FontList (list (cdr (assoc 2 (tblnext "STYLE" T )))) )
      (while (car (reverse FontList ))
        (setq FontList (append FontList (list (cdr (assoc 2 (tblnext "STYLE" nil ))))) )
      )
      (setq FontList (vl-remove nil FontList ) )
      (foreach FontStyle FontList
        (princ
          (strcat
            "\n\nStyle " FontStyle " belong to fontfile " (cdr (assoc 3 (tblsearch "STYLE" FontStyle )))
            "\nin Fontfile "
            (if (findfile (cdr (assoc 3 (tblsearch "STYLE" FontStyle ))))
              (findfile (cdr (assoc 3 (tblsearch "STYLE" FontStyle ))))
            "that is not in the searchpath, or missing the file extension."
            )
          )
        )
      )
      (textscr)
      (princ "\n\nHappy Computing !\n\nkennet" )
      (princ)
    )
    : ) Happy Computing !

    kennet

  3. #3
    100 Club CADmium's Avatar
    Join Date
    2004-08
    Location
    Eberswalde, Germany, Europe
    Posts
    128
    Login to Give a bone
    0

    Default Re: Font availability check

    Try this:
    Code:
    (defun DT:FONT_EXIST (FONTFILE / )
      (if (=(type FONTFILE) 'STR)
        (progn
          (setq FONTFILE (strcase FONTFILE 'T))  
          (if (not(vl-string-search "." FONTFILE)) (setq FONTFILE (strcat FONTFILE ".shx")))
          (cond
            ((=(vl-filename-extension FONTFILE)".SHX")	
              (if (findfile FONTFILE)  FONTFILE) 
    	)
    	((and(=(vl-filename-extension FONTFILE)".TTF")	
    	     (vl-registry-read
                   "HKEY_LOCAL_MACHINE\\SOFTWARE\\Microsoft\\Windows NT\\CurrentVersion"
                   "SystemRoot"
                 )
    	     (findfile(strcat
                            (vl-registry-read
                              "HKEY_LOCAL_MACHINE\\SOFTWARE\\Microsoft\\Windows NT\\CurrentVersion"
                              "SystemRoot"
                            )
    	                "\\FONTS\\"
                            FONTFILE
                          )
                 )
              )   
    	   FONTFILE
            )
          )
        )
      )  
    )

  4. #4
    AUGI Addict kennet.sjoberg's Avatar
    Join Date
    2002-05
    Posts
    1,707
    Login to Give a bone
    0

    Default Re: Font availability check

    Hi Manuel, updated for Windows *.ttf searchpath
    Code:
    (defun c:ChkFontStyles ( / FontList WinPath )
      (setq FontList (list (cdr (assoc 2 (tblnext "STYLE" T )))) )
      (while (car (reverse FontList ))
        (setq FontList (append FontList (list (cdr (assoc 2 (tblnext "STYLE" nil ))))) )
      )
      (setq FontList (vl-remove nil FontList ) )
      (setq WinPath (strcat (getenv "windir" ) "\\fonts\\" ) )
      (foreach FontStyle FontList
        (princ
          (strcat
            "\n\nStyle " FontStyle " belong to fontfile " (cdr (assoc 3 (tblsearch "STYLE" FontStyle )))
            "\nlocated in "
            (cond
              ((= (wcmatch (cdr (assoc 3 (tblsearch "STYLE" FontStyle ))) "*.*" ) nil )
                (findfile (strcat (cdr (assoc 3 (tblsearch "STYLE" FontStyle ))) ".shx" )) )
              ((= (type (findfile (strcat WinPath (cdr (assoc 3 (tblsearch "STYLE" FontStyle ))) ))) 'STR )
                (findfile (strcat WinPath (cdr (assoc 3 (tblsearch "STYLE" FontStyle ))) )) )
              ((= (type (findfile (cdr (assoc 3 (tblsearch "STYLE" FontStyle ))))) 'STR )
                (findfile (cdr (assoc 3 (tblsearch "STYLE" FontStyle )))) )
              (t "missplaced AutoCADs or missplaced Windows font searchpath,\nfile not found." )
            )
          )
        )
      )
      (textscr)
      (princ "\n\nHappy Computing !\n\nkennet" )
      (princ)
    )
    : ) Happy Computing !

    kennet

  5. #5
    I could stop if I wanted to
    Join Date
    2001-01
    Posts
    257
    Login to Give a bone
    0

    Default Re: Font availability check

    Hi Everyone-

    Thanks for the replies. I think both of these routines will do the job. Many many thanks.

    Manuel

Similar Threads

  1. Full colour book availability in LT please!
    By nkjones in forum AutoCAD LT - Wish List
    Replies: 0
    Last Post: 2005-03-22, 03:32 PM

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •