TheSwamp

Code Red => AutoLISP (Vanilla / Visual) => Topic started by: MeasureUp on February 06, 2011, 06:28:47 PM

Title: Font file issues
Post by: MeasureUp on February 06, 2011, 06:28:47 PM
I try to create a new text style when working on client's drawings.
Here is my code

Code: [Select]
(command "._-style" "Arial" "arial.ttf" "0.0" "1.0" "0.0" "No" "No")

Then I have an error message:

Quote
Command: (command "._-style" "Arial" "arial.ttf" "0.0" "1.0" "0.0" "No" "No")
._-style Enter name of text style or [?] <STANDARD>: Arial
New style.
Specify full font name or font filename (TTF or SHX) <txt>: arial.ttf
Font file doesn't exist.
Command: 0.0 Unknown command "0".  Press F1 for help.

Command: 1.0 Unknown command "0".  Press F1 for help.

Command: 0.0 Unknown command "0".  Press F1 for help.

Command: No Unknown command "NO".  Press F1 for help.

Command: No Unknown command "NO".  Press F1 for help.

Command: nil

AFAIK, all "ttf" fonts are resided in "c:/windows/fonts" directory.
I then explore the font foder & found a "arial_2.ttf" instead of "arial.ttf".
The strange thing is that the following returns "c:\\windows\\fonts\\arial.ttf".

Code: [Select]
(findfile "c:\\windows\\fonts\\arial.ttf")

I then did a couple of searches by using "findfile" method again & these are found
Quote
"c:\\windows\\fonts\\arial_0.ttf"
"c:\\windows\\fonts\\arial_1.ttf"
"c:\\windows\\fonts\\arial_2.ttf"
"c:\\windows\\fonts\\arial_3.ttf"
"c:\\windows\\fonts\\arial_4.ttf"
"c:\\windows\\fonts\\arial_5.ttf"
"c:\\windows\\fonts\\arial_6.ttf"
"c:\\windows\\fonts\\arial_7.ttf"
"c:\\windows\\fonts\\arial_8.ttf"
"c:\\windows\\fonts\\arial_9.ttf"

These font files do not exist in the "c:/windows/fonts" directory in fact.

Of course, I can rename the file name of "arial_2.ttf" to the original "arial.ttf".
But now my question is in the code how to check if the "arial.ttf" exists before creating the "arial" text style?

Thanks for your help.
Title: Re: Font file issues
Post by: Lee Mac on February 06, 2011, 06:50:15 PM
Just to demonstrate a possible idea - not really a practical solution:

