论坛 › A/VLISP › 拷贝属性从一个块到另一个块

Lisphk 发表于 2017-2-5 00:10:52

拷贝属性从一个块到另一个块

(defun c:MAV (/ AT:GetSel atts ss i ass)
;; Match Attribute Values
;; Alan J. Thompson, 2017.01.31

(if
    (and
      (AT:GetSel
        entsel
        "\nSelect source attributed block: "
        (lambda        (x / d)
          (if
          (and (eq (cdr (assoc 0 (setq d (entget (car x))))) "INSERT")
               (eq (cdr (assoc 66 d)) 1)
          ) ;_ end of and
             (setq
             atts (mapcar (function (lambda (a)
                                        (cons (vla-get-tagstring a)
                                              (vla-get-textstring a)
                                        ) ;_ end of cons
                                      ) ;_ end of lambda
                          ) ;_ end of function
                          (vlax-invoke
                              (vlax-ename->vla-object (car x))
                              'GetAttributes
                          ) ;_ end of vlax-invoke
                  ) ;_ end of mapcar
             ) ;_ end of setq
          ) ;_ end of if
        ) ;_ end of lambda
      ) ;_ end of AT:GetSel
      (progn
        (princ "\nSelect destination attributed block(s): ")
        (setq ss (ssget "_:L" '((0 . "INSERT") (66 . 1))))
      ) ;_ end of progn
    ) ;_ end of and
   (repeat (setq i (sslength ss))
       (foreach        a (vlax-invoke
                  (vlax-ename->vla-object (ssname ss (setq i (1- i))))
                  'GetAttributes
                  ) ;_ end of vlax-invoke
       (if (setq ass (cdr (assoc (vla-get-tagstring a) atts)))
           (vla-put-textstring a ass)
       ) ;_ end of if
       ) ;_ end of foreach
   ) ;_ end of repeat
) ;_ end of if
(princ)
) ;_ end of defun
(vl-load-com)
(princ)



函数 AT:GetSel
**** Hidden Message *****

yoyoho 发表于 2017-2-5 08:04:52

正需要，支持Lisphk楼主大人!!!!!

dnbcgrass 发表于 2017-2-5 10:30:48

回复学习学习！

HLCAD 发表于 2017-2-5 10:41:21

实用功能，谢谢分享程序！

向嘟嘟 发表于 2017-2-5 11:07:23

谢谢分享。。。。。。。

q3_2006 发表于 2017-2-5 13:48:08

过年都没歇着哈...

杨帆 发表于 2017-2-9 13:20:56

学习了。。。。。

sachindkini 发表于 2017-2-9 15:16:17

Learning .....

cnfswg001 发表于 2017-3-21 02:12:14

“我来测试一下，行不行”

defun 发表于 2017-5-15 14:39:53

谢谢分享。。。。。。。

xiaominghua174 发表于 2017-5-17 15:36:48

需要学习 看看

819534890 发表于 2017-5-17 15:53:05

回复学习学习

関吣 发表于 2017-5-23 16:33:15

看看能不能适合我用咯，谢谢开源

q2284555 发表于 2017-5-26 15:56:43

很好用啊啊1

qianzj 发表于 2017-5-27 14:32:28

挺好用的一个功能                  

查看完整版本: 拷贝属性从一个块到另一个块