[编程交流] 块匹配/复制属性

(defun c:attcopy ( / a b e i l s v x )
   (if
       (setq s
           (ssget "_X"
               (list
                  '(0 . "INSERT")
                  '(66 . 1)
                  '(2 . "REV,REVHISTORY")
                   (cons 410 (getvar 'ctab))
               )
           )
       )
       (progn
           (setq i -1)
           (while (not (or (and a b) (not (setq e (ssname s (setq i (1+ i)))))))
               (set (if (= "REV" (cdr (assoc 2 (entget e)))) 'a 'b) e)
           )
           (if (and a b)
               (progn
                   (setq l
                       (mapcar '(lambda ( x ) (cons (vla-get-tagstring x) (vla-get-textstring x)))
                           (vlax-invoke (vlax-ename->vla-object a) 'getattributes)
                       )
                   )
                   (foreach x (vlax-invoke (vlax-ename->vla-object b) 'getattributes)
                       (if (setq v (cdr (assoc (vla-get-tagstring x) l)))
                           (vla-put-textstring x v)
                       )
                   )
               )
               (if a
                   (princ "\nREVHISTORY block not found in the current layout.")
                   (princ "\nREV block not found in the current layout.")
               )
           )
       )
       (princ "\nNeither REV nor REVHISTORY blocks found in the current layout.")
   )
   (princ)
)
(vl-load-com) (princ)

(setq sublst '())
(setq blk1 (car (entsel "\nPick block 1")))
(foreach att (vlax-invoke (vlax-ename->vla-object blk1) 'getattributes)
(setq sublst (cons (vla-get-textstring att ) sublst))
)
(setq sublst (reverse sublst))
(setq x -1)
(setq blk2 (car (entsel "\nPick block 2")))
(foreach att (vlax-invoke (vlax-ename->vla-object blk2) 'getattributes)
(setq x (+ x 1))
(vla-put-textstring att (nth x sublst))
)