Code: [Select]
(defun CreateTextStyle ( style font / result )

  (defun _GetSpecialFolder ( name / wshShell specialFolders result )
    ; MP
   
    (vl-catch-all-apply
       '(lambda (  )
            (setq
                wshShell       (vlax-create-object "WScript.Shell")
                specialFolders (vlax-get wshShell 'SpecialFolders)
                result         (vlax-invoke specialFolders 'Item name)
            )             
        )
    )

    (if specialFolders (vlax-release-object specialFolders))
    (if wshShell (vlax-release-object wshShell))
   
    result
  )

  (if (setq font (findfile (strcat (_GetSpecialFolder "Fonts") "\\" font)))
    (vla-put-Fontfile
      (setq result
        (vla-Add
          (vla-get-TextStyles
            (vla-get-ActiveDocument (vlax-get-acad-object))
          )
          style
        )
      )
      font
    )
  )
  result
)

e.g.:

Code: [Select]
(CreateTextStyle "NewStyle" "Arial.ttf")
Note that if the Style specified exists, the font file for that style will be changed accordingly, else the Style will be created. Either way, if the fontfile is found, the Text Style will be returned.

Lee
Title: Re: Font file issues
Post by: MeasureUp on February 06, 2011, 07:12:21 PM
Thanks Lee.
Hope I haven't misunderstood what you explained.

Actually I can create a new style with any name.
In this case I am not worrying the style name but the font file to be used.
As I described previously, the code can lie by returning "c:\\windows\\fonts\\arial.ttf" when I use "findfile" method,
because the "arial.ttf" doesn't exist instead of "arial_2.ttf".
To ensure the font does exist, I need to put a checking function before I create the new style.
Title: Re: Font file issues
Post by: Lee Mac on February 06, 2011, 08:25:30 PM
I wasn't pertaining to the name, that was just a convenience of the code, rather that this...

Code: [Select]
(setq font (findfile (strcat (_GetSpecialFolder "Fonts") "\\" font)))
...works fine for me  :-)
Title: Re: Font file issues
Post by: MeasureUp on February 06, 2011, 09:56:57 PM
Sorry, maybe I have not expained clearly.
I want the code returning a result something like "arial.ttf is not found" if the "arial.ttf" does not exist in the "c:/windows/fonts" directory.
Title: Re: Font file issues
Post by: Keith™ on February 06, 2011, 10:39:14 PM
Well, arial.ttf should exist in the Font folder as arial.ttf ... Windows may report it as a different name since it is in a special folder (I don't know why they ever thought that was a good idea) ...

Have you tried using the fully qualified path to the font?

Code: [Select]
(command "._-style" "Arial" "c:\\windows\\fonts\\arial.ttf" "0.0" "1.0" "0.0" "No" "No")
Title: Re: Font file issues
Post by: MeasureUp on February 06, 2011, 10:47:42 PM
Well, arial.ttf should exist in the Font folder as arial.ttf ... Windows may report it as a different name since it is in a special folder (I don't know why they ever thought that was a good idea) ...

Have you tried using the fully qualified path to the font?

Code: [Select]
(command "._-style" "Arial" "c:\\windows\\fonts\\arial.ttf" "0.0" "1.0" "0.0" "No" "No")
Thanks, Keith.
Yes, I have tried & had the same result (the messgae: the "arial.ttf" doesn't exist.)
Title: Re: Font file issues
Post by: Lee Mac on February 07, 2011, 07:44:31 AM
Sorry, maybe I have not expained clearly.
I want the code returning a result something like "arial.ttf is not found" if the "arial.ttf" does not exist in the "c:/windows/fonts" directory.

You could easily add an 'else' expression printing a message of that nature to my current code if need be - my question would be: does my code work for you? i.e. does it return a TextStyle object?
Title: Re: Font file issues
Post by: MeasureUp on February 07, 2011, 11:06:17 PM
Sorry, Lee.
I tried but it doesn't work.

Quote
... does my code work for you? i.e. does it return a TextStyle object?
Title: Re: Font file issues
Post by: Lee Mac on February 08, 2011, 08:17:09 AM
Sorry, Lee.
I tried but it doesn't work.

Quote
... does my code work for you? i.e. does it return a TextStyle object?

What error do you get, if any?
Title: Re: Font file issues
Post by: Pepe on February 08, 2011, 01:08:36 PM
Hi...

Just to get registered Font Files (at least in Windows XP); after that you can check if your choice is a member of them.

Code: [Select]
(defun Get_TTFs (/ RegKey RegTTF TtfFil)
  (setq RegKey "HKEY_LOCAL_MACHINE\\SOFTWARE\\Microsoft\\Windows NT\\CurrentVersion\\Fonts"
RegTTF (vl-registry-descendents RegKey "")
)
  (foreach n RegTTF
    (setq TtfFil (cons (vl-registry-read RegKey n) TtfFil))
    )
  (reverse TtfFil)
  )

Regards from Spain  :-).
Title: Re: Font file issues
Post by: alanjt on February 08, 2011, 02:10:35 PM
Hi...

Just to get registered Font Files (at least in Windows XP); after that you can check if your choice is a member of them.

Code: [Select]
(defun Get_TTFs (/ RegKey RegTTF TtfFil)
  (setq RegKey "HKEY_LOCAL_MACHINE\\SOFTWARE\\Microsoft\\Windows NT\\CurrentVersion\\Fonts"
RegTTF (vl-registry-descendents RegKey "")
)
  (foreach n RegTTF
    (setq TtfFil (cons (vl-registry-read RegKey n) TtfFil))
    )
  (reverse TtfFil)
  )

Regards from Spain  :-).

Nice.

Code: [Select]
(defun GetTTFs (/)
  ((lambda (reg)
     (mapcar (function (lambda (n) (cons n (vl-registry-read reg n))))
             (vl-registry-descendents reg "")
     )
   )
    "HKEY_LOCAL_MACHINE\\SOFTWARE\\Microsoft\\Windows NT\\CurrentVersion\\Fonts"
  )
)

Code: [Select]
(defun _filter (lst filter)
  (vl-remove-if-not (function (lambda (x) (wcmatch (strcase (car x)) (strcase filter)))) lst)
)

eg.
Code: [Select]
(_filter (GetTTFs) "*ARIAL*")
Title: Re: Font file issues
Post by: MeasureUp on February 08, 2011, 05:12:05 PM
...
What error do you get, if any?
Thanks to Lee, again.
Here is what I got:
Code: [Select]
#<VLA-OBJECT IAcadTextStyle 000000002b774a68>
Title: Re: Font file issues
Post by: MeasureUp on February 08, 2011, 05:15:20 PM
Thanks to Pepe.
Your code returns all fonts in the "fonts" folder.
It looks nice.
But I also need a filter to show only the 'arial.ttf".
Title: Re: Font file issues
Post by: MeasureUp on February 08, 2011, 05:23:20 PM
Thanks, Alan.
Your code can return the family of "arial" fonts.
It looks a lot better.
How to improve the filter to show only "arial.ttf" if it exists?
Thanks again.
Title: Re: Font file issues
Post by: Lee Mac on February 08, 2011, 05:33:59 PM
...
What error do you get, if any?
Thanks to Lee, again.
Here is what I got:
Code: [Select]
#<VLA-OBJECT IAcadTextStyle 000000002b774a68>

Sorry, that is not an error - that is the TextStyle object, indicating that the code has succeeded.
Title: Re: Font file issues
Post by: MeasureUp on February 08, 2011, 06:33:07 PM
Thanks Lee.
I will come back to your reply.
Title: Re: Font file issues
Post by: MeasureUp on February 08, 2011, 06:46:11 PM
...
How to improve the filter to show only "arial.ttf" if it exists?
...
Now I modify this line:
Code: [Select]
(_filter (GetTTFs) "*ARIAL*")
to
Code: [Select]
(_filter (GetTTFs) "Arial (TrueType)")
It looks fine.
It returns:
(("Arial (TrueType)" . "arial.ttf"))
Am I right?

The next question is how to subtract the "arial.ttf" from above line?
Then I can write something like:
Code: [Select]
(setq ArialFont ...)  ;[color=red]need help in this line[/color]
(if (eq ArialFont "arial.ttf")
...
DoSomethingHere
...
)
Title: Re: Font file issues
Post by: alanjt on February 08, 2011, 07:22:36 PM
(cdr <List>)

But I don't understand the point of what you're trying to accomplish. You aren't wanting a list, you are wanting one particular font, but you are basically getting out what you are putting into the sub.
Title: Re: Font file issues
Post by: MeasureUp on February 08, 2011, 07:37:39 PM
(cdr <List>)

But I don't understand the point of what you're trying to accomplish. You aren't wanting a list, you are wanting one particular font, but you are basically getting out what you are putting into the sub.
Thanks Alan, again.
I am going to create a new text style & this is alright to me.
But I found the problem which the font file name has been changed & the code return an error message, as I mensioned before.
So I want to do something like this:
1) Check if the normal font name exists in the windows registry.
2) If the font is found, then create the text style, otherwise give user a warning message.
Title: Re: Font file issues
Post by: Lee Mac on February 08, 2011, 07:40:29 PM
2) If the font is found, then create the text style, otherwise give user a warning message.

