ReplaceBlock.lsp

;;; BlockSwap replaces selected blocks.
;;; by John Uhden (updated 03-09-17)
;;;
(defun c:ReplaceBlock ( / *error* vars ok name1 obj1 name2 obj2 opt ss)
  (vl-load-com)
  (defun *error* (err)
    (mapcar '(lambda (x)(setvar (car x)(cdr x))) vars)
    (vla-endundomark *doc*)
    (cond
      ((not err))
      ((wcmatch (strcase err) "*CANCEL*,*QUIT*"))
      (1  (princ (strcat "\nERROR: " err)))
    )
    (princ)
  )
  (or *acad* (setq *acad* (vlax-get-acad-object)))
  (or *doc* (setq *doc* (vla-get-ActiveDocument *acad*)))
  (vla-endundomark *doc*)
  (vla-startundomark *doc*)
  (setq vars (mapcar '(lambda (x)(cons x (getvar x))) '("cmdecho")))
  (mapcar '(lambda (x)(setvar (car x) 0))  vars)
  (command "_.expert" (getvar "expert")) ;; dummy command
  (while (not ok)
    (setq obj1 (vlax-ename->vla-object (car (entsel "\nPick old block: "))))
    (princ (strcat "  Old block name = \"" (setq name1 (vla-get-name obj1)) "\""))
    (setq  obj2 (vlax-ename->vla-object (car (entsel "\nPick new block: "))))
    (princ (strcat "  New block name = \"" (setq name2 (vla-get-name obj2)) "\""))
    (if (= name1 name2)
      (prompt "\nSame old and new blocks selected.")
      (setq ok 1)
    )
  )
  (initget "Replaceall Select")
  (setq opt (getkword
        "\nEnter an option [Select/Replaceall] <Replaceall> ... "
      )
      opt (if opt opt "Replaceall")
  )
  (cond 
    ((= opt "Select")
      (prompt "\nSelect blocks to be replaced...  ")
      (setq ss (ssget (list (cons 0 "INSERT") (cons 2 name1))))
    )
    ((= opt "Replaceall")
      (setq ss (ssget "X" (list (cons 0 "INSERT") (cons 2 name1))))
    )
  )
  (repeat (setq i (sslength ss))
    (vla-put-name (vlax-ename->vla-object (ssname ss (setq i (1- i)))) name2)
  )
  (vla-regen (vla-get-activedocument (vlax-get-acad-object))
       acActiveViewport
  )
  (*error* nil)
)
(defun c:BS ()(c:ReplaceBlock))