jukkoo Posted February 11, 2011 Share Posted February 11, 2011 Let's say I have 20 blocks named "george" in my dwg. Now, I would like to replace only 7 of them with the block "george2". Is there a simple way to do it just by selecting these 7 and replacing their definition without changing the other 13 "george" blocks? Thanks... Quote Link to comment Share on other sites More sharing options...
SPACECADET Posted February 11, 2011 Share Posted February 11, 2011 There is a lisp routine called something like rblock that will allow you to do just that. Quote Link to comment Share on other sites More sharing options...
Smirnoff Posted February 11, 2011 Share Posted February 11, 2011 First select all entities or blocks which you want to change, than pick to new entity or block (must be on screen). All selected items will be replaced. (defun c:mchange (/ ACTDOC COPOBJ ERRCOUNT EXTLST EXTSET FROMCEN LAYCOL MAXPT CURLAY MINPT OBJLAY OKCOUNT OLAYST SCLAY TOCEN TOOBJ VLAOBJ *ERROR* ) (vl-load-com) (defun *ERROR* (msg) (if olaySt (vla-put-Lock objLay olaySt) ); end if (vla-EndUndoMark actDoc) (princ) ); end of *ERROR* (defun GetBoundingCenter (vlaObj / blPt trPt cnPt) (vla-GetBoundingBox vlaObj 'minPt 'maxPt) (setq blPt (vlax-safearray->list minPt) trPt (vlax-safearray->list maxPt) cnPt (vlax-3D-point (list (+ (car blPt) (/ (- (car trPt) (car blPt)) 2)) (+ (cadr blPt) (/ (- (cadr trPt) (cadr blPt)) 2)) 0.0 ); end list ); end vlax-3D-point ); end setq ); end of GetBoundingCenter (if (not (setq extSet (ssget "_I"))) (progn (princ "\n<<< Select objects to replace >>> ") (setq extSet (ssget)) ); end progn ); end if (if (not extSet) (princ "\n<!> Replace objects isn't selected <!>") ); end if (if (and extSet (setq toObj (entsel "\nSelect new object -> ")) ); and and (progn (setq actDoc (vla-get-ActiveDocument (vlax-get-Acad-object) ) layCol (vla-get-Layers actDoc) extLst (mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar 'cadr (ssnamex extSet)) ) ) vlaObj (vlax-ename->vla-object (car toObj)) objLay (vla-Item layCol (vla-get-Layer vlaObj) ) olaySt (vla-get-Lock objLay) fromCen (GetBoundingCenter vlaObj) errCount 0 okCount 0 ); end setq (vla-StartUndoMark actDoc) (foreach obj extLst (setq toCen (GetBoundingCenter obj) scLay (vla-Item layCol (vla-get-Layer obj) ) );end setq (if (/= :vlax-true (vla-get-Lock scLay)) (progn (setq curLay (vla-get-Layer obj)) (vla-put-Lock objLay :vlax-false) (setq copObj (vla-copy vlaObj)) (vla-Move copObj fromCen toCen) (vla-put-Layer copObj curLay) (vla-put-Lock objLay olaySt) (vla-Delete obj) (setq okCount (1+ okCount)) ); end progn (setq errCount (1+ errCount)) ); end if ); end foreach (princ (strcat "\n" (itoa okCount) " were changed. " (if (/= 0 errCount) (strcat (itoa errCount) " were on locked layer! ") "" ); end if ); end strcat ); end princ (vla-EndUndoMark actDoc) ); end progn (princ "\n<!> New object isn't selected <!> ") ); end if (princ) ); end of c:mchange Quote Link to comment Share on other sites More sharing options...
SPACECADET Posted February 11, 2011 Share Posted February 11, 2011 Hi smirnoff. Do you think this lisp would deal with a question I have raised here> http://www.cadtutor.net/forum/showthread.php?56768-Replace-block-and-its-attributes-with-new-block-and-attributes I will test drive your code anyway on my problem. Any help greatly received. Have just test driven your code Smirnoff...on first attempt it seems to have solved my problem. Thank you. Quote Link to comment Share on other sites More sharing options...
jukkoo Posted February 11, 2011 Author Share Posted February 11, 2011 thanks, mate works great!! Quote Link to comment Share on other sites More sharing options...
jukkoo Posted February 11, 2011 Author Share Posted February 11, 2011 Actually, I encountered a problem... when replacing blocks with this lisp, the new blocks have all the same orientation, regardless of the orientation of the original block that has been replaced. Even the origin points are not respected ;( Therefore, it does not help me at all. I have about 100 windows in my floor plan, with 6 or 7 different orientations ( but all the same block). I need to change half of them to a different looking window... When I change them with this lisp, they do change, but are all in the wrong place and all of them rotated in the same way... So this lisp doesn't work for me after all ;( In Sketchup for example this thing can be done without problems Quote Link to comment Share on other sites More sharing options...
Ryder76 Posted February 11, 2011 Share Posted February 11, 2011 How about making 'george' a dynamic block with visibility states? That way you can select which 'style' of that block you want. Quote Link to comment Share on other sites More sharing options...
jukkoo Posted February 11, 2011 Author Share Posted February 11, 2011 not an option for me unfortunately, because when importing to sketchup (which I have to do) the dyn blocks disappear. Sketch up doesn't recognize them...I started replacing them one at a time... Quote Link to comment Share on other sites More sharing options...
SPACECADET Posted February 11, 2011 Share Posted February 11, 2011 Actually, I encountered a problem... when replacing blocks with this lisp, the new blocks have all the same orientation, regardless of the orientation of the original block that has been replaced. Even the origin points are not respected ;( yep I too have that problem...argh, so close. All i need now is a combination of this lisp that does what i want attribute wise and rblock that does what i want maintaining orientation/insert wise. back to the hunt. Quote Link to comment Share on other sites More sharing options...
Smirnoff Posted February 11, 2011 Share Posted February 11, 2011 Actually, I encountered a problem... when replacing blocks with this lisp, the new blocks have all the same orientation, regardless of the orientation of the original block that has been replaced. Even the origin points are not respected ;( I can fix this problem with additional option for ex. "Inherit block orientation? [Yes/No]:" But not today. Today is Friday, pool and beer with colleagues... Quote Link to comment Share on other sites More sharing options...
SPACECADET Posted February 11, 2011 Share Posted February 11, 2011 I hear that! Friday is for "a cold one" not a code one! orientation/insertion point option would rock. Virtual beer for you if you do. Quote Link to comment Share on other sites More sharing options...
Smirnoff Posted February 12, 2011 Share Posted February 12, 2011 I hope that this will satisfy you. There is options of inheritance layer, scale, rotation, and attributes with the same tags from old block. Options don't need to change every time, their value is stored after AutoCAD closing and will be the same in next session. (defun c:xch(/ iCnt bSet cFlg nBlc cVal pLst bNam aLst aDoc nBlc aSp cAt rLst) (vl-load-com) (defun Set_Initial_Setenv(varLst) (mapcar '(lambda(v)(if(not(getenv(car v)))(setenv(car v)(cadr v)))) varLst) ); end of Set_Initial_Setenv (defun Unblock_All_Layers(/ aDoc layCol actLay outLst) (setq aDoc(vla-get-ActiveDocument (vlax-get-acad-object)) layCol(vla-get-Layers aDoc) actLay(vla-get-ActiveLayer aDoc) ); end setq (vlax-map-collection layCol (function (lambda(x) (setq outLst (cons (list x (vla-get-Lock x) (vla-get-Freeze x) )outLst) ); end setq (vla-put-Lock x :vlax-false) (if(not(equal x actLay)) (vla-put-Freeze x :vlax-false) ); end if ); end lambda ); end function ); end vlax-map-collection outLst ); end of Unblock_All_Layers (defun Restore_All_Layer_States(Lst / actLay) (setq actLay(vla-get-ActiveLayer (vla-get-ActiveDocument (vlax-get-acad-object)))) (mapcar (function (lambda(x) (vla-put-Lock(car x)(cadr x)) (if(not(equal actLay(car x))) (vla-put-Freeze(car x)(last x)) ); end if ) ) Lst ) (princ) ); end of Restore_All_Layer_States (Set_Initial_Setenv '(("xchange:layer" "Yes")("xchange:scale" "Yes") ("xchange:rotation" "Yes")("xchange:attributes" "Yes"))) (princ "\n<<< Select blocks to replace >>> ") (if(setq bSet(ssget '((0 . "INSERT")))) (progn (while(not cFlg) (princ (strcat "\nOptions: Layer = "(getenv "xchange:layer") ", Scale = " (getenv "xchange:scale") ", Rotation = " (getenv "xchange:rotation") ", Attributes = " (getenv "xchange:attributes"))) (initget "Options") (setq nBlc(entsel "\nSelect new block or [Options] > ")) (cond ((and (= 'LIST(type nBlc)) (equal '(0 . "INSERT")(assoc 0(entget(car nBlc)))) ); end and (setq nBlc(vlax-ename->vla-object(car nBlc)) cFlg T); end setq ); end condition #1 ((= 'LIST(type nBlc)) (princ "\n<!> This isn't block <!> ") ); end condition #2 ((= "Options" nBlc) (initget "Yes No") (setq cVal(getkword(strcat "\nInherit old block layer [Yes/No] <" (getenv "xchange:layer")">: "))) (if(member cVal '("Yes" "No"))(setenv "xchange:layer" cVal)) (initget "Yes No") (setq cVal(getkword(strcat "\nInherit old block scale [Yes/No] <" (getenv "xchange:scale")">: "))) (if(member cVal '("Yes" "No"))(setenv "xchange:scale" cVal)) (initget "Yes No") (setq cVal(getkword(strcat "\nInherit old block rotation [Yes/No] <" (getenv "xchange:rotation")">: "))) (if(member cVal '("Yes" "No"))(setenv "xchange:rotation" cVal)) (initget "Yes No") (setq cVal(getkword(strcat "\nInherit attributes with similar tags [Yes/No] <" (getenv "xchange:attributes")">: "))) (if(member cVal '("Yes" "No"))(setenv "xchange:attributes" cVal)) ); end condition #3 ); end cond ); end while (setq aDoc(vla-get-ActiveDocument(vlax-get-acad-object)) bNam(vla-get-Name nBlc) aSp(vla-ObjectIdToObject aDoc(vla-get-OwnerId nBlc)) iCnt 0 ); end setq (vla-StartUndoMark aDoc) (setq rLst(Unblock_All_Layers)) (foreach b(mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar 'cadr(ssnamex bSet)))) (if(= :vlax-true(vla-get-HasAttributes b)) (setq aLst (mapcar '(lambda (a) (list (vla-get-TagString a) (vla-get-TextString a))) (vlax-safearray->list (vlax-variant-value (vla-GetAttributes b))))) ); end if (setq nBlc(vla-InsertBlock aSp (vla-get-InsertionPoint b)bNam 1.0 1.0 1.0 0.0)) (if(= "Yes"(getenv "xchange:layer")) (vla-put-Layer nBlc(vla-get-Layer b)) ); end if (if(= "Yes"(getenv "xchange:scale")) (progn (vla-put-XScaleFactor nBlc(vla-get-XScaleFactor b)) (vla-put-YScaleFactor nBlc(vla-get-YScaleFactor b)) (vla-put-ZScaleFactor nBlc(vla-get-ZScaleFactor b)) ); end progn ); end if (if(= "Yes"(getenv "xchange:rotation")) (vla-put-Rotation nBlc(vla-get-Rotation b)) ); end if (if (and (= "Yes"(getenv "xchange:attributes")) (= :vlax-true(vla-get-HasAttributes nBlc)) ); end and (foreach i(mapcar '(lambda (a)(list(vla-get-TagString a)a)) (vlax-safearray->list (vlax-variant-value(vla-GetAttributes nBlc)))) (if(setq cAt(assoc(car i)aLst)) (vla-put-TextString(last i)(last cAt)) ); end if ); end foreach ); end if (vla-Delete b) (setq iCnt(1+ iCnt)) ); end foreach (Restore_All_Layer_States rLst) (vla-EndUndoMark aDoc) (princ(strcat "\n" (itoa iCnt) " block(s) was replaced. ")) ); end progn (princ "\n<!> Nothing selected <!>" ) ); end if (princ) ); end of c:xch Quote Link to comment Share on other sites More sharing options...
jukkoo Posted February 16, 2011 Author Share Posted February 16, 2011 thanks, man. It works great. You are a genius Quote Link to comment Share on other sites More sharing options...
Smirnoff Posted February 16, 2011 Share Posted February 16, 2011 thanks, man. It works great. You are a genius Glad that this program will useful for you. I have one more idea about it, but now in in bisiness tirip in San Peterspburg (Russia). Do this when will be back. Bue. Quote Link to comment Share on other sites More sharing options...
SPACECADET Posted February 21, 2011 Share Posted February 21, 2011 This script also works great for me now. I Like the added options. Great work. Thank you. Quote Link to comment Share on other sites More sharing options...
irneb Posted February 22, 2011 Share Posted February 22, 2011 You could of course do this without using extra Lisp: Select the blocks you want replaced (and one of the new blocks) & press Ctrl+X to cut them to clipboard. Start a new blank drawing and paste to original coordinates Alt+E+D (or Edit --> Paste to Original Coordinates) Use the express tools' BlockReplace (Express --> Blocks --> Replace block with another block). Choose / pick the old block's name, then the new block's name. Ctrl+X the blocks again. Swap to the original DWG & Alt+E+D This should keep orientation, layer, properties, attributes, etc. Even attributes left as is (even if the new block doesn't have any attributes). If you want the Attributes to be changed as well, then use AttSync / BAttMan. Quote Link to comment Share on other sites More sharing options...
troggarf Posted March 21, 2011 Share Posted March 21, 2011 Smirnoff This routine rocks!!! Thanks for sharing Made my life a lot easier today ~Greg Quote Link to comment Share on other sites More sharing options...
Bobzy20 Posted August 6, 2013 Share Posted August 6, 2013 The normal routine is AutoCAD wouldn’t work correctly but this code sorted the problem straight away. Quote Link to comment Share on other sites More sharing options...
Least Posted December 5, 2014 Share Posted December 5, 2014 Thanks Smirnoff just what I was after. P Quote Link to comment Share on other sites More sharing options...
EBROWN Posted March 24, 2015 Share Posted March 24, 2015 I use this lisp (xch) all the time. It works great in 2d. Can someone enhance the code to include blocks that are in different USC. Thanks EBrown 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.