Updated mine to give a 'warning message':

Code: [Select]
(defun CreateTextStyle ( style font / result fontfile )

  (defun _GetSpecialFolder ( name / wshShell specialFolders result )
    ; MP
   
    (vl-catch-all-apply
       '(lambda (  )
            (setq
                wshShell       (vlax-create-object "WScript.Shell")
                specialFolders (vlax-get wshShell 'SpecialFolders)
                result         (vlax-invoke specialFolders 'Item name)
            )             
        )
    )

    (if specialFolders (vlax-release-object specialFolders))
    (if wshShell (vlax-release-object wshShell))
   
    result
  )

  (if (setq fontfile (findfile (strcat (_GetSpecialFolder "Fonts") "\\" font)))
    (vla-put-Fontfile
      (setq result
        (vla-Add
          (vla-get-TextStyles
            (vla-get-ActiveDocument (vlax-get-acad-object))
          )
          style
        )
      )
      fontfile
    )
    (princ (strcat "\n** " font " not found **"))
  )
  (princ)
)

[ I still think a nil return was better... ]
Title: Re: Font file issues
Post by: alanjt on February 08, 2011, 07:45:34 PM
(cdr <List>)

But I don't understand the point of what you're trying to accomplish. You aren't wanting a list, you are wanting one particular font, but you are basically getting out what you are putting into the sub.
Thanks Alan, again.
I am going to create a new text style & this is alright to me.
But I found the problem which the font file name has been changed & the code return an error message, as I mensioned before.
So I want to do something like this:
1) Check if the normal font name exists in the windows registry.
2) If the font is found, then create the text style, otherwise give user a warning message.

