;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;幕匠LISP实验室;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;程序功能：图块替换   [备注：]
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun c:cb (/ cn oldb newb len se1 e0 e1 bn b0)
  (command "color" "")
  (setvar "unitmode" 0)
  (princ "\n选择块实体：")
  (setq        se1  (ssget '((0 . "INSERT")))
        oldb nil
        newb nil
  )
  (if se1
    (progn
      (setq bn (getstring "\n批量替换*/<新块名>（回车选取样块）："))
      (cond
        ((= bn "*")
         (setq oldb (strcase (getstring "\n旧块名："))
               newb (strcase (getstring "\n新块名："))
         )
        )
        ((= bn "")
         (setq b0 nil)
         (while        (not b0)
           (initget " ")
           (setq b0 (entsel "\n选取样块："))
           (cond
             ((= (type b0) 'STR) (setq b0 t))
             ((and
                (= (type b0) 'LIST)
                (/= (cdr (assoc 0 (setq b0 (entget (car b0))))) "INSERT")
              )
              (setq b0 nil)
             )
             (t (setq bn (cdr (assoc 2 b0))))
           )
         )
        )
        (t nil)
      )
      (setq len (sslength se1))
      (while (> len 0)
        (setq e0 (ssname se1 0)
              e1 (entget e0)
        )
        (if (and oldb newb)
          (if (= (strcase (cdr (assoc 2 e1))) oldb)
            (setq e1 (subst (cons 2 newb) (assoc 2 e1) e1))
          )
          (setq e1 (subst (cons 2 bn) (assoc 2 e1) e1))
        )
        (entmod e1)
        (entupd e0)
        (ssdel e0 se1)
        (if se1
          (setq len (sslength se1))
        )
      )
    )
  )
  (princ)
) 
