论坛 › A/VLISP › 用指定的块替换一个或者多个选择的块

Lisphk 发表于 2016-12-16 20:05:14

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

(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 发表于 2016-12-19 09:12:53

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

kqqt6236 发表于 2017-2-28 00:04:54

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

结构攻城狮 发表于 2020-8-4 11:45:50

木有反应呢{:1_2:}

huangpc27 发表于 2020-8-7 16:00:46

好像很不错的

yy1050503750 发表于 2023-4-20 16:32:33

替换后比例不对

happyending 发表于 7 天前

不错，感谢您的分享。

查看完整版本: 用指定的块替换一个或者多个选择的块