This might be better (untested)...
Code: [Select]
(defun doesTTFexist (ttf)
  ((lambda (reg ttf)
     (vl-some (function (lambda (x / n) (if (eq (setq n (vl-registry-read reg x)) ttf) n)))
              (vl-registry-descendents reg "")
     )
   )
    "HKEY_LOCAL_MACHINE\\SOFTWARE\\Microsoft\\Windows NT\\CurrentVersion\\Fonts"
    (strcase ttf)
  )
)
eg.
Code: [Select]
(doesTTFexist "ARIAL.TTF")

[ I still think a nil return was better... ]
ditto
Title: Re: Font file issues
Post by: MeasureUp on February 08, 2011, 08:15:15 PM
Thanks, Alan.

Quote
ditto

I need to think again.
Title: Re: Font file issues
Post by: alanjt on February 08, 2011, 08:16:41 PM
I need to think again.
:lmao:
Title: Re: Font file issues
Post by: MeasureUp on February 08, 2011, 08:18:32 PM
...
Here is what I got:
Code: [Select]
#<VLA-OBJECT IAcadTextStyle 000000002b774a68>

Sorry, that is not an error - that is the TextStyle object, indicating that the code has succeeded.

Thanks, Lee.
How to get the font file name at this point?
Title: Re: Font file issues
Post by: Lee Mac on February 08, 2011, 08:20:40 PM
...
Here is what I got:
Code: [Select]
#<VLA-OBJECT IAcadTextStyle 000000002b774a68>

Sorry, that is not an error - that is the TextStyle object, indicating that the code has succeeded.

Thanks, Lee.
How to get the font file name at this point?

The font file has already been assigned to the TextStyle at that point (using vla-put-fontfile in the code) - if you check the newly created TextStyle after running the code, is the Font assigned correctly?

This line:

Code: [Select]
(setq fontfile (findfile (strcat (_GetSpecialFolder "Fonts") "\\" font)))
Constructs the FontFile path.
Title: Re: Font file issues
Post by: MeasureUp on February 08, 2011, 08:50:39 PM
Thanks, Lee.
Title: Re: Font file issues
Post by: MeasureUp on February 08, 2011, 08:59:41 PM
This might be better (untested)...
Code: [Select]
(defun doesTTFexist (ttf)
  ((lambda (reg ttf)
     (vl-some (function (lambda (x / n) (if (eq (setq n (vl-registry-read reg x)) ttf) n)))
              (vl-registry-descendents reg "")
     )
   )
    "HKEY_LOCAL_MACHINE\\SOFTWARE\\Microsoft\\Windows NT\\CurrentVersion\\Fonts"
    (strcase ttf)
  )
)
eg.
Code: [Select]
(doesTTFexist "ARIAL.TTF")...
Now the "arial.ttf" exists in registry.
But when I paste this line to command line it returns "nil".
Code: [Select]
(doesTTFexist "ARIAL.TTF")

Did I miss something?
Title: Re: Font file issues
Post by: alanjt on February 08, 2011, 09:13:48 PM
This might be better (untested)...
Code: [Select]
(defun doesTTFexist (ttf)
  ((lambda (reg ttf)
     (vl-some (function (lambda (x / n) (if (eq (setq n (vl-registry-read reg x)) ttf) n)))
              (vl-registry-descendents reg "")
     )
   )
    "HKEY_LOCAL_MACHINE\\SOFTWARE\\Microsoft\\Windows NT\\CurrentVersion\\Fonts"
    (strcase ttf)
  )
)
eg.
Code: [Select]
(doesTTFexist "ARIAL.TTF")...
Now the "arial.ttf" exists in registry.
But when I paste this line to command line it returns "nil".
Code: [Select]
(doesTTFexist "ARIAL.TTF")

Did I miss something?
Only that I said it was untested. ATM, I don't have AutoCAD on my home machine.
Title: Re: Font file issues
Post by: MeasureUp on February 08, 2011, 11:39:47 PM
Quote
Only that I said it was untested. ATM, I don't have AutoCAD on my home machine.
I tried again. I can't figure it out.
Could you please check it when you are at work?
Thanks.
Title: Re: Font file issues
Post by: Pepe on February 09, 2011, 05:35:32 AM
Quote
Code: [Select]
(defun GetTTFs (/)
  ((lambda (reg)
     (mapcar (function (lambda (n) (cons n (vl-registry-read reg n))))
             (vl-registry-descendents reg "")
     )
   )
    "HKEY_LOCAL_MACHINE\\SOFTWARE\\Microsoft\\Windows NT\\CurrentVersion\\Fonts"
  )
)

Much better and elegant  :lol: !  (Indeed!) I should write this kind of stuff sooner in the day... :ugly: Thank you, alanjt.
Title: Re: Font file issues
Post by: alanjt on February 09, 2011, 08:37:26 AM
Quote
Only that I said it was untested. ATM, I don't have AutoCAD on my home machine.
I tried again. I can't figure it out.
Could you please check it when you are at work?
Thanks.
Try this, I forgot to capitalize the value before checking...

Code: [Select]
(defun doesTTFexist (ttf)
  ((lambda (reg ttf)
     (vl-some (function (lambda (x / n)
                          (if (eq (setq n (strcase (vl-registry-read reg x))) ttf)
                            n
                          )
                        )
              )
              (vl-registry-descendents reg "")
     )
   )
    "HKEY_LOCAL_MACHINE\\SOFTWARE\\Microsoft\\Windows NT\\CurrentVersion\\Fonts"
    (strcase ttf)
  )
)
Title: Re: Font file issues
Post by: MeasureUp on February 09, 2011, 04:56:48 PM
It works graet!
Thanks, Alan.  :-D
Title: Re: Font file issues
Post by: alanjt on February 09, 2011, 04:58:24 PM
It works graet!
Thanks, Alan.  :-D
Rock 'n Roll baby
Title: Re: Font file issues
Post by: MeasureUp on February 09, 2011, 05:17:16 PM
BTW, what is the reason that you make it uppercase?
What if you keep the value lowercase?
Title: Re: Font file issues
Post by: Lee Mac on February 09, 2011, 05:24:05 PM
Just curious, does this work?

Code: [Select]
(findfile (strcat (_GetSpecialFolder "Fonts") "\\" font))
I just didn't see why the registry needs to get involved is all...
Title: Re: Font file issues
Post by: ronjonp on February 09, 2011, 05:46:41 PM
Just curious, does this work?

Code: [Select]
(findfile (strcat (_GetSpecialFolder "Fonts") "\\" font))
I just didn't see why the registry needs to get involved is all...

I was thinking the same thing ... this should work as well:
Code: [Select]
(findfile (strcat (getenv "windir") "\\fonts\\arial.ttf"))
Title: Re: Font file issues
Post by: alanjt on February 09, 2011, 05:54:02 PM
Just curious, does this work?

Code: [Select]
(findfile (strcat (_GetSpecialFolder "Fonts") "\\" font))
I just didn't see why the registry needs to get involved is all...

