Topic: Font file issues

[Lee Mac]

...
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.

[MeasureUp]

Thanks Lee.
I will come back to your reply.

[MeasureUp]

...
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
...
)


[alanjt]

(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.

[MeasureUp]

(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.

[Lee Mac]

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... ]

[alanjt]

(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

[MeasureUp]

Thanks, Alan.

ditto

I need to think again.

[alanjt]

I need to think again.

[MeasureUp]

...
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?

[Lee Mac]

...
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.

[MeasureUp]

Thanks, Lee.

[MeasureUp]

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?

[alanjt]

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.

[MeasureUp]

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.