Results 1 to 5 of 5

Thread: AutoLISP program that converts text height

  1. #1
    I could stop if I wanted to
    Join Date
    2006-04
    Posts
    441
    Login to Give a bone
    0

    Default AutoLISP program that converts text height

    ; This autolisp program converts text height

    Code:
    (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 ]
    Attached Files Attached Files
    Last edited by Mike.Perry; 2007-01-09 at 09:25 AM. Reason: [CODE] tags added.

  2. #2
    I could stop if I wanted to kpblc2000's Avatar
    Join Date
    2006-09
    Posts
    212
    Login to Give a bone
    0

    Default Re: AutoLISP program that converts text height

    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

  3. #3
    I could stop if I wanted to
    Join Date
    2003-11
    Posts
    277
    Login to Give a bone
    0

    Default Re: AutoLISP program that converts text height

    Hi aaronic,
    This code not yet test,sorry
    Code:
    (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
    Quote Originally Posted by 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

  4. #4
    I could stop if I wanted to kpblc2000's Avatar
    Join Date
    2006-09
    Posts
    212
    Login to Give a bone
    0

    Default Re: AutoLISP program that converts text height

    another way (used activex functions):
    Code:
    (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

  5. #5
    I could stop if I wanted to
    Join Date
    2015-08
    Posts
    263
    Login to Give a bone
    0

    Default Re: AutoLISP program that converts text height

    Quote Originally Posted by aaronic_abacus
    ; 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

Similar Threads

  1. Repeating an autolisp program
    By pkreusch in forum AutoLISP
    Replies: 5
    Last Post: 2009-07-31, 06:11 PM
  2. Converts one or more lines of text to mtext
    By Sureshrrai in forum AutoCAD Tips & Tricks
    Replies: 7
    Last Post: 2008-10-13, 10:23 PM
  3. AutoLISP program to convert text styles
    By aaronic_abacus in forum AutoLISP
    Replies: 1
    Last Post: 2007-01-09, 08:51 AM
  4. The first autolisp program I wrote
    By aaronic_abacus in forum AutoLISP
    Replies: 0
    Last Post: 2007-01-03, 03:55 AM
  5. Changing text height and style in AutoLISP
    By ahipkin60511 in forum AutoLISP
    Replies: 7
    Last Post: 2004-07-19, 08:13 AM

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •