list to globally change text height & width factor

Hi, is anybody who has the lisp routine that can globally change the height & width factor of text, mtext and attrbiutes in a block:(. Your help is much appreciated.

Thanks,

courage dog

This is a crude way to change it in both the block definition, and in the existing Inserts.

Be careful with pre-formatted MText though.

(defun c:Redefine_Block_Text (/ *error* itemp GetName ENT OBJ UFLAG)
 (vl-load-com)
 ;; Lee Mac  ~  11.03.10

 (defun *error* (msg)
   (and uFlag (vla-EndUndoMark *doc))
   (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
       (princ (strcat "\n** Error: " msg " **")))
   (princ))

 (defun itemp (collection item / result)
   (if (not (vl-catch-all-error-p
              (setq result (vl-catch-all-apply (function vla-item)
                             (list collection item)))))
       result))
 
 (setq *doc (cond (*doc) ((vla-get-ActiveDocument
                            (vlax-get-acad-object)))))

 (setq GetName (lambda (obj) (if (vlax-property-available-p obj 'EffectiveName)
                               (vla-get-EffectiveName obj)
                               (vla-get-Name obj))))

 (or *hdef* (setq *hdef* 1.0))
 (or *twid* (setq *twid* 1.0))

 (while
   (progn
     (setq ent (car (entsel "\nSelect Block to Change: ")))

     (cond (  (eq 'ENAME (type ent))

              (if (eq "AcDbBlockReference"
                      (vla-get-Objectname
                        (setq obj (vlax-ename->vla-object ent))))
                (progn
                  (setq uFlag (not (vla-StartUndoMark *doc)))

                  (initget 6)
                  (setq *hdef* (cond ((getdist "\nSpecify New Text Height: "))   (*hdef*)))
                  
                  (initget 6)
                  (setq *twid* (cond ((getdist "\nSpecify Text Width Factor: ")) (*twid*)))

                  (if (ssget "_X" (list (cons 0 "INSERT") (cons 2 (GetName obj)) (cons 66 1)))
                    (progn
                      (vlax-for sObj (setq ss (vla-get-ActiveSelectionSet *doc))
                        
                        (foreach att (append (vlax-invoke sObj 'GetAttributes)
                                             (vlax-invoke sObj 'GetConstantAttributes))

                          (vla-put-Height att *hdef*)

                          (if (eq :vlax-false (vla-get-MTextAttribute att))
                            (vla-put-ScaleFactor att *twid*)
                            (vla-put-TextString att (strcat "{\\W" (vl-princ-to-string *twid*) ";"
                                                            (vla-get-TextString att) "}")))))
                      (vla-delete ss)))

                  (vlax-for sub (itemp (vla-get-Blocks *doc) (GetName obj))

                    (cond (  (vl-position (vla-get-ObjectName sub) '("AcDbText" "AcDbAttributeDefinition"))

                             (vla-put-Height sub *hdef*)
                             (vla-put-ScaleFactor sub *twid*))

                          (  (eq "AcDbMText" (vla-get-ObjectName sub))

                             (vla-put-Height sub *hdef*)
                             (vla-put-TextString sub (strcat "{\\W" (vl-princ-to-string *twid*) ";"
                                                             (vla-get-TextString sub) "}")))))

                  (setq uFlag (vla-EndUndomark *doc))
                  (vla-Regen *doc AcActiveViewport))

                (princ "\n** Object Must be a Block **"))))))
 (princ))      

This is a crude way to change it in both the block definition, and in the existing Inserts.

 

Be careful with pre-formatted MText though.

 

(defun c:Redefine_Block_Text (/ *error* itemp GetName ENT OBJ UFLAG)
 (vl-load-com)
 ;; Lee Mac  ~  11.03.10

 (defun *error* (msg)
   (and uFlag (vla-EndUndoMark *doc))
   (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
       (princ (strcat "\n** Error: " msg " **")))
   (princ))

 (defun itemp (collection item / result)
   (if (not (vl-catch-all-error-p
              (setq result (vl-catch-all-apply (function vla-item)
                             (list collection item)))))
       result))

 (setq *doc (cond (*doc) ((vla-get-ActiveDocument
                            (vlax-get-acad-object)))))

 (setq GetName (lambda (obj) (if (vlax-property-available-p obj 'EffectiveName)
                               (vla-get-EffectiveName obj)
                               (vla-get-Name obj))))

 (or *hdef* (setq *hdef* 1.0))
 (or *twid* (setq *twid* 1.0))

 (while
   (progn
     (setq ent (car (entsel "\nSelect Block to Change: ")))

     (cond (  (eq 'ENAME (type ent))

              (if (eq "AcDbBlockReference"
                      (vla-get-Objectname
                        (setq obj (vlax-ename->vla-object ent))))
                (progn
                  (setq uFlag (not (vla-StartUndoMark *doc)))

                  (initget 6)
                  (setq *hdef* (cond ((getdist "\nSpecify New Text Height: "))   (*hdef*)))

                  (initget 6)
                  (setq *twid* (cond ((getdist "\nSpecify Text Width Factor: ")) (*twid*)))

                  (if (ssget "_X" (list (cons 0 "INSERT") (cons 2 (GetName obj)) (cons 66 1)))
                    (progn
                      (vlax-for sObj (setq ss (vla-get-ActiveSelectionSet *doc))

                        (foreach att (append (vlax-invoke sObj 'GetAttributes)
                                             (vlax-invoke sObj 'GetConstantAttributes))

                          (vla-put-Height att *hdef*)

                          (if (eq :vlax-false (vla-get-MTextAttribute att))
                            (vla-put-ScaleFactor att *twid*)
                            (vla-put-TextString att (strcat "{\\W" (vl-princ-to-string *twid*) ";"
                                                            (vla-get-TextString att) "}")))))
                      (vla-delete ss)))

                  (vlax-for sub (itemp (vla-get-Blocks *doc) (GetName obj))

                    (cond (  (vl-position (vla-get-ObjectName sub) '("AcDbText" "AcDbAttributeDefinition"))

                             (vla-put-Height sub *hdef*)
                             (vla-put-ScaleFactor sub *twid*))

                          (  (eq "AcDbMText" (vla-get-ObjectName sub))

                             (vla-put-Height sub *hdef*)
                             (vla-put-TextString sub (strcat "{\\W" (vl-princ-to-string *twid*) ";"
                                                             (vla-get-TextString sub) "}")))))

                  (setq uFlag (vla-EndUndomark *doc))
                  (vla-Regen *doc AcActiveViewport))

                (princ "\n** Object Must be a Block **"))))))
 (princ))      

Untested yet... but it's gotta be another great routine... how could you do it so fast?

I can´t imagine your brain at the top... numbers and stuff floating all around... I am the autocad solution guy in my office, and I have used some of your lisps... I must consider start paying for it

But well, I haven´t even created my paypal account yet... I think I'll pay when I decide to start with paypal....

Untested yet... but it's gotta be another great routine... how could you do it so fast?

 

I can´t imagine your brain at the top... numbers and stuff floating all around... I am the autocad solution guy in my office, and I have used some of your lisps... I must consider start paying for it

 

But well, I haven´t even created my paypal account yet... I think I'll pay when I decide to start with paypal....

Its just as fast as I can type... I know exactly the process that I want to use, and what to use etc. I use some code blocks, like the error handler, to save typing it over and over... but really its just practice.

There's no request for payment for my LISPs... I write them for enjoyment (as do most of the members on here), but of course, we all glady welcome donations

... I must consider start paying for it

 

But well, I haven´t even created my paypal account yet... I think I'll pay when I decide to start with paypal....

Donate to the forum. Without it, none of this would be possible.

Hello Lee Mac,

is it possible to make this work for a selected amount of blocks ? If yes, that would great, cause it´s what I´m searching for a long time !

Thanks

geonor

I haven't looked at it in a while, but I understand that the current code will alter all references of the selected block - would you be looking to select multiple distinct blocks?

Thanks for your reply.

The problem is, that the data has be exported from a GIS into DXF. The name of the blocks are based on the class of objects in GIS and the unique handle of the object. What means, there are blocks all of the same kind (e.g. sewer manhole) but with different blocknames. It´s like having 1000 copies (each with different block/reference-names) of the same reference. For all of those I would like to change the width/height of all included text. So what I´ve been seaching for was a procedure, that´s allowing to modify all text in a block for a number of selected blocks.

Hi, try this:

(defun c:RedefineBlockText ( / *error* doc blocks GetName ss undo )
 (vl-load-com)
 ;; © Lee Mac 2010

 (defun *error* ( msg )
   (and undo (vla-EndUndoMark doc))
   (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
       (princ (strcat "\n** Error: " msg " **")))
   (princ)
 )

 (setq doc    (vla-get-ActiveDocument (vlax-get-acad-object))
       blocks (vla-get-Blocks doc))

 (setq GetName
   (lambda ( obj )
     (if (vlax-property-available-p obj 'EffectiveName)
       (vla-get-EffectiveName obj)
       (vla-get-Name obj)
     )
   )
 )

 (mapcar '(lambda ( sym val ) (or (boundp sym) (set sym val))) '(*hdef* *twid*) '(1. 1.))

 (if (setq ss (ssget "_:L" '((0 . "INSERT"))))
   (
     (lambda ( i / e o n done atts sub )
       (initget 6)
       (setq *hdef* (cond ( (getdist "\nSpecify New Text Height: "  ) ) ( *hdef* )))
       
       (initget 6)
       (setq *twid* (cond ( (getdist "\nSpecify Text Width Factor: ") ) ( *twid* )))
       
       (setq undo (not (vla-StartUndoMark doc)))
       
       (while (setq e (ssname ss (setq i (1+ i))))
         (setq o (vlax-ename->vla-object e))

         (if (not (vl-position (setq n (GetName o)) done))
           (progn

             (if (setq atts (ssget "_X" (list (cons 0 "INSERT") (cons 2 n) (cons 66 1))))
               (
                 (lambda ( j / f p att )
                   
                   (while (setq f (ssname atts (setq j (1+ j))))
                     (setq p (vlax-ename->vla-object f))

                     (foreach att (append (vlax-invoke p 'GetAttributes)
                                          (vlax-invoke p 'GetConstantAttributes))
                       
                       (vla-put-Height att *hdef*)

                       (if (eq :vlax-false (vla-get-MTextAttribute att))
                         (vla-put-ScaleFactor att *twid*)
                         (vla-put-TextString att
                           (strcat "{\\W" (vl-princ-to-string *twid*) ";" (vla-get-TextString att) "}")
                         )
                       )
                     )
                   )
                 )
                 -1
               )
             )

             (vlax-for sub (LM:Itemp Blocks n)

               (cond
                 ( (vl-position (vla-get-ObjectName sub) '("AcDbText" "AcDbAttributeDefinition"))
                  
                   (vla-put-Height sub *hdef*)
                   (vla-put-ScaleFactor sub *twid*)
                 )
                 ( (eq "AcDbMText" (vla-get-ObjectName sub))
                  
                   (vla-put-Height sub *hdef*)
                   (vla-put-TextString sub
                     (strcat "{\\W" (vl-princ-to-string *twid*) ";" (vla-get-TextString sub) "}")
                   )
                 )
               )
             )
             (setq done (cons n done))
           )
         )
       )

       (setq undo (vla-EndUndoMark doc))
       (vla-Regen doc AcActiveViewport)
     )
     -1
   )
 )

 (princ)
)

;;-----------------------=={ Itemp }==------------------------;;
;;                                                            ;;
;;  Retrieves the item with index 'item' if present in the    ;;
;;  specified collection, else nil                            ;;
;;------------------------------------------------------------;;
;;  Author: Lee McDonnell, 2010                               ;;
;;                                                            ;;
;;  Copyright © 2010 by Lee McDonnell, All Rights Reserved.   ;;
;;  Contact: Lee Mac @ TheSwamp.org, CADTutor.net             ;;
;;------------------------------------------------------------;;
;;  Arguments:                                                ;;
;;  coll - the VLA Collection Object                          ;;
;;  item - the index of the item to be retrieved              ;;
;;------------------------------------------------------------;;
;;  Returns:  the VLA Object at the specified index, else nil ;;
;;------------------------------------------------------------;;

(defun LM:Itemp ( coll item )
 ;; © Lee Mac 2010
 (if
   (not
     (vl-catch-all-error-p
       (setq item
         (vl-catch-all-apply
           (function vla-item) (list coll item)
         )
       )
     )
   )
   item
 )
)

Tested and enjoyed,

the routine works great and is doing the job perfectly.

Magnificent, thanks a lot...

Tested and enjoyed,

the routine works great and is doing the job perfectly.

Magnificent, thanks a lot...

You're very welcome