AutoLISP program that converts text height

[aaronic_abacus]

; This autolisp program converts text height

(DEFUN C:THC (/ SSTEXT NOT CT LP ENT)
  (PROMPT "\n*TEXT HEIGHT CONVERSION*")
  (PROMPT "\nChoose text ")
  (SETQ SSTEXT (SSGET '((0 . "TEXT"))))
  (SETQ NOT (SSLENGTH SSTEXT))
  (SETQ CT (- NOT 1))
  (IF (= THI NIL)
    (SETQ THI (* DWGSCALE 0.1))
  )
  (PROMPT "\nNew text height<")
  (PROMPT (RTOS THI))
  (PROMPT ">: ")
  (SETQ THIT (GETDIST))
  (IF (/= THIT NIL)
    (SETQ THI THIT)
  )
  (TERPRI)
  (PRINC CT)
  (PROMPT " Text Entities, Converting... ")
  (SETQ LP 1)
  (WHILE LP
    (SETQ ENT (SSNAME SSTEXT CT))
    (SETQ TL (ENTGET ENT))
    (SETQ TH (ASSOC 40 TL))
    (SETQ THA (CONS 40 THI))
    (SETQ NTH (SUBST THA TH TL))
    (ENTMOD NTH)
    (SETQ CT (- CT 1))
    (IF	(< CT 0)
      (SETQ LP NIL)
    )
  );END WHILE
  (PRINC)
);END THC

[ Moderator Action = ON ] What are [ CODE ] tags... [ Moderator Action = OFF ]

[kpblc2000]

1. Never redefine lisp keywords (not, nth)!
2. Where are start and end marks?
3. dwgscale is not defined
4. Layer status is not traced

[Adesu]

Hi aaronic,
This code not yet test,sorry

(defun c:thc (/ cnt ct dwgscale ent lp note noteha notehh sstext th tha thi thit tl)
  (prompt "\n*text height conversion*")
  (prompt "\nchoose text ")
  (setq sstext (ssget '((0 . "text"))))
  (setq note (sslength sstext))
  ;(setq ct (- not 1))
  (setq cnt 0)
  (if
    (= thi nil)
    (progn
      (setq dwgscale (getreal "\nEnter drawing scale <1/2>: "))
      (if (= dwgscale nil)(setq dwgscale 0.5))
      (setq thi (* dwgscale 0.1))
      )                           ; progn
    )                             ; if
  ;(prompt "\nnew text height<")
  ;(prompt (rtos thi))
  ;(prompt ">: ")
  (prompt (strcat "\nnew text height< " (rtos thi) " >: "))
  (setq thit (getdist))
  (if (/= thit nil) (setq thi thit))
  (terpri)
  ;(princ ct)
  (prompt " text entities, converting... ")
  (setq lp 1)
  ;(while lp
  (repeat
    note
    (setq ent (ssname sstext ct))
    (setq tl (entget ent))
    (setq th (assoc 40 tl))
    (setq tha (cons 40 thi))
    (setq notehh (subst tha th tl))
    (entmod noteha)
    ;(setq ct (- ct 1))
    (setq cnt (1+ cnt))
    ;(if (< ct 0) (setq lp nil))
    )     ; repeat
  (princ)
  );end thc

; This autolisp program converts text height


(DEFUN C:THC (/ SSTEXT NOT CT LP ENT)
(PROMPT "\n*TEXT HEIGHT CONVERSION*")
(PROMPT "\nChoose text ")
(SETQ SSTEXT (SSGET '((0 . "TEXT"))))
(SETQ NOT (SSLENGTH SSTEXT))
(SETQ CT (- NOT 1))
(IF (= THI NIL) (SETQ THI (* DWGSCALE 0.1)))
(PROMPT "\nNew text height<")
(PROMPT (RTOS THI))
(PROMPT ">: ")
(SETQ THIT (GETDIST))
(IF (/= THIT NIL) (SETQ THI THIT))
(TERPRI)
(PRINC CT)
(PROMPT " Text Entities, Converting... ")
(SETQ LP 1)
(WHILE LP
(SETQ ENT (SSNAME SSTEXT CT))
(SETQ TL (ENTGET ENT))
(SETQ TH (ASSOC 40 TL))
(SETQ THA (CONS 40 THI))
(SETQ NTH (SUBST THA TH TL))
(ENTMOD NTH)
(SETQ CT (- CT 1))
(IF (< CT 0) (SETQ LP NIL))
);END WHILE
(PRINC)
);END THC

[kpblc2000]

another way (used activex functions):

(defun c:texth (/ adoc selset text_h)
  (vl-load-com)
  (vla-startundomark
    (setq adoc (vla-get-activedocument (vlax-get-acad-object)))
    ) ;_ end of vla-StartUndoMark
  (vl-catch-all-apply
    (function
      (lambda ()
        (if
          (not (setq text_h
                      ((lambda (/ res)
                         (initget 128 "Scale New _ S N")
                         (setq res
                                (getdist
                                  (strcat
                                    "\nNew text height [Scale/New height] <Height = "
                                    (rtos (getvar "textsize"))
                                    " > : "
                                    ) ;_ end of strcat
                                  ) ;_ end of getdist
                               ) ;_ end of setq
                         (cond
                           ((= res "S")
                            (initget 6)
                            (setq
                              res (append (list res)
                                          (list (cond
                                                  ((getreal "\nEnter new scale <1> : "))
                                                  (t 1.)
                                                  ) ;_ end of cond
                                                ) ;_ end of list
                                          ) ;_ end of append
                              ) ;_ end of setq
                            )
                           ((= res "N")
                            (initget 6)
                            (setq res
                                   (append
                                     (list
                                       res
                                       ) ;_ end of list
                                     (list (cond
                                             ((getreal (strcat "\nEnter new height <"
                                                               (rtos (getvar "textsize"))
                                                               "> : "
                                                               ) ;_ end of strcat
                                                       ) ;_ end of getreal
                                              )
                                             (t (getvar "textsize"))
                                             ) ;_ end of cond
                                           ) ;_ end of list
                                     ) ;_ end of append
                                  ) ;_ end of setq
                            )
                           ((not res)
                            (getvar "textsize")
                            )
                           ) ;_ end of cond
                         res
                         ) ;_ end of lambda
                       )
                     ) ;_ end of setq
               ) ;_ end of not
           (setq text_h (getvar "textsize"))
           ) ;_ end of if
        (if (setq selset (ssget "_:L" '((0 . "*TEXT"))))
          (foreach item
                   (mapcar 'vlax-ename->vla-object
                           (vl-remove-if 'listp (mapcar 'cadr (ssnamex selset)))
                           ) ;_ end of mapcar
            (vla-put-height
              item
              (cond
                ((or (= (type text_h) 'real)
                     (= (type text_h) 'int)
                     ) ;_ end of or
                 text_h
                 )
                ((= (car text_h) "N")
                 (cadr text_h)
                 )
                ((= (car text_h) "S")
                 (* (vla-get-height item) (cadr text_h))
                 )
                (t (vla-get-height item))
                ) ;_ end of cond
              ) ;_ end of vla-put-height
            ) ;_ end of foreach
          ) ;_ end of if
        ) ;_ end of lambda
      ) ;_ end of function
    ) ;_ end of vl-catch-all-apply
  (vla-endundomark adoc)
  (princ)
  ) ;_ end of defun

[abdulhuck]

; This autolisp program converts text height

Dear Aron,

As long as we can use the Chtext.lsp shipped with older versions of AutoCAD, I feel that these functions are not very useful. Still you can combine your pieces of codes in to one function and choose options for height, width, style, colour, layer, rotation, ... etc.

Regards,

Abdul Huck