1 (defun c:BRE (/ *error* blk f ss temp)
   2 ;; Replace multiple instances of selected blocks (can be different) with selected block
   3 ;; Size and Rotation will be taken from original block and original will be deleted
   4 ;; Required subroutines: AT:GetSel
   5 ;; Alan J. Thompson, 02.09.10
   6 ;; Found at: http://www.cadtutor.net/forum/showthread.php?48458-Replace-Selected-Block-Or-Blocks-With-Another-Block
   7 (vl-load-com)
   8 (defun *error* (msg)
   9 (and f *AcadDoc* (vla-endundomark *AcadDoc*))
  10 (if (and msg (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*QUIT*,")))
  11 (princ (strcat "\nError: " msg))
  12 )
  13 )
  14 (if
  15 (and
  16 (AT:GetSel
  17 entsel
  18 "\nSelect replacement block: "
  19 (lambda (x / e)
  20 (if
  21 (and
  22 (eq "INSERT" (cdr (assoc 0 (setq e (entget (car x))))))
  23 (/= 4 (logand (cdr (assoc 70 (tblsearch "BLOCK" (cdr (assoc 2 e))))) 4))
  24 (/= 4 (logand (cdr (assoc 70 (entget (tblobjname "LAYER" (cdr (assoc 8 e)))))) 4))
  25 )
  26 (setq blk (vlax-ename->vla-object (car x)))
  27 )
  28 )
  29 )
  30 (princ "\nSelect blocks to be repalced: ")
  31 (setq ss (ssget "_:L" '((0 . "INSERT"))))
  32 )
  33 (progn
  34 (setq f (not (vla-startundomark
  35 (cond (*AcadDoc*)
  36 ((setq *AcadDoc* (vla-get-activedocument (vlax-get-acad-object))))
  37 )
  38 )
  39 )
  40 )
  41 (vlax-for x (setq ss (vla-get-activeselectionset *AcadDoc*))
  42 (setq temp (vla-copy blk))
  43 (mapcar (function (lambda (p)
  44 (vl-catch-all-apply
  45 (function vlax-put-property)
  46 (list temp p (vlax-get-property x p))
  47 )
  48 )
  49 )
  50 '(Insertionpoint Rotation XEffectiveScaleFactor YEffectiveScaleFactor
  51 ZEffectiveScaleFactor
  52 )
  53 )
  54 (vla-delete x)
  55 )
  56 (vla-delete ss)
  57 (*error* nil)
  58 )
  59 )
  60 (princ)
  61 )
  62 (defun AT:GetSel (meth msg fnc / ent good)
  63 ;; meth - selection method (entsel, nentsel, nentselp)
  64 ;; msg - message to display (nil for default)
  65 ;; fnc - optional function to apply to selected object
  66 ;; Ex: (AT:GetSel entsel "\nSelect arc: " (lambda (x) (eq (cdr (assoc 0 (entget (car x)))) "ARC")))
  67 ;; Alan J. Thompson, 05.25.10
  68 (setvar 'errno 0)
  69 (while (not good)
  70 (setq ent (meth (cond (msg)
  71 ("\nSelect object: ")
  72 )
  73 )
  74 )
  75 (cond
  76 ((vl-consp ent)
  77 (setq good (cond ((or (not fnc) (fnc ent)) ent)
  78 ((prompt "\nInvalid object!"))
  79 )
  80 )
  81 )
  82 ((eq (type ent) 'STR) (setq good ent))
  83 ((setq good (eq 52 (getvar 'errno))) nil)
  84 ((eq 7 (getvar 'errno)) (setq good (prompt "\nMissed, try again.")))
  85 )
  86 )
  87 )