用指定的块替换一个或者多个选择的块

Lisphk

(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.")))
    )
  )
)

yufeng37

正需要，支持楼主大人了！

kqqt6236

啥也不说了，感谢楼主分享哇！

结构攻城狮

木有反应呢

huangpc27

好像很不错的

yy1050503750

替换后比例不对