Replace Selected Block Or Blocks With Another Block

[alanjt]

Do you have a similar routine that wors with attributes? I often have to change (blocks with attributes) parts of my drawing from proposed to existing. The blocks are the same except for color and font style. Thanks

So, you want to replace one attribute block with another and transfer attribute values from the original block to the replacement?

[Lee Mac]

Do you have a similar routine that wors with attributes? I often have to change (blocks with attributes) parts of my drawing from proposed to existing. The blocks are the same except for color and font style. Thanks

 

Rename block references to use new block definition; ATTSYNC to synchronise attributes (assuming attribute tags are identical).

 

Done!

[alanjt]

Rename block references to use new block definition; ATTSYNC to synchronise attributes (assuming attribute tags are identical).

 

Done!

 

And you are wanting to replace all instances of said block.

[Guest]

 

(defun c:BRE (/ *error* blk f ss temp)
 ;; Replace multiple instances of selected blocks (can be different) with selected block
 ;; Size and Rotation will be taken from original block and original will be deleted
 ;; Required subroutines: AT:GetSel
 ;; Alan J. Thompson, 02.09.10

 (vl-load-com)

 (defun *error* (msg)
   (and f *AcadDoc* (vla-endundomark *AcadDoc*))
   (if (and msg (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*QUIT*,")))
     (princ (strcat "\nError: " msg))
   )
 )

 (if
   (and
     (AT:GetSel
       entsel
       "\nSelect replacement block: "
       (lambda (x / e)
         (if
           (and
             (eq "INSERT" (cdr (assoc 0 (setq e (entget (car x))))))
             (/= 4 (logand (cdr (assoc 70 (tblsearch "BLOCK" (cdr (assoc 2 e))))) 4))
             (/= 4 (logand (cdr (assoc 70 (entget (tblobjname "LAYER" (cdr (assoc 8 e)))))) 4))
           )
            (setq blk (vlax-ename->vla-object (car x)))
         )
       )
     )
     (princ "\nSelect blocks to be repalced: ")
     (setq ss (ssget "_:L" '((0 . "INSERT"))))
   )
    (progn
      (setq f (not (vla-startundomark
                     (cond (*AcadDoc*)
                           ((setq *AcadDoc* (vla-get-activedocument (vlax-get-acad-object))))
                     )
                   )
              )
      )
      (vlax-for x (setq ss (vla-get-activeselectionset *AcadDoc*))
        (setq temp (vla-copy blk))
        (mapcar (function (lambda (p)
                            (vl-catch-all-apply
                              (function vlax-put-property)
                              (list temp p (vlax-get-property x p))
                            )
                          )
                )
                '(Insertionpoint Rotation XEffectiveScaleFactor YEffectiveScaleFactor
                  ZEffectiveScaleFactor
                 )
        )
        (vla-delete x)
      )
      (vla-delete ss)
      (*error* nil)
    )
 )
 (princ)
)

(defun AT:GetSel (meth msg fnc / ent good)
 ;; meth - selection method (entsel, nentsel, nentselp)
 ;; msg - message to display (nil for default)
 ;; fnc - optional function to apply to selected object
 ;; Ex: (AT:GetSel entsel "\nSelect arc: " (lambda (x) (eq (cdr (assoc 0 (entget (car x)))) "ARC")))
 ;; Alan J. Thompson, 05.25.10
 (setvar 'errno 0)
 (while (not good)
   (setq ent (meth (cond (msg)
                         ("\nSelect object: ")
                   )
             )
   )
   (cond
     ((vl-consp ent)
      (setq good (cond ((or (not fnc) (fnc ent)) ent)
                       ((prompt "\nInvalid object!"))
                 )
      )
     )
     ((eq (type ent) 'STR) (setq good ent))
     ((setq good (eq 52 (getvar 'errno))) nil)
     ((eq 7 (getvar 'errno)) (setq good (prompt "\nMissed, try again.")))
   )
 )
)

 

Nice work alanjt . Can you update your code to replace selected instances of a block (or blocks) with another block, sync attributes.

[VIGNESH]

i need to replace one block with another block with same coordinates. pls. somebody give LISP program. If i run that program, without opening any of drawings, in the drawing directory it should replace all blocks with what i have selected and should replace all blocks. it will be agreat help for me

[allent392]

Continue to read the thread and you will find a lisp routine that works great.. The command prompt is BRE...

[allent392]

The BRE routine has saved me hours of work!!! Thank You!

[supaman]

"Error: no function definition: VLAX-ENAME->VLA-OBJECT"

Hi, I got this error when use it like justtindm. Previous time it still work ok but I don't know today I got this error.

Does it work correctly with att block?

(defun c:BRE (/ *error* blk f ss temp)
 ;; Replace multiple instances of selected blocks (can be different) with selected block
 ;; Size and Rotation will be taken from original block and original will be deleted
 ;; Required subroutines: AT:GetSel
 ;; Alan J. Thompson, 02.09.10

 (vl-load-com)

 (defun *error* (msg)
   (and f *AcadDoc* (vla-endundomark *AcadDoc*))
   (if (and msg (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*QUIT*,")))
     (princ (strcat "\nError: " msg))
   )
 )

 (if
   (and
     (AT:GetSel
       entsel
       "\nSelect replacement block: "
       (lambda (x / e)
         (if
           (and
             (eq "INSERT" (cdr (assoc 0 (setq e (entget (car x))))))
             (/= 4 (logand (cdr (assoc 70 (tblsearch "BLOCK" (cdr (assoc 2 e))))) 4))
             (/= 4 (logand (cdr (assoc 70 (entget (tblobjname "LAYER" (cdr (assoc 8 e)))))) 4))
           )
            (setq blk (vlax-ename->vla-object (car x)))
         )
       )
     )
     (princ "\nSelect blocks to be repalced: ")
     (setq ss (ssget "_:L" '((0 . "INSERT"))))
   )
    (progn
      (setq f (not (vla-startundomark
                     (cond (*AcadDoc*)
                           ((setq *AcadDoc* (vla-get-activedocument (vlax-get-acad-object))))
                     )
                   )
              )
      )
      (vlax-for x (setq ss (vla-get-activeselectionset *AcadDoc*))
        (setq temp (vla-copy blk))
        (mapcar (function (lambda (p)
                            (vl-catch-all-apply
                              (function vlax-put-property)
                              (list temp p (vlax-get-property x p))
                            )
                          )
                )
                '(Insertionpoint Rotation XEffectiveScaleFactor YEffectiveScaleFactor
                  ZEffectiveScaleFactor
                 )
        )
        (vla-delete x)
      )
      (vla-delete ss)
      (*error* nil)
    )
 )
 (princ)
)

(defun AT:GetSel (meth msg fnc / ent good)
 ;; meth - selection method (entsel, nentsel, nentselp)
 ;; msg - message to display (nil for default)
 ;; fnc - optional function to apply to selected object
 ;; Ex: (AT:GetSel entsel "\nSelect arc: " (lambda (x) (eq (cdr (assoc 0 (entget (car x)))) "ARC")))
 ;; Alan J. Thompson, 05.25.10
 (setvar 'errno 0)
 (while (not good)
   (setq ent (meth (cond (msg)
                         ("\nSelect object: ")
                   )
             )
   )
   (cond
     ((vl-consp ent)
      (setq good (cond ((or (not fnc) (fnc ent)) ent)
                       ((prompt "\nInvalid object!"))
                 )
      )
     )
     ((eq (type ent) 'STR) (setq good ent))
     ((setq good (eq 52 (getvar 'errno))) nil)
     ((eq 7 (getvar 'errno)) (setq good (prompt "\nMissed, try again.")))
   )
 )
)

[supaman]

Hi, I reset the computer then it work well again. thank you, it's very cool

The problem may be cause when I load many lisp and it conflict with each other.

[alanjt]

If the code is already posted in the thread, please don't post it again. If I ever update the code, an older version will still reside in a post I cannot edit.

 

Glad you got it working. Add (vl-load-com) before or after the code. I have that in my startup file, so I have a tendency to forget to add it to commands. Apologies.

[mauione]

I have been looking and have not yet found what I am looking for. I have blocks that come from MicroStation into ACAD. When they come to ACAD, they have the same name, however they also have a sequential suffix.

(I.E. MH1, MH2,...) I have found a lisp that will allow me to replace all "MH#" with MH, but only one type at a time. (MH#; then run the lisp again and do LP#, etc...).

What I am getting at I would like to eventually have one lisp that will basically be, if (XXX## equal true, then replace with XXX) and do this for each type block type. I have no problem adding to a routine or building it. I really do not know where to get started.

Thank you for your time and patience in this.

rblk.lsp is what I have found for one by one- just a step above REPLACEBLOCK command.

rblk.lsp

[BlackBox]

I have been looking and have not yet found what I am looking for. I have blocks that come from MicroStation into ACAD. When they come to ACAD, they have the same name, however they also have a sequential suffix.

(I.E. MH1, MH2,...) I have found a lisp that will allow me to replace all "MH#" with MH, but only one type at a time. (MH#; then run the lisp again and do LP#, etc...).

What I am getting at I would like to eventually have one lisp that will basically be, if (XXX## equal true, then replace with XXX) and do this for each type block type. I have no problem adding to a routine or building it. I really do not know where to get started.

Thank you for your time and patience in this.

rblk.lsp is what I have found for one by one- just a step above REPLACEBLOCK command.

 

Welcome to CADTutor.

 

I don't have time to read the earlier pages of this thread, which may already have an answer for you, but this recent thread may be of use:

 

http://forums.augi.com/showthread.php?160855-Change-a-Block-to-another-Block

 

 

 

Cheers

[cad tutor]

hi friend,

How can i convert layer in multiple blocks to layer "0".

Thanks!

[Lee Mac]

hi friend,

How can i convert layer in multiple blocks to layer "0".

Thanks!

 

Try the example program from my Apply to Block Objects function.

[iconeo]

Thanks Alan.

[bhOOVER84]

Hey Guys,

 

I'm very new to CAD but I am a really fast learner as I am sure many of you are. I have added this LSP into our cad and it has worked magically; however, I am having an issue for some unknown reason and I was hoping someone could point out to me what the issue may be.

 

I am designing a lighting blueprint for an engineering firm. We have several blocks for 2x4 normal, emergency lights and all other various sizes. I have had the BRE command work perfectly for our 1/2x4 blocks which has saved me a lot of time of deleting and replacing the block.

 

When I attempt to use the BRE command on the 2x4 blocks, the end result deletes the block "TO BE" replaced. Is there an issue with my blocks?

 

Here are some of the troubleshooting I have already attempted.

- I have created now blocks, saved with new names and replaced ALL blocks on the model with the new named block. Same result.

- I have edited the blocks and changed the current layer for each item within the block. Same result.

 

Any ideas?

Also, not sure if this matters. I am currently working on AutoCad 2017

 

Thanks for any attempts to assist.

Bryan

[Roy_043]

Blocks are indeed deleted as part of the replacement process. Without an example dwg I can only guess that the blocks are mismatched in terms of scale or insertion point. Try zooming to extents after using the code.

[mruu]

Is there a line in this code that can be changed ever so slightly so that each replaced block might be able to keep their old attributes??

[3dwannab]

On 10/9/2019 at 2:58 AM, mruu said:

Is there a line in this code that can be changed ever so slightly so that each replaced block might be able to keep their old attributes??

 

Bit late to the party  but try this.

 

See the header for changes I've made.

 

(vl-load-com)

;;
;; Replace multiple instances of selected blocks (can be different) with selected block
;; Size and Rotation will be taken from original block and original will be deleted
;; Required subroutines: AT:GetSel
;; Alan J. Thompson, 2010.09.02
;; Found at: http://www.cadtutor.net/forum/showthread.php?48458-Replace-Selected-Block-Or-Blocks-With-Another-Block
;;
;; EDIT by 3dwannab, 2018.04.09 - Added redraw to old block selection, Error handling for redraw and sssetfirst newly created blocks.
;; EDIT by 3dwannab, 2024.08.15 - Removed original selection from the new selection set and output block name to commandline.
;; EDIT by 3dwannab, 2024.11.28 - Give the user the ability to replace the same blocks by name as the ones selected. Option Yes/No.
;;                              - Option to choose whether you want to match properties or not. Option Yes/No.
;;                              - Added undo handling.
;;                              - Changed the redraw to a regen to correctly display the new selection of blocks.
;;
;; TO DO LIST
;; N/A
;;

(defun c:BKReplace (/ *error* acDoc ansMatchProps ansReplaceAll blkNew blkNewObj def e f lst ssReplaced ssSel ssVla var_cmdecho var_osmode var_selectsimilarmode) 

  (defun *error* (errmsg) 
    (and acDoc (vla-EndUndoMark acDoc))
    (and errmsg 
         (not (wcmatch (strcase errmsg) "*CANCEL*,*EXIT*"))
         (princ (strcat "\n<< Error: " errmsg " >>\n"))
    )
    (command "_.regen")
    (setvar 'cmdecho var_cmdecho)
    (setvar 'osmode var_osmode)
    (setvar 'selectsimilarmode var_selectsimilarmode)
  )

  ;; Start the undo mark here
  (setq acDoc (vla-get-ActiveDocument (vlax-get-acad-object)))
  (or (vla-EndUndoMark acDoc) (vla-StartUndoMark acDoc))

  ;; Get any system variables here
  (setq var_cmdecho (getvar "cmdecho"))
  (setq var_osmode (getvar "osmode"))
  (setq var_selectsimilarmode (getvar 'selectsimilarmode))
  (setvar 'cmdecho 0)
  (setvar 'osmode 0)

  (if 
    (and 
      (AT:GetSel 
        entsel
        "\nSelect NEW block: "
        (lambda (blkOriginal / e) 
          (if 
            (and 
              (eq "INSERT" (cdr (assoc 0 (setq e (entget (car blkOriginal))))))
              (/= 4 (logand (cdr (assoc 70 (tblsearch "BLOCK" (cdr (assoc 2 e))))) 4))
              (/= 4 (logand (cdr (assoc 70 (entget (tblobjname "LAYER" (cdr (assoc 8 e)))))) 4))
            )
            (setq blkNewObj (vlax-ename->vla-object (car blkOriginal)))
          )
        )
      )
      (not (redraw (vlax-vla-object->ename blkNewObj) 3))
    )

    (progn 

      ;; initget from LeeMac help pages
      (initget "No Yes")
      (setq ansReplaceAll (cond 
                            ((getkword 
                               (strcat "\nReplace all the same blocks as the one you select now ? [Yes/No] <" 
                                       (setq ansReplaceAll (cond (ansReplaceAll) ("Yes")))
                                       ">: "
                               )
                             )
                            )
                            (ansReplaceAll)
                          )
      )

      ;; If No to replace blocks only replace the selection
      (if (= ansReplaceAll "No") 
        (progn 
          (princ "\nSelect OLD blocks to be replaced: ")
          (setq ssReplaced (ssget "_:L" '((0 . "INSERT"))))
        )
        ;; If yes, replace the same blocks as the one you select
        (progn 

          ; Code by Lee Mac http://www.cadtutor.net/forum/showthread.php?92638-Simple-fix-%28LISP-noob%29-Syntax-problem&p=633824&viewfull=1#post633824
          ;; Iterate over the block table and compile a list of xref blocks to exclude
          (while (setq def (tblnext "block" (not def))) 
            (if (= 4 (logand 4 (cdr (assoc 70 def)))) 
              (setq lst (vl-list* "," (cdr (assoc 2 def)) lst))
            )
          )

          ;; Attempt to retrieve a selection of blocks (but not xrefs)
          (setq ssReplaced (ssget (cons '(0 . "INSERT") (if lst (vl-list* '(-4 . "<NOT") (cons 2 (apply 'strcat (cdr lst))) '((-4 . "NOT>")))))))

          ;; Set selectsimilarmode to use the name of an object.
          (setvar 'selectsimilarmode 128)

          ;; If ss1 one is valid then do this
          (if ssReplaced 
            (progn 
              (vl-cmdf "_.selectsimilar" ssReplaced "")
              (setq ssReplaced nil) ;; Reset the selection set
              (setq ssReplaced (ssget)) ;; Create a new selection set for to zoom and reselect as the zoom objects will do this
            )
            (princ "\n: ------------------------------\n\t\t*** Nothing selected ***\n: ------------------------------\n")
          )
        )
      )

      (setq f (not 
                (vla-startundomark 
                  (cond 
                    (acDoc)
                    ((setq acDoc (vla-get-activedocument (vlax-get-acad-object))))
                  )
                )
              )
      )

      ;; initget from LeeMac help pages
      (initget "No Yes")
      (setq ansMatchProps (cond 
                            ((getkword 
                               (strcat "\nMatch these properties? Insertionpoint, Rotation, XEffectiveScaleFactor, YEffectiveScaleFactor & ZEffectiveScaleFactor\nNo only matches the Insertion Point and Rotation[Yes/No] <" 
                                       (setq ansMatchProps (cond (ansMatchProps) ("Yes")))
                                       ">: "
                               )
                             )
                            )
                            (ansMatchProps)
                          )
      )

      ; Set ssSel to a null selection set:
      (setq ssSel (ssadd))

      (vlax-for blkOriginal (setq ssVla (vla-get-activeselectionset acDoc)) 

        ;; Check if old block is not part of the new selection
        (if (not (equal (vlax-vla-object->ename blkNewObj) (vlax-vla-object->ename blkOriginal))) 

          (progn 

            (setq blkNew (vla-copy blkNewObj))

            (cond 
              ((= "Yes" ansMatchProps)

               (mapcar 
                 (function 
                   (lambda (p) 
                     (vl-catch-all-apply 
                       (function vlax-put-property)
                       (list blkNew p (vlax-get-property blkOriginal p))
                     )
                   )
                 )
                 '(Insertionpoint Rotation XEffectiveScaleFactor YEffectiveScaleFactor ZEffectiveScaleFactor)
               )
              )
              ((= "No" ansMatchProps)
               ;; Only match the insertion point
               (mapcar 
                 (function 
                   (lambda (p) 
                     (vl-catch-all-apply 
                       (function vlax-put-property)
                       (list blkNew p (vlax-get-property blkOriginal p))
                     )
                   )
                 )
                 '(Insertionpoint Rotation)
               )
              )
            )

            ; The following command adds the blkNew entity to the selection set referenced by ss2:
            (ssadd (vlax-vla-object->ename blkNew) ssSel)

            (vla-delete blkOriginal)
          )
        )
      )

      ; Select ssSel
      (sssetfirst nil ssSel)

      (redraw (vlax-vla-object->ename blkNewObj) 4)

      (vla-delete ssVla)

      (princ (strcat "\n'" (vla-get-effectivename blkNewObj) "' has replaced " (itoa (sslength ssReplaced)) (if (> (sslength ssReplaced) 1) " blocks" " block")))
    )
  )

  (vla-EndUndoMark acDoc)

  (*error* nil)
  (princ)
)

(defun AT:GetSel (meth msg fnc / ent good) 
  ;; meth - selection method (entsel, nentsel, nentselp)
  ;; msg - message to display (nil for default)
  ;; fnc - optional function to apply to selected object
  ;; Ex: (AT:GetSel entsel "\nSelect arc: " (lambda (blkOriginal) (eq (cdr (assoc 0 (entget (car blkOriginal)))) "ARC")))
  ;; Alan J. Thompson, 05.25.10
  (setvar 'errno 0)
  (while (not good) 
    (setq ent (meth 
                (cond 
                  (msg)
                  ("\nSelect OLD blocks to be replaced: ")
                )
              )
    )
    (cond 
      ((vl-consp ent)
       (setq good (cond 
                    ((or (not fnc) (fnc ent)) ent)
                    ((prompt "\nInvalid object!"))
                  )
       )
      )
      ((eq (type ent) 'STR) (setq good ent))
      ((setq good (eq 52 (getvar 'errno))) nil)
      ((eq 7 (getvar 'errno)) (setq good (prompt "\nMissed, try again.")))
    )
  )
)

(princ "\nBK_Replace.lsp loaded...")
(princ)

; (c:BKReplace) ;; Unblock for testing