Replace only selected blocks with a different one

March 25, 2015

Can someone enhance the code to include blocks that are in different USC.

Thanks

EBrown

March 25, 2015

Can someone enhance the code to include blocks that are in different USC.

You said that already.

October 21, 2015

Give this a try

NOT TESTED

(defun c:ReplaceBlockS () (c:RBS))
(defun c:RBS (/ answr ent idx new_block newname obj ss)
 (vl-load-com)
 (command ".undo" "be")
 ;;if the user selects something, inputs a ne block name AND it exists in the dwg...
 (if (and (setq ss (ssget ":S" '((0 . "INSERT"))))
   (setq new_block (entget (car (entsel "\nPick instance of new block: "))))
   (setq newname (cdr (assoc 2 new_block)))
   (tblobjname "BLOCK" newname)
   )
   (progn
     (setq idx -1)
     (while (setq ent (ssname ss (setq idx (1+ idx))))
(setq obj (vlax-ename->vla-object ent))
(vla-put-name obj newname);;change the name
(vla-update obj)
)
     )
   )
 (command ".undo" "end")
 (princ (strcat "\nReplaced " (itoa idx) " blocks......"))
 (princ)
 )

October 21, 2015

Thank you asos2000,

I'll test the code and let you know.

Many thanks,

Ebrown

August 19, 2016

Dear Smirnoff,

You rock. You are my hero today. Thank you for this routine. You have no idea how much time you just saved my project with 15000 address blocks needing to be replaced, but keep the layer, the rotation and the many attributes!

I'd buy you a drink if you lived in WA or OR...

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

December 30, 2016

tks you a lot.

March 8, 2017

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

Hello people and Smirnoff especially, I really hope you're still active here.

this LISP of yours has made my job a lot easier for a few drawings but I was wondering, is it possible for the LISP to also take note of the dynamic block states and apply them to the new block (scale, rotation, flip state)? The new block will have all the same parameters as the old one but it's just a little different.

Sorry for posting on an old post, if there is a newer one for this, please be so kind to leave a link and I will post there again or just transfer my post.

Thank you in advance,

BR,

March 8, 2017

YichGa: Smirnoff's last recorded visit here was 13-Feb-2013 or just a little over four years ago. I'm kind of doubting you will hear from back him.

March 8, 2017

YichGa: Smirnoff's last recorded visit here was 13-Feb-2013 or just a little over four years ago. I'm kind of doubting you will hear from back him.

Yeah, was affraid of that. Any suggestions for where to post the question? Maybe somebody else can help

March 8, 2017

Create a new thread in the.... AutoCAD Customization > AutoLISP.... forum.

March 9, 2017

Thank you ReMark

July 14

Smirnoff , please if you do not mind to help me adding some 3 options in this code :

1- Inherit old block flip
2- Inherit old block alignment
3- inherit new block attributes and attributes' value

On 2/12/2011 at 4:45 PM, Smirnoff said:

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

Sign In

Replace only selected blocks with a different one

Recommended Posts

EBROWN

Top Posters In This Topic

Popular Days

Top Posters In This Topic

Popular Days

RobDraw

asos2000

EBROWN

ORgrown

satashi0123

YichGa

ReMark

YichGa

ReMark

YichGa

thefisherman

Join the conversation

Tutorials

Forums

Activity