iTijn Posted April 26, 2007 Share Posted April 26, 2007 Can someone set me of in the right direction? I'm trying to make a button to change the layer of the attribute in a block reference. I can do it manually with eattedit but this command doesn't allow the <_-command> format. Any suggestions how to approach this? Quote Link to comment Share on other sites More sharing options...
kpblc Posted April 26, 2007 Share Posted April 26, 2007 You can do it by lisp. But there is one more qestion exist - do you want to change block definition or block references? Or both of them? In case of your answer the solving will be different. Quote Link to comment Share on other sites More sharing options...
lpseifert Posted April 26, 2007 Share Posted April 26, 2007 Try -attedit instead. Quote Link to comment Share on other sites More sharing options...
ASMI Posted April 26, 2007 Share Posted April 26, 2007 It's imposible to change attribute layer with (command. Try something like this: (defun c:atlay(/ curAtt samObj wLay) (vl-load-com) (setq curAtt T) (if (setq samObj (entsel "\nPick object to select layer > ")) (progn (setq wLay(cdr(assoc 8(entget(car samObj))))) (princ (strcat "\nYou select layer: " wLay)) (while curAtt (setq curAtt (nentsel "\nPick Attribute ot Right Click to quit > ")) (if curAtt (progn (setq curAtt(vlax-ename->vla-object(car curAtt))) (if (= "AcDbAttribute"(vla-get-ObjectName curAtt)) (if (vl-catch-all-error-p (vl-catch-all-apply 'vla-put-Layer(list curAtt wLay))) (princ "\nCan't change layer. Attribute on locked layer! ") ); end if (princ "\nThis isn't attribute reference! ") ); end if ); end progn ); end if ); end while ); end progn ); end if (princ) ); end of c:atlay Multiple changing also possible, but need to add several lines of code. Quote Link to comment Share on other sites More sharing options...
ASMI Posted April 26, 2007 Share Posted April 26, 2007 Look at http://www.cadtutor.net/forum/showthread.php?t=13270 ***** editing ***** The link above doesn't work any more -the target thread is moved right here. Fuccaro Quote Link to comment Share on other sites More sharing options...
VVA Posted April 26, 2007 Share Posted April 26, 2007 (defun mydcl (zagl info-list / fl ret dcl_id) (vl-load-com) (if (null zagl) (setq zagl "Select") ) ;_ end of if (setq fl (vl-filename-mktemp "mip" nil ".dcl")) (setq ret (open fl "w")) (mapcar '(lambda (x) (write-line x ret)) (list "mip_msg : dialog { " (strcat "label=\"" zagl "\";") " :list_box {" "alignment=top ;" "width=51 ;" (if (> (length info-list) 26) "height= 26 ;" (strcat "height= " (itoa (+ 3 (length info-list))) ";") ) ;_ end of if "is_tab_stop = false ;" "key = \"info\";}" "ok_cancel;}" ) ;_ end of list ) ;_ end of mapcar (setq ret (close ret)) (if (setq dcl_id (load_dialog fl)) (if (new_dialog "mip_msg" dcl_id) (progn (start_list "info") (mapcar 'add_list info-list) (end_list) (set_tile "info" "0") (setq ret (car info-list)) (action_tile "info" "(setq ret (nth (atoi $value) info-list))") (action_tile "cancel" "(progn(setq ret nil)(done_dialog 0))") (action_tile "accept" "(done_dialog 1)") (start_dialog) ) ;_ end of progn ) ;_ end of if ) ;_ end of if (unload_dialog dcl_id) (vl-file-delete fl) ret ) ;;;================================================================================ ;;;Written By Michael Puckett. ;;;(setq all_layers (tablelist "LAYER")) (defun tablelist (s / d r) (while (setq d (tblnext s (null d))) (setq r (cons (cdr (assoc 2 d)) r)) ) ) (defun C:CHATTLAY ( / *error* lay att ed blk blkdef doc) (vl-load-com) (setq doc (vla-get-activedocument(vlax-get-acad-object))) (if (setq lay (mydcl "Select layer" (acad_strlsort (tablelist "LAYER")))) (progn (while (setq att (nentselp "\nSelect attribute <exit>:")) (if (= (cdr(assoc 0 (setq ed (entget(setq att(car att)))))) "ATTRIB") (progn (setq att (vlax-ename->vla-object att)) (setq blk (vla-objectidtoobject doc (vla-get-ownerid att))) (setq blkdef (vla-item (vla-get-blocks doc)(vla-get-name blk))) (vlax-for itm blkdef (if (and (= (vla-get-objectname itm) "AcDbAttributeDefinition") (= (strcase(vla-get-tagstring itm))(strcase(vla-get-tagstring att)))) (progn (vla-put-layer itm lay) (vla-put-layer att lay) ) ) ) (vla-update blk) ) ) ) ) ) (princ) ) (princ "\nType CHATTLAY to run") Quote Link to comment Share on other sites More sharing options...
iTijn Posted April 26, 2007 Author Share Posted April 26, 2007 Wow! Thank you every body. KPBLC: The block definition should remain the same. It's just the block reference of which I want to change one attribute to a visible or frozen layer. LPSeifert: My excuses for posting the same question on differtent forum groups. I'm not used to forums responding this quickly!!! Won't happen again. ASMI adn VVA. Thank you for the code! That's more than I ever wished! I will get on with it.! Quote Link to comment Share on other sites More sharing options...
fuccaro Posted April 26, 2007 Share Posted April 26, 2007 LPSeifert: My excuses for posting the same question on differtent forum groups. I'm not used to forums responding this quickly!!!Won't happen again. That's good! I moved here all the posts about this subject -for your and for our convenience. Quote Link to comment Share on other sites More sharing options...
iTijn Posted April 30, 2007 Author Share Posted April 30, 2007 The ActiveX code is new to me. I have started to read into it (good stuff), but can't find what I need. Both of the routines assume that I can select the attribute entity directly with nentsel or nentselp, but in this case I can't because the attribute might be on a frozen layer. I assume I have to select the complete block with entsel and than find the nested attribute within that block by attribute name. Say curBlk would be the the VLAOBJECT block How do I than select a Attribute with the name “CONTYPE” within that block. See properties of the block below. LOG # # # PINAL 1D9 :vlax-true :vlax-false # Millimeters 1.0 # :vlax-false PIN_OFF ByLayer 1.0 -1 ByLayer PINAL # 2130429704 AcDbBlockReference 2130414840 ByLayer Quote Link to comment Share on other sites More sharing options...
ASMI Posted May 1, 2007 Share Posted May 1, 2007 Hi iTijn. Do some actions in command line. Select block and get its vla-object: (setq curBlk(vlax-ename->vla-object(car(entsel)))) Select object: #<VLA-OBJECT IAcadBlockReference 08ad94a4> Then get full dump list of properties and methods (in your dump list is only properties because missed T argument in vlax-dump-object function. Command: (vlax-dump-object curBlk T) ; IAcadBlockReference: AutoCAD Block Reference Interface ; Property values: ; Application (RO) = #<VLA-OBJECT IAcadApplication 00b9b5e4> ; Document (RO) = #<VLA-OBJECT IAcadDocument 01117f90> ; Handle (RO) = "EC" ; [color="#0000ff"] HasAttributes (RO) = -1[/color] ; HasExtensionDictionary (RO) = 0 ; Hyperlinks (RO) = #<VLA-OBJECT IAcadHyperlinks 08adae44> ; InsertionPoint = (0.0 0.0 0.0) ; Layer = "0" ; Linetype = "ByLayer" ; LinetypeScale = 1.0 ; Lineweight = -1 ; Name = "Test1" ; Normal = (0.0 0.0 1.0) ; ObjectID (RO) = 2130034592 ; ObjectName (RO) = "AcDbBlockReference" ; OwnerID (RO) = 2130033912 ; PlotStyleName = "ByLayer" ; Rotation = 0.0 ; TrueColor = #<VLA-OBJECT IAcadAcCmColor 08adaf10> ; Visible = -1 ; XScaleFactor = 1.0 ; YScaleFactor = 1.0 ; ZScaleFactor = 1.0 ; Methods supported: ; ArrayPolar (3) ; ArrayRectangular (6) ; Copy () ; Delete () ; Explode () ; [color="Blue"]GetAttributes ()[/color] ; GetBoundingBox (2) ; [color="#0000ff"]GetConstantAttributes ()[/color] ; GetExtensionDictionary () ; GetXData (3) ; Highlight (1) ; IntersectWith (2) ; Mirror (2) ; Mirror3D (3) ; Move (2) ; Rotate (2) ; Rotate3D (3) ; ScaleEntity (2) ; SetXData (2) ; TransformBy (1) ; Update () Now you can see GetAttributes and GetConstantAttributes methods. Extract attributes array: Command: (setq attArr(vla-GetAttributes curBlk)) #<variant 8201 ...> Now you have variant with safearray of attributes inside it. Get list of attributes: Command: (setq attLst(vlax-safearray->list(vlax-variant-value attArr))) (#<VLA-OBJECT IAcadAttributeReference 08ad6f64>) Now you have list of attributes (only one attribute in my block) and can use its methods and properties. Read this book http://discussion.autodesk.com/servlet/JiveServlet/download/126-452839-5076083-99652/VLisp%20Bible.pdf to get more information about ActiveX. Quote Link to comment Share on other sites More sharing options...
iTijn Posted May 1, 2007 Author Share Posted May 1, 2007 I am Happy now!! A world of possibilities has just opened! Thanks! I've got it working the way I want! Quote Link to comment Share on other sites More sharing options...
albert001 Posted January 21, 2009 Share Posted January 21, 2009 Thank-you VVA! I have been looking for a lisp routine like that for years! Quote Link to comment Share on other sites More sharing options...
CroIvo Posted March 28, 2011 Share Posted March 28, 2011 VVA, Thank you! It works great! Quote Link to comment Share on other sites More sharing options...
Cazza Posted September 4, 2012 Share Posted September 4, 2012 Thank you very much VVA, your a life saver. Is there a way to change this code to selecting a window rather than each attribute individually? Quote Link to comment Share on other sites More sharing options...
Dadgad Posted September 4, 2012 Share Posted September 4, 2012 You might try this from Lee Mac. http://www.lee-mac.com/resetxreflayers.html or maybe this http://www.lee-mac.com/macatt.html Thanks Lee! Quote Link to comment Share on other sites More sharing options...
Cazza Posted September 5, 2012 Share Posted September 5, 2012 Thanks for the reply Dadgad. This didn't seem to be what I was after though, it looks like this is more to do with changing the test itself rather than the colour that it is displayed in. The code from VVA works great but it only lets you select one attribute at a time rather than windowing the attributes that require changing. I'm sure that it is just a little change to the code but I am a begginner when it comes to LISP and don't know what I need to change to enable this. Quote Link to comment Share on other sites More sharing options...
Guest Posted May 26, 2014 Share Posted May 26, 2014 hi VVA nice job. Is it posible to add acommand to select window the blocks ? (defun mydcl (zagl info-list / fl ret dcl_id) (vl-load-com) (if (null zagl) (setq zagl "Select") ) ;_ end of if (setq fl (vl-filename-mktemp "mip" nil ".dcl")) (setq ret (open fl "w")) (mapcar '(lambda (x) (write-line x ret)) (list "mip_msg : dialog { " (strcat "label=\"" zagl "\";") " :list_box {" "alignment=top ;" "width=51 ;" (if (> (length info-list) 26) "height= 26 ;" (strcat "height= " (itoa (+ 3 (length info-list))) ";") ) ;_ end of if "is_tab_stop = false ;" "key = \"info\";}" "ok_cancel;}" ) ;_ end of list ) ;_ end of mapcar (setq ret (close ret)) (if (setq dcl_id (load_dialog fl)) (if (new_dialog "mip_msg" dcl_id) (progn (start_list "info") (mapcar 'add_list info-list) (end_list) (set_tile "info" "0") (setq ret (car info-list)) (action_tile "info" "(setq ret (nth (atoi $value) info-list))") (action_tile "cancel" "(progn(setq ret nil)(done_dialog 0))") (action_tile "accept" "(done_dialog 1)") (start_dialog) ) ;_ end of progn ) ;_ end of if ) ;_ end of if (unload_dialog dcl_id) (vl-file-delete fl) ret ) ;;;================================================================================ ;;;Written By Michael Puckett. ;;;(setq all_layers (tablelist "LAYER")) (defun tablelist (s / d r) (while (setq d (tblnext s (null d))) (setq r (cons (cdr (assoc 2 d)) r)) ) ) (defun C:CHATTLAY ( / *error* lay att ed blk blkdef doc) (vl-load-com) (setq doc (vla-get-activedocument(vlax-get-acad-object))) (if (setq lay (mydcl "Select layer" (acad_strlsort (tablelist "LAYER")))) (progn (while (setq att (nentselp "\nSelect attribute <exit>:")) (if (= (cdr(assoc 0 (setq ed (entget(setq att(car att)))))) "ATTRIB") (progn (setq att (vlax-ename->vla-object att)) (setq blk (vla-objectidtoobject doc (vla-get-ownerid att))) (setq blkdef (vla-item (vla-get-blocks doc)(vla-get-name blk))) (vlax-for itm blkdef (if (and (= (vla-get-objectname itm) "AcDbAttributeDefinition") (= (strcase(vla-get-tagstring itm))(strcase(vla-get-tagstring att)))) (progn (vla-put-layer itm lay) (vla-put-layer att lay) ) ) ) (vla-update blk) ) ) ) ) ) (princ) ) (princ "\nType CHATTLAY to run") Thanks 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.