I was thinking the same thing ... this should work as well:
Code: [Select]
(findfile (strcat (getenv "windir") "\\fonts\\arial.ttf"))
Agreed. I guess I had the fun blinders on. Don't listen to me.
I was just trying to remember that sysvar.
Title: Re: Font file issues
Post by: alanjt on February 09, 2011, 05:55:15 PM
BTW, nice work, Ron.
Title: Re: Font file issues
Post by: MeasureUp on February 09, 2011, 06:16:04 PM
Sorry, Lee.

Code: [Select]
(setq fontfile (findfile (strcat (_GetSpecialFolder "Fonts") "\\" font)))

It is much the same as the following mensioned previously:
Because the they may return a fake result.

Code: [Select]
(findfile "c:\\windows\\fonts\\arial.ttf")

I have just read your latest post & check this one gives the same result as above:

Code: [Select]
(findfile (strcat (getenv "windir") "\\fonts\\arial.ttf"))

I was wondering if there is a way to check the font file name.
Because the "fildfile" lines above may return a fake result as menstioned.

I discuss this issue because the font file name could be changed in some cases.
Title: Re: Font file issues
Post by: ronjonp on February 09, 2011, 06:16:14 PM
BTW, nice work, Ron.
8-)
Title: Re: Font file issues
Post by: Lee Mac on February 09, 2011, 06:19:32 PM
Code: [Select]
(setq fontfile (findfile (strcat (_GetSpecialFolder "Fonts") "\\" font)))

It is much the same as the following mensioned previously:
Because the they may return a fake result.

I'm just a little puzzled since the result you posted from running my previous code (the first post) indicated that the font assignment was successful. Which raises the question: What font was assigned to the new TextStyle?
Title: Re: Font file issues
Post by: alanjt on February 09, 2011, 06:22:38 PM
Code: [Select]
(setq fontfile (findfile (strcat (_GetSpecialFolder "Fonts") "\\" font)))

It is much the same as the following mensioned previously:
Because the they may return a fake result.

I'm just a little puzzled since the result you posted from running my previous code (the first post) indicated that the font assignment was successful. Which raises the question: What font was assigned to the new TextStyle?
It's a wacky mystery!   :lol:
Title: Re: Font file issues
Post by: MeasureUp on February 09, 2011, 06:27:09 PM
I have already renamed the "arial_6.ttf" to the original "arial.ttf" in my system.
By continuing the tests I use the "ariali_5.ttf" (my "ariali.ttf" name was changed as well).
Title: Re: Font file issues
Post by: MeasureUp on February 09, 2011, 06:29:39 PM
Alan, did you read my post #34?
Thanks.
Title: Re: Font file issues
Post by: alanjt on February 09, 2011, 07:29:53 PM
Alan, did you read my post #34?
Thanks.
It's to remove any possible case-sensitive occurrences.
Title: Re: Font file issues
Post by: MeasureUp on February 09, 2011, 10:05:41 PM
Thanks.
Will it return a lowercase value if two line were:
Code: [Select]
(vl-registry-read reg x)
...
ttf
Instead of
Code: [Select]
(strcase (vl-registry-read reg x))
...
(strcase ttf)
Title: Re: Font file issues
Post by: alanjt on February 09, 2011, 10:09:59 PM
Thanks.
Will it return a lowercase value if two line were:
Code: [Select]
(vl-registry-read reg x)
...
ttf
Instead of
Code: [Select]
(strcase (vl-registry-read reg x))
...
(strcase ttf)
(strcase <String> T) would, but it's not to set the case, but to have the same case for comparison purposes. Unaltered, each could return any case.

eg.
(eq "dog" DOG") => nil
(eq "DOG" "DOG") => T
(eq (strcase "dog") (strcase "Dog")) => T

In this situation, the case is irrelevant, so I'll just capitalize each for easy comparison.

However, dont' take my word for it. Dissect the routine, step-by-step and see what actually happens.
Title: Re: Font file issues
Post by: MeasureUp on February 10, 2011, 09:08:23 PM
Thank you very much, Alan.
Title: Re: Font file issues
Post by: alanjt on February 10, 2011, 09:36:51 PM
Thank you very much, Alan.
Any time.