Help with routine for text styles - Autolisp

[scottividal]

Hello,

I'm trying to create a routine that creates a new text style and at the same time changes the text style of all the texts in a layer determined by this new style.
But I can not find how to create text styles in the "AutoLISP Developer's Guide".

Could someone guide me a little?

Thank you,

[dbhunia]

Hi,

As you asked......

---

@scottividal wrote:

Hello,

I'm trying to create a routine that creates a new text style and at the same time changes the text style of all the texts in a layer determined by this new style.
But I can not find how to create text styles in the "AutoLISP Developer's Guide".
..........................

---

Try this........ (But if your "Font Name" is wrong it will create a style with that, but should not work properly)......

(defun C:TSC (/)
(setq ST (getstring "\nEnter Style Name to Create: "))
(setq FN (getstring "\nEnter Font Name: "))
 (if (not (tblsearch "STYLE" ST))
   (progn
   (entmakex (list
		'(0 . "STYLE")
		'(100 . "AcDbSymbolTableRecord")
		'(100 . "AcDbTextStyleTableRecord")
		(cons 2 ST) ;Style Name
		'(70 . 0)
	        '(40 . 0.0)
                '(41 . 1.0)
		'(50 . 0.0)
		'(71 . 0)
		'(42 . 0.09375)
		(cons 3 FN);Get Font Name
		'(4 . "")
	     )
   )
   (setq LAY (cdr(assoc 8 (entget(car(entsel "\Select Layer to Change Text Style: "))))))
   (Setq selectionset (ssget "_A" (list '(0 . "TEXT") (cons 8 LAY))))
   (repeat (setq N (sslength selectionset))
	(setq Data (ssname selectionset (setq N (- N 1))))
	(setq EntityData (entget Data))
	(setq Text_ST (cdr (assoc 7 EntityData)))
	(entmod(subst (cons 7 ST) (assoc 7 EntityData) EntityData))
   )
   )
   (princ "\n Style already defined")
 )
(princ)
)

So it is my advice to create a Style first and then try this........

(defun C:TSC (/)
(setq ST (getstring "\nEnter Style Name to Change: "))
(if (not (tblsearch "STYLE" ST))
   (princ "\nStyle Does not Exist")
   (progn
     (setq LAY (cdr(assoc 8 (entget(car(entsel "\Select Layer to Change Text Style: "))))))
     (Setq selectionset (ssget "_A" (list '(0 . "TEXT") (cons 8 LAY))))
     (repeat (setq N (sslength selectionset))
	(setq Data (ssname selectionset (setq N (- N 1))))
	(setq EntityData (entget Data))
	(setq Text_ST (cdr (assoc 7 EntityData)))
  	(entmod(subst (cons 7 ST) (assoc 7 EntityData) EntityData))
     )
   )
)
(princ)
)

And for....

---

@Anonymous............

But I can not find how to create text styles in the "AutoLISP Developer's Guide".
............................

---

check this.....

https://adndevblog.typepad.com/autocad/2012/12/how-to-programmatically-create-a-new-text-style-with-truetype-fonts-in-lisp.html

[dlanorh]

Not AutoLisp but Visual Lisp.

; returns newly created text style or existing if name already exists
(defun rh:create_txtstyle ( s_name doc / txt_style)
  (if (not (vl-catch-all-error-p (setq txt_style (vl-catch-all-apply 'vla-add (list (vla-get-textstyles doc) s_name)))))
     txt_style
  );end_if
);end_defun

;; Usage
(vl-load-com)
(defun c:test ( / c_doc txt_style)
  (setq c_doc (vla-get-activedocument (vlax-get-acad-object)))

  (if (setq txt_style (rh:create_txtstyle "MyNewTxtStyle" c_doc)) ;CHANGE THIS TO THE STYLE NAME YOU REQUIRE
    (progn
      (vlax-put-property txt_style 'fontfile "romans.shx") ;CHANGE THIS TO THE FONT YOU REQUIRE
      (vlax-put-property txt_style 'height 0)
      ; other available properties to set 'lastheight 'obliqueangle 'width 'bigfontfile 
    );end_progn
    (alert "Invalid Text Style Name")
  );end_if
  (ssget "_X" '((0 . "TEXT") (8 . "REQUIRED_LAYER"))) ;CHANGE THIS TO THE LAYER YOU REQUIRE
  (vlax-for t_obj (vla-get-activeselectionset c_doc)
    (vlax-put-property t_obj 'textstyle txt_style)
  );end_for  
);end_defun