Changing text height and style in AutoLISP

[ahipkin60511]

Is there a way to change the height and style of text in an AutoLISP program? Currently I have to do it manually (select the text and change the height in the Properties Box). This Forum has been a wealth of information for me in the past but I haven't seen anyone mention this specifically.

[Jeff_M]

Yes, this is a relatively easy program to write.

Select text objects
Cycle through the selection set
Modify the "Height" and "Stylename" properties using ActiveX OR
Modify the Assoc 40 & 7 lists of the entity list with subst & entmod
Voila! you're done!

HTH,
Jeff

[brennan.cunningham]

Try this out....
New text height:


(defun c:CHGHT ()
(graphscr)
(prompt "text height to change")(terpri)
(setq a (ssget))
(setq nh(getreal "New Text Height . . ? "))
(princ "\nWORKING\n")
(setq N (sslength a))
(progn
(setq n1 N)
(repeat N
(setq n1 (- n1 1))
(setq b (ssname a n1))
(setq c (cdr(assoc 0(entget b))))
(if (= c "TEXT") (progn
(setq e (entget b))
(setq f (assoc 40 e))
(setq g (atof(rtos(cdr f)2 6)))
(entmod (subst(cons(car f) nh) f e))

))
))

(princ)
)


New text style:
(defun C:CHGSTYLE ()
(setq e (getstring "STYLE TO CHANGE TO? >>"))(terpri)
(setq DEG (getreal "OBLIQUING ANGLE OF NEW STYLE?>>"))(terpri)
(setq g (dtr deg))
(setq gh (ssget))
(setq gi (sslength gh)) ;number of objects selected
(setq gk gi)
(repeat gi
(setq gk (- gk 1))
(setq gr (ssname gh gk))
(setq gt (entget gr))
(setq gj (assoc 0 gt))
(setq gl (cdr gj))
(if (= gl "TEXT")
(EDITLIST)
) )
(princ)
)

(defun EDITLIST ()
(setq b gt)
(setq d (assoc 7 b))
(setq d1 (cons (car d ) e))
(setq b1 (subst d1 d b))
(setq f (assoc 51 b1))
(setq f1 (cons (car f ) g))
(setq b2 (subst f1 f b1))
(entmod b2)
)


Enjoy!

[David.Hoole]

Or here's an example using Activex



