Author Topic: SetTextFont  (Read 4457 times)

0 Members and 1 Guest are viewing this topic.

GDF

  • Water Moccasin
  • Posts: 2081
SetTextFont
« on: November 13, 2019, 06:35:57 PM »
Is there a way to modify the code below to work for dimstyles?


Code - Auto/Visual Lisp: [Select]
  1. ;;;http://www.theswamp.org/index.php?topic=6343.0;all
  2. ;;;Jürg Menzi
  3.  
  4. (defun C:SetTextFont ( / AcaDoc FntFil FntPth NewFnt WscObj)
  5.  (setq NewFnt "Helvl.shx"
  6.        WscObj (vlax-create-object "WScript.Shell")
  7.        FntPth (vla-Item (vlax-get WscObj 'SpecialFolders) "Fonts")
  8.        FntFil (cond
  9.                ((findfile NewFnt) NewFnt)
  10.                ((findfile (strcat FntPth "\\" NewFnt)))
  11.                (T nil)
  12.               )
  13.  )
  14.  (if FntFil
  15.   (progn
  16.    (vla-StartUndoMark AcaDoc)
  17.    (vlax-for Sty (vla-get-TextStyles AcaDoc)
  18.     (vla-put-FontFile Sty FntFil)
  19.    )
  20.    (vla-Regen AcaDoc acAllViewports)
  21.    (vla-EndUndoMark AcaDoc)
  22.   )
  23.   (alert (strcat "Requested font file " NewFnt " not found. "))
  24.  )
  25.  (princ)
  26. )
  27.  
Why is there never enough time to do it right, but always enough time to do it over?
BricsCAD 2020x64 Windows 10x64

mailmaverick

  • Bull Frog
  • Posts: 494
Re: SetTextFont
« Reply #1 on: November 14, 2019, 04:44:04 AM »
Not aware about DimStyles but our great Lee Mac has a LISP for Linetypes :-

http://www.lee-mac.com/loadlinetype.html

GDF

  • Water Moccasin
  • Posts: 2081
Re: SetTextFont
« Reply #2 on: November 14, 2019, 10:18:31 AM »
I found this routine:
;;;MP
;;;http://www.theswamp.org/index.php?topic=55439.0
;;;Consolas true type font is a good alternate for RomanS

This is the best I have come up with, for substituting old font to new font:

Code - Auto/Visual Lisp: [Select]
  1. (defun ATT:WIDTH-85  (/ ss wd)
  2.   (if (and (setq ss (ssget "x" '((0 . "INSERT") (66 . 1)))) (setq wd 0.85))
  3.     ((lambda (i / sn)
  4.        (while (setq sn (ssname ss (setq i (1+ i))))
  5.          (foreach
  6.                 x  (vlax-invoke (vlax-ename->vla-object sn) 'GetAttributes)
  7.            (vla-put-scalefactor x wd))))
  8.       -1))
  9.   (princ))
  10. (defun ATT:WIDTH-1  (/ ss wd)
  11.   (if (and (setq ss (ssget "x" '((0 . "INSERT") (66 . 1)))) (setq wd 1.00))
  12.     ((lambda (i / sn)
  13.        (while (setq sn (ssname ss (setq i (1+ i))))
  14.          (foreach
  15.                 x  (vlax-invoke (vlax-ename->vla-object sn) 'GetAttributes)
  16.            (vla-put-scalefactor x wd))))
  17.       -1))
  18.   (princ))
  19. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  20. (defun ARCH:Fix-Fonts-x  (oldname newname / ss idx cnt n e en ent opt)
  21.   (setq txtstyle oldname)
  22.   (setq ss (ssget "_X" '((0 . "MTEXT,TEXT,INSERT"))))
  23.   (if (null ss)
  24.     (progn (alert "ERROR - No Text Entities found")
  25.            (setvar "CMDECHO" 1)
  26.            (exit))
  27.     (progn))
  28.   (setq idx 0)
  29.   (setq cnt 0)
  30.   (setq n (sslength ss))
  31.   (setq opt newname)
  32.   (repeat n
  33.     (setq e (ssname ss cnt))
  34.     (setq en (vlax-ename->vla-object e))
  35.     (if (eq (vla-get-ObjectName en) "AcDbBlockReference")
  36.       (if (= (vla-get-HasAttributes en) :vlax-true)
  37.         (progn (mapcar '(lambda (o) (vla-put-StyleName o opt))
  38.                        (vlax-invoke en 'GetAttributes))
  39.                (vla-Update en)))
  40.       (progn (setq ent (vlax-get-property en "StyleName"))
  41.              (vla-put-StyleName en opt)))
  42.     (setq cnt (1+ cnt)))
  43.   (princ))
  44. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  45. (defun ARCH:Fix-Fonts-ATT  (oldname newname / ss idx cnt n e en ent opt)
  46.   (setq txtstyle oldname)
  47.   ;;(setq ss (ssget "_X" '((0 . "ATTDEF"))))
  48.   (setq ss (ssget "_X" '((0 . "INSERT") (8 . "A-*,E-*,M-*,S-*,*SYMB*"))))
  49.   (if (null ss)
  50.     (progn (alert "ERROR - No Text Entities found")
  51.            (setvar "CMDECHO" 1)
  52.            (exit))
  53.     (progn))
  54.   (setq idx 0)
  55.   (setq cnt 0)
  56.   (setq n (sslength ss))
  57.   (setq opt newname)
  58.   (repeat n
  59.     (setq e (ssname ss cnt))
  60.     (setq en (vlax-ename->vla-object e))
  61.     (if (eq (vla-get-ObjectName en) "AcDbBlockReference")
  62.       (if (= (vla-get-HasAttributes en) :vlax-true)
  63.         (progn (mapcar '(lambda (o) (vla-put-StyleName o opt))
  64.                        (vlax-invoke en 'GetAttributes))
  65.                (vla-Update en)))
  66.       (progn (setq ent (vlax-get-property en "StyleName"))
  67.              (vla-put-StyleName en opt)))
  68.     (setq cnt (1+ cnt)))
  69.   (princ))
  70. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  71. (defun C:SYNC  ()
  72.   (command "_ATTSYNC" "select" (ssget "_x" '((2 . "SYM*"))) "yes")
  73.   (princ))
  74. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  75. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  76. (defun ARCH:SetTextFont (NewFnt / AcaDoc FntFil FntPth NewFnt WscObj)
  77.  ;;;http://www.theswamp.org/index.php?topic=6343.0;all
  78. ;;;Jürg Menzi
  79.  (setq ;;NewFnt "ARIAL.ttf"
  80.        WscObj (vlax-create-object "WScript.Shell")
  81.        FntPth (vla-Item (vlax-get WscObj 'SpecialFolders) "Fonts")
  82.        FntFil (cond
  83.                ((findfile NewFnt) NewFnt)
  84.                ((findfile (strcat FntPth "\\" NewFnt)))
  85.                (T nil)
  86.               )
  87.  )
  88.  (if FntFil
  89.   (progn
  90.    (vla-StartUndoMark AcaDoc)
  91.    (vlax-for Sty (vla-get-TextStyles AcaDoc)
  92.     (vla-put-FontFile Sty FntFil)
  93.    )
  94.    (vla-Regen AcaDoc acAllViewports)
  95.    (vla-EndUndoMark AcaDoc)
  96.   )
  97.   (alert (strcat "Requested font file " NewFnt " not found. "))
  98.  )
  99.  (princ)
  100. )
  101. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  102. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  103. (defun C:Cfont  (/ tmp scl ctx-style sclname tx-style dm-style nfont)
  104.   (setq scl (getvar "dimscale"))
  105.   (setq ctx-style (getvar "textstyle"))
  106.   (cond ((= scl 1) (setq sclname (strcat "00" (rtos scl 2 0))))
  107.         ((or (= scl 128) (= scl 192))(setq sclname (strcat "" (rtos scl 2 0))))
  108.         ((or (/= scl 128) (/= scl 192))(setq sclname (strcat "0" (rtos scl 2 0)))))
  109.   (initget "A H")
  110.   (setq tmp (getkword "\n* Change Font: [Arial Helvl] *"))
  111.   (if (not tmp)(setq tmp "A"))
  112.   (cond ((= tmp "A")
  113.           (progn
  114.             (setq nfont "ARIAL.ttf")
  115.             (ARCH:SetTextFont nfont)
  116.             (setq tx-style (strcat "NOTE " sclname))          
  117.             (setq dm-style (strcat "TICK " sclname))
  118.             ;;(command "-style" tx-style nfont "0" "1.00" "0" "N" "N")
  119.             (ARCH:Fix-Fonts-x ctx-style tx-style)
  120.             (ARCH:Fix-Fonts-ATT ctx-style tx-style)            
  121.             (ATT:WIDTH-1)              
  122.             ;;(setvar "DIMTXSTY" dm-style)
  123.             (cond ((/= (cdr (assoc 2 (tblsearch "dimstyle" dm-style))) dm-style)(command "-dimstyle" "S" dm-style))
  124.                   ((= (cdr (assoc 2 (tblsearch "dimstyle" dm-style))) dm-style)(command "-dimstyle" "S" dm-style "Y")))
  125.             (command "-dimstyle" "A" (ssget "x") "")))
  126.         ((= tmp "H")
  127.           (progn
  128.             (setq nfont "HELVL.shx")
  129.             (ARCH:SetTextFont nfont)
  130.             (setq tx-style (strcat "NOTE " sclname))          
  131.             (setq dm-style (strcat "TICK " sclname))
  132.             ;;(command "-style" tx-style nfont "0" "0.85" "0" "N" "N")
  133.             (ARCH:Fix-Fonts-x ctx-style tx-style)
  134.             (ARCH:Fix-Fonts-ATT ctx-style tx-style)            
  135.             (ATT:WIDTH-85)            
  136.             ;;(setvar "DIMTXSTY" dm-style)
  137.             (cond ((/= (cdr (assoc 2 (tblsearch "dimstyle" dm-style))) dm-style)(command "-dimstyle" "S" dm-style))
  138.                   ((= (cdr (assoc 2 (tblsearch "dimstyle" dm-style))) dm-style)(command "-dimstyle" "S" dm-style "Y")))
  139.             (command "-dimstyle" "A" (ssget "x") "")))
  140.         )
  141.   (princ))
  142. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  143. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  144.  
Why is there never enough time to do it right, but always enough time to do it over?
BricsCAD 2020x64 Windows 10x64

ronjonp

  • Needs a day job
  • Posts: 7526
Re: SetTextFont
« Reply #3 on: November 14, 2019, 10:18:53 AM »
If you're setting the font for the textstyle, shouldn't dimensions referencing that textstyle update?

Windows 11 x64 - AutoCAD /C3D 2023

Custom Build PC

GDF

  • Water Moccasin
  • Posts: 2081
Re: SetTextFont
« Reply #4 on: November 14, 2019, 10:29:53 AM »
Yes, but my clients cad standards do not follow this rule.
Why is there never enough time to do it right, but always enough time to do it over?
BricsCAD 2020x64 Windows 10x64

ronjonp

  • Needs a day job
  • Posts: 7526
Re: SetTextFont
« Reply #5 on: November 14, 2019, 10:37:59 AM »
Yes, but my clients cad standards do not follow this rule.
Explain .. I thought there was only one way to define a font in a dimension via a style?

Windows 11 x64 - AutoCAD /C3D 2023

Custom Build PC

JohnK

  • Administrator
  • Seagull
  • Posts: 10604
Re: SetTextFont
« Reply #6 on: November 14, 2019, 10:45:28 AM »
RE:
Code: [Select]
(progn
    (com "_.-linetype" "_L" typ lin "")
    (tblsearch "ltype" typ)
)

FWIW, You can use the function VLA-LOAD instead of COMMAND. Below are some very old--probably over 20 years old now--functions I wrote on the subject which should demonstrate that use. I have been out of the Autolisp game for a long time but even I can see the "crudeness" of my code snips below (I was obviously just learning lisp when I wrote these). Please feel free to add any efficiencies you feel fit.

Code - Auto/Visual Lisp: [Select]
  1. ;;;===================================================================;
  2. ;;; FIND-LINE-TYPE                                                    ;
  3. ;;;-------------------------------------------------------------------;
  4. ;;; This searches a linetype collection object and determines if      ;
  5. ;;; the linetype is present in the collection.                        ;
  6. ;;;                                                                   ;
  7. ;;; Note: l-obj is a local variable within the scope of the vlax-for  ;
  8. ;;;       function because it is used within a "for" expression       ;
  9. ;;;                                                                   ;
  10. ;;; Arguments: line-type = A string which denotes the linetype        ;
  11. ;;;                        to search for in the line-type-collection  ;
  12. ;;;                        argument.                                  ;
  13. ;;;            line-type-collection = A vla collection object which   ;
  14. ;;;                                   contains the current linetypes  ;
  15. ;;;                                   loaded in ACAD.                 ;
  16. ;;;                                                                   ;
  17. ;;; Returned Value: If the linetype is found a vla linetype object    ;
  18. ;;;                 is returned such as:                              ;
  19. ;;;                 #<VLA-OBJECT IAcadLineType 03fe0b00>              ;
  20. ;;;                 (If the linetype search fails this function       ;
  21. ;;;                  returns n(defun TxtStr (x)                       ;
  22. ;;;                                                                   ;
  23. ;;; Usage: (find-line-type "CENTER" "acad.lin")                       ;
  24. ;;;===================================================================;
  25. (defun find-line-type (line-type line-type-collection / res)
  26.   (setq line-type (strcase line-type))
  27.   (vlax-for l-obj line-type-collection
  28.     (if (= (strcase (vla-get-name l-obj)) line-type)
  29.       (setq res l-obj)
  30.     )
  31.   )
  32.   res
  33. )
  34.  
  35.  
  36. ;;;===================================================================;
  37. ;;; LOAD-LINE-TYPES                                                   ;
  38. ;;;-------------------------------------------------------------------;
  39. ;;; This function loads a linetype in to the drawing                  ;
  40. ;;;                                                                   ;
  41. ;;; Required Functions: find-line-type                                ;
  42. ;;;                                                                   ;
  43. ;;; Arguments: line-type = A string which denotes the LT to load      ;
  44. ;;;            file-name = A string which denotes the LT file to      ;
  45. ;;;                        which to load the requested linetype       ;
  46. ;;;                                                                   ;
  47. ;;; Returned Value:  A vla linetype object objects such as:           ;
  48. ;;;                  #<VLA-OBJECT IAcadLineType 03fe0b00>             ;
  49. ;;;                                                                   ;
  50. ;;; Usage: (load-line-types "CENTER" "acad.lin")                      ;
  51. ;;;===================================================================;
  52. (defun load-line-types (line-type file-name / tmp res)
  53.            (setq tmp (vla-get-activedocument tmp))
  54.            (setq tmp (vla-get-linetypes tmp));; linetypes is the last
  55.                                              ;; set and the current
  56.                                              ;; linetype collection
  57.       )
  58.     (if (setq res (find-line-type line-type tmp))
  59.       res
  60.       (progn
  61.                  ;; load the linetype
  62.         (vla-load tmp line-type file-name)
  63.                  ;; since the vla-load function returns nil
  64.                  ;; we force the following function to test if
  65.                  ;; the load was successful. If success the
  66.                  ;; return the vla linetype object
  67.         (if (vla-item tmp line-type)
  68.           (vla-item tmp line-type)
  69.           ;; Nothing was loaded so we return nil
  70.           nil
  71.         )   ;; _test to see if the line was loaded
  72.       )     ;; evaluate when the linetype is not loaded in acad
  73.     )       ;; end if for check if linetype is loaded
  74.     nil
  75.   )         ;; end if for various calls to ACAD
  76. )
TheSwamp.org (serving the CAD community since 2003)
Member location map - Add yourself

Donate to TheSwamp.org

JohnK

  • Administrator
  • Seagull
  • Posts: 10604
Re: SetTextFont
« Reply #7 on: November 14, 2019, 10:51:39 AM »
If you're setting the font for the textstyle, shouldn't dimensions referencing that textstyle update?

ronjonp, I don't have AutoCAD any longer but I found this snip even further back in my lisp code. This was how I did my dimstyle setting stuff back when I was drawing with crayons in Autolisp (please be nice to me). ...is this what you're referring to?

Code - Auto/Visual Lisp: [Select]
  1. (command "-style" "_Detail-Text" "romans.shx" "0" "1.0" "0" "n" "n" "n")
  2.  
  3. ;;;(command "-dimstyle" "an" "no" "_Detail" "")
  4.         '((SETVAR "DIMADEC" 0)          (SETVAR "DIMALT" 0)             (SETVAR "DIMALTD" 2)
  5.           (SETVAR "DIMALTF" 25.4)       (SETVAR "DIMALTRND" 0.0)        (SETVAR "DIMALTTD" 2)
  6.           (SETVAR "DIMALTTZ" 0)         (SETVAR "DIMALTU" 2)            (SETVAR "DIMALTZ" 0)
  7.           (SETVAR "DIMAPOST" "")        (SETVAR "DIMASZ" 0.125)         (SETVAR "DIMATFIT" 3)
  8.           (SETVAR "DIMAUNIT" 0)         (SETVAR "DIMAZIN" 0)            (SETVAR "DIMBLK" "")
  9.           (SETVAR "DIMBLK1" "")         (SETVAR "DIMBLK2" "")           (SETVAR "DIMCEN" 0.09375)
  10.           (SETVAR "DIMCLRD" 256)        (SETVAR "DIMCLRE" 256)          (SETVAR "DIMCLRT" 256)
  11.           (SETVAR "DIMDEC" 1)           (SETVAR "DIMDLE" 0.0)           (SETVAR "DIMDLI" 0.125)
  12. ;;;          (SETVAR "DIMDSEP" ".")
  13.           (SETVAR "DIMEXE" 0.0625)        (SETVAR "DIMEXO" 0.0625)
  14.           (SETVAR "DIMFRAC" 0)          (SETVAR "DIMGAP" 0.0625)        (SETVAR "DIMJUST" 0)
  15.           (SETVAR "DIMLDRBLK" "")       (SETVAR "DIMLFAC" 1.0)          (SETVAR "DIMLIM" 0)
  16.           (SETVAR "DIMLUNIT" 2)         (SETVAR "DIMLWD" -2)            (SETVAR "DIMLWE" -2)
  17.           (SETVAR "DIMPOST" "")         (SETVAR "DIMRND" 0.0)           (SETVAR "DIMSAH" 0)
  18.           (SETVAR "DIMSCALE" 1.0)       (SETVAR "DIMSD1" 0)             (SETVAR "DIMSD2" 0)
  19.           (SETVAR "DIMSE1" 0)           (SETVAR "DIMSE2" 0)             (SETVAR "DIMSOXD" 0)
  20.           (SETVAR "DIMTAD" 1)           (SETVAR "DIMTDEC" 1)            (SETVAR "DIMTFAC" 1.0)
  21.           (SETVAR "DIMTIH" 1)           (SETVAR "DIMTIX" 0)             (SETVAR "DIMTM" 0.0)
  22.           (SETVAR "DIMTMOVE" 0)         (SETVAR "DIMTOFL" 0)            (SETVAR "DIMTOH" 1)
  23.           (SETVAR "DIMTOL" 0)           (SETVAR "DIMTOLJ" 1)            (SETVAR "DIMTP" 0.0)
  24.           (SETVAR "DIMTSZ" 0.0)         (SETVAR "DIMTVP" 0.0)           (SETVAR "DIMTXSTY" "_Detail-Text")
  25.           (SETVAR "DIMTXT" 0.03125)     (SETVAR "DIMTZIN" 0)            (SETVAR "DIMUPT" 0)
  26.           (SETVAR "DIMZIN" 8)))
  27. (command "-dimstyle" "s" "_Detail")

TheSwamp.org (serving the CAD community since 2003)
Member location map - Add yourself

Donate to TheSwamp.org

myloveflyer

  • Newt
  • Posts: 152
Re: SetTextFont
« Reply #8 on: November 14, 2019, 11:27:30 AM »
This is what I am using now, I hope to help you.
Code: [Select]
(defun DimensionStyleSetup ()
  (command "STYLE" "tpst" "Tssdeng,hztxt" "0" "0.7" "0" "n" "n" "n")
  (setvar "TEXTSTYLE" "tpst")
  (if (not (tblsearch "DIMSTYLE" "Tpst_Dimension"))
    (progn
      (setvar "DIMASZ" 2.0)           
      (setvar "dimexe" 3.0)           
      (setvar "dimdle" 0.0)           
      (setvar "DIMCLRD" 180)           
      (setvar "DIMCLRE" 180)           
      (setvar "DIMCLRT" 6)           
      (setvar "DIMEXO" 2)           
      (setvar "DIMDLI" 3.75)           
      (setvar "DIMBLK1" "_ARCHTICK")
      (setvar "DIMLDRBLK" "_ARCHTICK")
      (setvar "DIMADEC" 0)           
      (setvar "DIMZIN" 8)
      (setvar "DIMDEC" 0)           
      (setvar "DIMTXT" 5.5)           
      (setvar "DIMGAP" 2.0)           
      (setvar "DIMTOH" 0)                   
      (setvar "dimlfac" 1.0)           
      (setvar "dimscale" 8.0)           
      (command "DIMTXSTY" "tpst")
      (command "DIMSTYLE" "S" "Tpst_Dimension")
    )
  )
(command "DIMSTYLE" "r" "Tpst_Dimension")
  (princ)
)
« Last Edit: November 14, 2019, 11:32:04 AM by myloveflyer »
Never give up !

ronjonp

  • Needs a day job
  • Posts: 7526
Re: SetTextFont
« Reply #9 on: November 14, 2019, 12:34:27 PM »
I think I'm misunderstanding what Gary wants to do. The code he posted as an example sets all textstyles to the same font?

Windows 11 x64 - AutoCAD /C3D 2023

Custom Build PC

GDF

  • Water Moccasin
  • Posts: 2081
Re: SetTextFont
« Reply #10 on: November 14, 2019, 12:40:21 PM »
Yes sir. What I want to do is a FONT substitution only.
This would modify: dtext, mtext, textstyles, dimstyles and attributed blocks.
Why is there never enough time to do it right, but always enough time to do it over?
BricsCAD 2020x64 Windows 10x64

ronjonp

  • Needs a day job
  • Posts: 7526
Re: SetTextFont
« Reply #11 on: November 14, 2019, 12:46:58 PM »
Yes sir. What I want to do is a FONT substitution only.
This would modify: dtext, mtext, textstyles, dimstyles and attributed blocks.
Maybe use stripmtext then the dimension should honor the text within the style.

Windows 11 x64 - AutoCAD /C3D 2023

Custom Build PC