Jump to content

Replacing a Font and width by another in the whole drawing lisp


gilsoto13

Recommended Posts

Hi, I've been out the forum for a long while, but I got a small new challenge for someone who thinks could have an easy way to solve it.

 

in the company I work for we have used the style simplex + width= 0.8 for decades, but now we have been using Revit, the standards management decided to change the simplex W=0.8 for Arial Narrow width=1.0 to match and ease the use of Revit and autocad at the same time.

 

So I am trying to just make an easy routine to be automatically loaded everytime you open an autocad dwg. to replace the old style by the new one (I can take care of the automatic load). It seemed to be very easy, by just resetting the style and a few lines (by Lee Mac) to change all text and mtext width to 1.0, but the only problem is that we also use the old font in our standard attributed blocks, and when the style is reseted the width remains 0.8 (due to the block definition, I'll take care of that), but I think it may be easy to add the function to find the style called "standard" in every attributed block in the whole drawing and modify their width factor to 1.

 

Who's got an idea of how to easily add this funtion?

 

;; this routine will change all standard text to Arial Narrow width = 1.0

(defun c:TW3 (/ i ss ent elst)
 
(command "_.-STYLE" "standard" "arialn.ttf" "0" "1" "0" "N" "N")
 (if (setq i -1 ss (ssget "_X" '((0 . "TEXT"))))
   (while (setq ent (ssname ss (setq i (1+ i))))
     (setq elst (entget ent))
     (entmod (subst (cons 41 1.0) (assoc 41 elst) elst))
     (entupd ent)))
;;

(defun smt2 ( / textos indice caso lent contenido inicio final subcadena) 
  (setq textos (ssget "_X" '((0 . "MTEXT")) ) 
       indice 0 
  ) 
  (while (setq caso (ssname textos indice)) 
     (setq lent (entget caso) 
          contenido (cdr (assoc 1 lent)) 
          indice (1+ indice) 
     ) 
     (while (and caso (setq inicio (vl-string-search "\\" contenido))) 
        (if (setq final (vl-string-position (ascii ";" ) contenido inicio)) 
            (setq  subcadena (substr contenido (1+ inicio) (1+ (- final inicio))) 
             contenido (vl-string-subst "" subcadena contenido)) 
         (setq caso nil) 
        ) 
     ) 
     (entmod (subst (cons 1 contenido) (assoc 1 lent) lent)) 
  ) 
) 
;;
(smt2)
;;
)

Edited by gilsoto13
Link to comment
Share on other sites

Ok, This is what i need, but I need to modify this code to Filter only attributes with the style called "standard", who can help with this last question?

 

 


;[url]http://forums.autodesk.com/t5/Visual-LISP-AutoLISP-and-General/Attribute-Width-Change/m-p/1525366/highlight/false[/url]





(defun c:test (/ ss i blk atts att )
(vl-load-com)
(if (setq ss (ssget 
"x" '((0 . "INSERT")(2 . "F*")(66 . 1))))
(progn
 (setq i 0 width 
1.0)
  (repeat (sslength ss)
   (setq blk (vlax-ename->vla-object 
(ssname ss i)))
   (if (safearray-value (setq atts (vlax-variant-value 
(vla-getattributes blk))))
    (progn
     (setq atts 
(vlax-safearray->list (vlax-variant-value (vla-getattributes blk))))
     
(foreach att atts
        (vla-put-scalefactor att width)
      ); 
foreach 
    ); progn
   ); if
   (setq i (+ i 1))
  ); 
repeat
); progn
); if
(princ)
)

Link to comment
Share on other sites

This one works for the same thing, but I cannot filter the selection of attributes to those with Style "standard" only... I think I am close but i just haven´t found the right way

 


;;; Changes the Width of all attributes within a block
(defun C:ChgAttWidth (/ ss sslen cnt blck ent entinfo)
 (setq ss (ssget "x" 
'((0 . "INSERT"))))
 (setq cnt 0)
 (setq sslen (sslength 
ss))
 (while (< cnt sslen)
   (setq blck (ssname 
ss cnt))
   (setq ent (entnext blck))
   
(setq entinfo (entget ent))
   
(while
     (and ent (= (cdr (assoc 0 entinfo)) 
"ATTRIB"))
      (entmod (subst (cons 41 1) 
(assoc 41 entinfo) entinfo))
      (entupd 
ent)
      (setq ent (entnext 
ent))
      (setq entinfo (entget 
ent))
   )
   (setq cnt (1+ 
cnt))
 )
 (princ)
)

Link to comment
Share on other sites

(defun C:ChgAttWidth  (/ ss sslen cnt blck ent entinfo)
     (setq ss (ssget "x"
                     '((0 . "INSERT")[color=blue](66 . 1)[/color])))
     (setq cnt 0)
     (setq sslen (sslength
                       ss))
     (while (< cnt sslen)
           (setq blck (ssname
                            ss
                            cnt))
           (setq ent (entnext blck))
           (setq entinfo (entget ent))
           (while
                 (and ent
                      (= (cdr (assoc 0 entinfo))
                         "ATTRIB"))
                 [color=blue] (if (eq (strcase (cdr (assoc 7 entinfo))) "STANDARD")[/color]
[color=blue]                         (progn[/color]
[color=blue]                     (entmod (subst (cons 41 1)[/color]
[color=blue]                                    (assoc 41 entinfo)[/color]
[color=blue]                                    entinfo))[/color]
[color=blue]                      (entupd[/color]
[color=blue]                            ent))[/color]
[color=blue]                         )[/color]
                      (setq ent (entnext
                                      ent))
                      (setq entinfo
                                 (entget
                                       ent))
                      )
           (setq cnt (1+
                           cnt))
           )
     (princ)
     )

 

 

That way if the text style is "Standard" it will process the entity otherwise it will go to the next one. I added (66 . 1) there to ensure you are only selecting blocks with attributes.

 

Hope this helps

Link to comment
Share on other sites

Great!!

 

I am not able to do that much code by my self.... maybe i'll never be...

 

anyway... thanks a lot. The routine works perfect now... it will save lots of time to many people as always...

Link to comment
Share on other sites

I can´t upload the final version properly.... let see if now

[/size]
[size=1];; this routine will change all standard text and attributes from style Simplex Width 0.8 to Arial Narrow width 1.0

(defun c:an (/ i ss ent elst)
 
(command "_.-STYLE" "standard" "arialn.ttf" "0" "1" "0" "N" "N")[/size]
[size=1]  (if (setq i -1 ss (ssget "_X" '((0 . "TEXT"))))
   (while (setq ent (ssname ss (setq i (1+ i))))
     (setq elst (entget ent))[/size]
[size=1]      (entmod (subst (cons 41 1.0) (assoc 41 elst) elst))
     (entupd ent)))[/size]
[size=1];;[/size]
[size=1]
(defun smt2 ( / textos indice caso lent contenido inicio final subcadena) 
  (setq textos (ssget "_X" '((0 . "MTEXT")) ) 
       indice 0 
  ) 
  (while (setq caso (ssname textos indice)) 
     (setq lent (entget caso) 
          contenido (cdr (assoc 1 lent)) 
          indice (1+ indice) 
     ) 
     (while (and caso (setq inicio (vl-string-search "\\" contenido))) 
        (if (setq final (vl-string-position (ascii ";" ) contenido inicio)) 
            (setq  subcadena (substr contenido (1+ inicio) (1+ (- final inicio))) 
             contenido (vl-string-subst "" subcadena contenido)) 
         (setq caso nil) 
        ) 
     ) 
     (entmod (subst (cons 1 contenido) (assoc 1 lent) lent)) 
  ) 
) 

;;
;;Thanks to 'pbejse' from autodesk Discussion groups
;;http://forums.autodesk.com/t5/Visual-LISP-AutoLISP-and-General/Attribute-Width-Change/m-p/3125032#M298532
;;
(defun at4  (/ ss sslen cnt blck ent entinfo)
     (setq ss (ssget "x"
                     '((0 . "INSERT")(66 . 1))))
     (setq cnt 0)
     (setq sslen (sslength
                       ss))
     (while (< cnt sslen)
           (setq blck (ssname
                            ss
                            cnt))
           (setq ent (entnext blck))
           (setq entinfo (entget ent))
           (while
                 (and ent
                      (= (cdr (assoc 0 entinfo))
                         "ATTRIB"))
                  (if (eq (strcase (cdr (assoc 7 entinfo))) "STANDARD")
                        (progn
                    (entmod (subst (cons 41 1)
                                   (assoc 41 entinfo)
                                   entinfo))
                     (entupd
                           ent))
                        )
                      (setq ent (entnext
                                      ent))
                      (setq entinfo
                                 (entget
                                       ent))
                      )
           (setq cnt (1+
                           cnt))
           )
     (princ)
     )
;;

(smt2)
(at4)
)
;;
[/size] 
[size=1]
Link to comment
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
×
  • Create New...