(defun c:fixtext ( / ss1 index newht newstyle styledata defwidth ename txtobj)
(setq ss1 (ssget (list (cons 0 "*text")))
index 0
newht (getstring "\nEnter new height for text: ")
newstyle (getstring "\Enter new style for text: ")
)
(if (setq styledata (tblsearch "style" newstyle))
(progn
(setq defwidth (cdr (assoc 41 styledata)))
(while (setq ename (ssname ss1 index))
(setq txtobj (vlax-ename->vla-object ename))
(vlax-put-property txtobj 'Height newht)
(vlax-put-property txtobj 'StyleName newstyle)
(if (vlax-property-available-p txtobj 'ScaleFactor)
(vlax-put-property txtobj 'ScaleFactor defwidth)
)
(setq index (1+ index))
)
)
(princ "\nRequested text style does not exist!")
)
(princ)
)

[BCrouse]

Can this work for MText? If not, can it be added. Also, how would you added this to your cad?

[doggarn.70892]

Here is a niffty leroy font routine been using for years




;;TDD.LSP
;;
;;
;;Sets up text styles (IMPERIAL) without having softdesk loaded..
;;
(DEFUN C:Tdd (); Start





(setvar "userr5" 1)
(setvar "USERR4" (* 1 (getvar "DIMSCALE")))

(prompt "\nDefining text styles for ")


;Note this section is for model space fonts... see below for paperspace fonts
(prompt "IMPERIAL drawing..")(princ (strcat "\nCurrent Text Style set to " sname "."))
(setvar "CMDECHO" 0)
(setvar "BLIPMODE" 0)(setq sname (getvar "textstyle"))(princ)
(setq scl_fact (getvar "userr4"))
(command ".style" "Standard" "simplex" (* 1.000 1.000) "1" "0" "n" "n" "n")
(command ".style" "L10" "simplex" (* 0.010 scl_fact) "1" "0" "n" "n" "n")
(command ".style" "L20" "simplex" (* 0.020 scl_fact) "1" "0" "n" "n" "n")
(command ".style" "L30" "simplex" (* 0.030 scl_fact) "1" "0" "n" "n" "n")
(command ".style" "L40" "simplex" (* 0.040 scl_fact) "1" "0" "n" "n" "n")
(command ".style" "L50" "simplex" (* 0.050 scl_fact) "1" "0" "n" "n" "n")
(command ".style" "L60" "simplex" (* 0.060 scl_fact) "1" "0" "n" "n" "n")
(command ".style" "L80" "simplex" (* 0.080 scl_fact) "1" "0" "n" "n" "n")
(command ".style" "L100" "simplex" (* 0.100 scl_fact) "1" "0" "n" "n" "n")
(command ".style" "L120" "simplex" (* 0.120 scl_fact) "1" "0" "n" "n" "n")
(command ".style" "L140" "simplex" (* 0.140 scl_fact) "1" "0" "n" "n" "n")
(command ".style" "L175" "simplex" (* 0.175 scl_fact) "1" "0" "n" "n" "n")
(command ".style" "L200" "simplex" (* 0.200 scl_fact) "1" "0" "n" "n" "n")
(command ".style" "L240" "simplex" (* 0.240 scl_fact) "1" "0" "n" "n" "n")
(command ".style" "L290" "simplex" (* 0.290 scl_fact) "1" "0" "n" "n" "n")
(command ".style" "L350" "simplex" (* 0.350 scl_fact) "1" "0" "n" "n" "n")
(command ".style" "L425" "simplex" (* 0.425 scl_fact) "1" "0" "n" "n" "n")
(command ".style" "L500" "simplex" (* 0.500 scl_fact) "1" "0" "n" "n" "n")
(command ".style" "ROMANT" "ROMANT" (* 0.175 scl_fact) "1" "0" "n" "n" "n")


;Note this section is for paperspace fonts dimscale 1
(setq scl_fact_ps (getvar "userr5"))

(command ".style" "Line" "simplex" (* 1.00 1.000) "1" "0" "n" "n" "n")
(command ".style" "DASH100" "dashfont" (* 0.1000 scl_fact) "1" "0" "n" "n")
(command ".style" "DASH120" "dashfont" (* 0.1200 scl_fact) "1" "0" "n" "n")
(command ".style" "DASH140" "dashfont" (* 0.1400 scl_fact) "1" "0" "n" "n")
(command ".style" "DASH240" "dashfont" (* 0.2400 scl_fact) "1" "0" "n" "n")
(command ".style" "PL100" "simplex" (* 0.1 scl_fact_PS) "1" "0" "n" "n" "n")
(command ".style" "PL120" "simplex" (* 0.12 scl_fact_PS) "1" "0" "n" "n" "n")
(command ".style" "PL140" "simplex" (* 0.14 scl_fact_PS) "1" "0" "n" "n" "n")
(command ".style" "PL80" "simplex" (* 0.08 scl_fact_PS) "1" "0" "n" "n" "n")
(command ".style" "RomanT100" "ROMANT" (* 0.1 scl_fact_PS) "1" "0" "n" "n" "n")
(command ".style" "RomanT120" "ROMANT" (* 0.12 scl_fact_PS) "1" "0" "n" "n" "n")
(setvar "cmdecho" 0)(setvar "textstyle" sname)


(setq sname (getvar "textstyle"))

(setvar "BLIPMODE" 1)(setvar "BLIPMODE" 0)



);end

Mike Perry
Anchorage Alaska
doggarn@acsalaska.net

[peter]

Here is a similar routine that could be used as a template to create routines that change text height style or whatever

Peter Jamtgaard



(defun C:CHW (/ inCount sngTextWidth ssSelections objSelection)
(princ "\nSelect text entities to modify text width: ")
(setq ssSelections (ssget (list (cons 0 "TEXT,ATTDEF")))
sngTextWidth (getdist "\nEnter text width: ")
)
(if (and ssSelections
(> sngTextWidth 0.0)
)
(repeat (setq intCount (sslength ssSelections))
(setq intCount (1- intCount)
objSelection (vlax-ename->vla-object
(ssname ssSelections intCount)
)
)
(vla-put-scalefactor objSelection sngTextWidth)
)
)
(prin1)
)

[David.Hoole]

The code I posted earlier will work for MTEXT, provided the formatting hasn't been applied in the MTEXT Editor. If it has there's a routine called STRIPMTEXT.LSP which will remove the formatting. It can be found at:

http://www.users.qwest.net/~sdoman/

If you're not familiar with customising AutoCAD, the easiest way to add these commands to your setup is to go to Tools>Load Application and add them to the Startup Suite.