Topic: Creating or Changing Text Styles - Annotative or Not

[cmwade77]

I had been looking for a way to create text styles, especially annotative text styles without using the style command for various reasons and found there wasn't really anything out there that I could find, so in checking various places, this is what I have come up with:

Code: [Select]

(defun CW:CreateTextStyle (StyleName Font Annotative Height WidthFactor MakeActive / *ThisDrawing* *Styles* Obj DestinationTypeFace Font_Path xtype xdata TypeFace Bold Italic charSet PitchandFamily)
  ;Create Text Style
  ;2022-04-11 - Chris Wade - cmwade77 on cadtutor.net and theswamp.org
  (vl-load-com) 
  (setq *ThisDrawing* (vla-get-activedocument (vlax-get-acad-object))
        *Styles* (vla-get-textstyles *ThisDrawing*)
        Obj (vla-add *Styles* StyleName)
  )
  (if Obj
    (progn
      (if (= (strcase (vl-filename-extension Font)) (strcase ".ttf"))
        (progn
          (if (not (setq Font_Path (findfile (strcat (getenv "WINDIR") "\\fonts\\" Font))))
            (progn
              (setq Font_Path (findfile Font))
              (setq Font_Path (getfiled "Select Font File" "ttf"))
            )
          )         
        )
      )
      (if Font_Path       
        (setq DestinationTypeFace (vl-filename-base Font))       
        (progn
          (alert "Couldn't find font path, exiting!")
          (repeat 3
            (vla-purgeall *ThisDrawing*)
          )
          (exit)
        )
      )     
      (vla-GetFont Obj 'typeFace 'Bold 'Italic 'charSet 'PitchandFamily)     
      (vla-put-fontfile Obj Font_Path)
      (vla-SetFont Obj DestinationTypeFace Bold Italic charSet PitchandFamily)     
      (vla-put-height Obj Height)
      (vla-put-width Obj WidthFactor)
      (vla-put-ObliqueAngle Obj 0.0)
      (vla-put-TextGenerationFlag Obj 0)
      ;Code to make Annotative adapted from codw by ksperopoulos at https://www.cadtutor.net/forum/topic/59375-making-text-style-annotative/?do=findComment&comment=491676
      (if Annotative
        (progn
          (setq xtype (vlax-make-safearray vlax-vbInteger '(0 . 5))
                 xdata (vlax-make-safearray vlax-vbVariant '(0 . 5))
          )
          (vlax-safearray-put-element xtype 0 1001)
          (vlax-safearray-put-element xdata 0 "AcadAnnotative")
          (vlax-safearray-put-element xtype 1 1000)
          (vlax-safearray-put-element xdata 1 "AnnotativeData")
          (vlax-safearray-put-element xtype 2 1002)
          (vlax-safearray-put-element xdata 2 "{")
          (vlax-safearray-put-element xtype 3 1070)
          (vlax-safearray-put-element xdata 3 1)
          (vlax-safearray-put-element xtype 4 1070)
          (vlax-safearray-put-element xdata 4 1)
          (vlax-safearray-put-element xtype 5 1002)
          (vlax-safearray-put-element xdata 5 "}")
          (vla-SetXData Obj xtype xdata)
        )
      )
      (if MakeActive
        (vla-put-activetextstyle *ThisDrawing* Obj)
      )
    )
  )
  Obj
)It returns the text style as an ActiveX object so that you can make further adjustments if needed to minimize the number of parameters needed.

Please let me know what you think or if there is a better way to do this.

EDIT: Later versions in this thread will also change existing text styles.

[JohnK]

What happens if the style exists?
~ as the code stands, this procedure will override end-user overrides. Is this a design feature?

What happens if a value isn't "within normal range"?
~ as the code stands, this procedure will error out.

Code: [Select]

Command: (CW:CreateTextStyle "Test" "arial.ttf" 1 0.09375 0 0)
; error: Automation Error. Invalid input
;; The WIDTH value is wrong~ the font section isn't handling incorrect values properly.

Code: [Select]

Command: (CW:CreateTextStyle "Test" "arial2.ttf" 1 0.09375 1 0)
; error: too few arguments
I will try to find some time to look more later.

[cmwade77]

What happens if the style exists?
~ as the code stands, this procedure will override end-user overrides. Is this a design feature?

What happens if a value isn't "within normal range"?
~ as the code stands, this procedure will error out.

Code: [Select]

Command: (CW:CreateTextStyle "Test" "arial.ttf" 1 0.09375 0 0)
; error: Automation Error. Invalid input
;; The WIDTH value is wrong~ the font section isn't handling incorrect values properly.

Code: [Select]

Command: (CW:CreateTextStyle "Test" "arial2.ttf" 1 0.09375 1 0)
; error: too few arguments
I will try to find some time to look more later.

Exactly why I posted this, I have addressed these errors and adjusted the code to where if the text style already exists it will change the existing style.

Code: [Select]

(defun CW:CreateOrCahngeTextStyle (StyleName Font Annotative Height WidthFactor MakeActive / *ThisDrawing* *Styles* Style Obj DestinationTypeFace Font_Path xtype xdata TypeFace Bold Italic charSet PitchandFamily)
  ;Create Text Style
  ;2022-04-11 - Chris Wade - cmwade77 on cadtutor.net and theswamp.org
  (cond
    ((and (<= WidthFactor 0.01) (= WidthFactor (abs WidthFactor)))
      (princ (strcat "\nInvalid width factor of " (rtos WidthFactor 2 0) " specified, setting width factor to smallest allowable value of 0.01\n"))
      (setq WidthFactor 0.01)
    )
    ((< WidthFactor 0)
      (setq WidthFactor (* WidthFactor -1))
      (princ (strcat "\nInvalid width factor of " (rtos (* WidthFactor -1) 2 0 ) " specfied, adjusting to: " (rtos WidthFactor 2 0) "\n"))
    )
  )
  (vl-load-com) 
  (if (= (strcase (vl-filename-extension Font)) (strcase ".ttf"))       
    (setq Font_Path (findfile (strcat (getenv "WINDIR") "\\fonts\\" Font)))
    (progn
      (if (strcase (vl-filename-extension Font) (strcase ".shx"))
        (setq Font_Path (findfile Font))
      )
    )                     
  )
  (if Font_Path       
    (setq DestinationTypeFace (vl-filename-base Font))       
    (progn
      (alert "Couldn't find font path, exiting!")     
      (exit)
    )
  )
  (setq *ThisDrawing* (vla-get-activedocument (vlax-get-acad-object))
        *Styles* (vla-get-textstyles *ThisDrawing*)       
  )
  (vlax-for Style *Styles*
    (if (= (strcase (vla-get-name Style)) (strcase StyleName))
      (setq Obj Style)
    )
  )
  (if (not Obj)
    (setq Obj (vla-add *Styles* StyleName))
  )
  (if Obj
    (progn     
      (vla-GetFont Obj 'typeFace 'Bold 'Italic 'charSet 'PitchandFamily)     
      (vla-put-fontfile Obj Font_Path)
      (vla-SetFont Obj DestinationTypeFace Bold Italic charSet PitchandFamily)     
      (vla-put-height Obj Height)
      (vla-put-width Obj WidthFactor)
      (vla-put-ObliqueAngle Obj 0.0)
      (vla-put-TextGenerationFlag Obj 0)
      ;Code to make Annotative adapted from codw by ksperopoulos at https://www.cadtutor.net/forum/topic/59375-making-text-style-annotative/?do=findComment&comment=491676
      (if Annotative
        (progn
          (setq xtype (vlax-make-safearray vlax-vbInteger '(0 . 5))
                 xdata (vlax-make-safearray vlax-vbVariant '(0 . 5))
          )
          (vlax-safearray-put-element xtype 0 1001)
          (vlax-safearray-put-element xdata 0 "AcadAnnotative")
          (vlax-safearray-put-element xtype 1 1000)
          (vlax-safearray-put-element xdata 1 "AnnotativeData")
          (vlax-safearray-put-element xtype 2 1002)
          (vlax-safearray-put-element xdata 2 "{")
          (vlax-safearray-put-element xtype 3 1070)
          (vlax-safearray-put-element xdata 3 1)
          (vlax-safearray-put-element xtype 4 1070)
          (vlax-safearray-put-element xdata 4 1)
          (vlax-safearray-put-element xtype 5 1002)
          (vlax-safearray-put-element xdata 5 "}")
          (vla-SetXData Obj xtype xdata)
        )
      )
      (if MakeActive
        (vla-put-activetextstyle *ThisDrawing* Obj)
      )
    )
  )
  Obj
)

[JohnK]

A few *QUICK* thoughts.

Your `WidthFactor` code is a bit overkill. I tend to set/ensure default values like this; it is far more clear what you are doing (setting a value but ensuring it is within range).

Code - Auto/Visual Lisp: [Select]

1. (set 'WidthFactor
2.      (cond
3.        ((>= WidthFactor 0.01) (abs WidthFactor))
4.        (0.01)))

Also, you can use a built in function instead of creating your own to search if the style exists.

Code - Auto/Visual Lisp: [Select]

1. (tblsearch "style" StyleName)

I wouldn't EXIT if the font is bad, I would set a default font--of arial-. See my short `widthfactor` example above. If this is intended as a "library type function" you can assume the font is somewhat vetted but I would still do a simple search like (findfile "arial.ttf").

The overall logic is getting a bit convoluted (if (not obj) ... (if obj... (if obj setq obj... which can be cleaned up quite a bit. I am trying to get through a few more specification sections at the moment but I will see if I can mock something up in the style how *I* would approach this.

[JohnK]

I just noticed that you are intending to "create or CHANGE" so my comment about searching above is not on topic (and I'll have to look over your code again). Sorry for any confusion.

[cmwade77]

A few *QUICK* thoughts.

Your `WidthFactor` code is a bit overkill. I tend to set/ensure default values like this; it is far more clear what you are doing (setting a value but ensuring it is within range).

Code - Auto/Visual Lisp: [Select]

1. (set 'WidthFactor
2.      (cond
3.        ((>= WidthFactor 0.01) (abs WidthFactor))
4.        (0.01)))

Also, you can use a built in function instead of creating your own to search if the style exists.

Code - Auto/Visual Lisp: [Select]

1. (tblsearch "style" StyleName)

I wouldn't EXIT if the font is bad, I would set a default font--of arial-. See my short `widthfactor` example above. If this is intended as a "library type function" you can assume the font is somewhat vetted but I would still do a simple search like (findfile "arial.ttf").

The overall logic is getting a bit convoluted (if (not obj) ... (if obj... (if obj setq obj... which can be cleaned up quite a bit. I am trying to get through a few more specification sections at the moment but I will see if I can mock something up in the style how *I* would approach this.

So. I had tried the idea of (findfile "arial.ttf") and that works if the font is installed on the system as a Windows font; however, let's say you tried (findfile "arial2.ttf") and that font is not installed as a Windows font, then the rest of the routine fails, as the font must be installed as a windows font AND you must have the font file associated with the installed font. I didn't know this until I tried what you suggest.

And yes, the widthfactor code may be overkill, but in all reality this mainly meant for my LISP routine use, but I like getting the feedback, as it helps me see what I may have missed and helps me do better in the long run.

And there probably can be quite a bit of cleanup.

[cmwade77]

I just noticed that you are intending to "create or CHANGE" so my comment about searching above is not on topic (and I'll have to look over your code again). Sorry for any confusion.

Yeah, that was a change I quickly found I had to make because there were errors if the style already existed, th confusion was totally on my end, but yes, I do want to fix any overrides that might exist.