gilsoto13 Posted August 15, 2011 Share Posted August 15, 2011 (edited) 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 August 16, 2011 by gilsoto13 Quote Link to comment Share on other sites More sharing options...
gilsoto13 Posted August 16, 2011 Author Share Posted August 16, 2011 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) ) Quote Link to comment Share on other sites More sharing options...
gilsoto13 Posted August 16, 2011 Author Share Posted August 16, 2011 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) ) Quote Link to comment Share on other sites More sharing options...
pBe Posted August 16, 2011 Share Posted August 16, 2011 (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 Quote Link to comment Share on other sites More sharing options...
gilsoto13 Posted August 16, 2011 Author Share Posted August 16, 2011 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... Quote Link to comment Share on other sites More sharing options...
gilsoto13 Posted August 16, 2011 Author Share Posted August 16, 2011 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] Quote Link to comment Share on other sites More sharing options...
alanjt Posted August 16, 2011 Share Posted August 16, 2011 [THAT'S WHAT SHE SAID]it's so tiny[/THAT'S WHAT SHE SAID] Quote Link to comment Share on other sites More sharing options...
Recommended Posts
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.