Jump to content

Replace only selected blocks with a different one


Recommended Posts

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...

Link to comment
Share on other sites

  • Replies 30
  • Created
  • Last Reply

Top Posters In This Topic

  • jukkoo

    5

  • SPACECADET

    5

  • Smirnoff

    4

  • EBROWN

    3

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

Link to comment
Share on other sites

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.

Link to comment
Share on other sites

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

Link to comment
Share on other sites

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...

Link to comment
Share on other sites

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.

Link to comment
Share on other sites

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...

Link to comment
Share on other sites

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

Link to comment
Share on other sites

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.

Link to comment
Share on other sites

You could of course do this without using extra Lisp:

 

  1. Select the blocks you want replaced (and one of the new blocks) & press Ctrl+X to cut them to clipboard.
  2. Start a new blank drawing and paste to original coordinates Alt+E+D (or Edit --> Paste to Original Coordinates)
  3. Use the express tools' BlockReplace (Express --> Blocks --> Replace block with another block).
  4. Choose / pick the old block's name, then the new block's name.
  5. Ctrl+X the blocks again.
  6. 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.

Link to comment
Share on other sites

  • 4 weeks later...
  • 2 years later...
  • 1 year later...
  • 3 months later...

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

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...