Jump to content

Replace only selected blocks with a different one


Recommended Posts

  • Replies 30
  • Created
  • Last Reply

Top Posters In This Topic

  • jukkoo

    5

  • SPACECADET

    5

  • Smirnoff

    4

  • EBROWN

    3

  • 6 months later...

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

Link to comment
Share on other sites

  • 9 months later...

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

Link to comment
Share on other sites

  • 4 months later...
  • 2 months later...
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.:unsure:

 

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,

Link to comment
Share on other sites

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.

Link to comment
Share on other sites

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

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