polhub 发表于 2022-7-5 17:51:46

从一个块复制属性

我正在寻找一种方法，将属性从一个块复制到许多其他块，下面的内容非常接近，除了我需要选择几个目标块，而不是选择一个目标块。
 
感谢李·麦克：
 
(defun c:sla ( / myentsel des src val )
   (setq myentsel
       (lambda ( msg / ent enx )
         (while
               (progn (setvar 'errno 0) (setq ent (car (entsel msg)))
                   (cond
                     (   (= 7 (getvar 'errno))
                           (princ "\nMissed, try again.")
                     )
                     (   (null ent) nil)
                     (   (/= "INSERT" (cdr (assoc 0 (setq enx (entget ent)))))
                           (princ "\nSelected object is not a block.")
                     )
                     (   (/= 1 (cdr (assoc 66 enx)))
                           (princ "\nSelected block is not attributed.")
                     )
                   )
               )
         )
         (if ent (vlax-invoke (vlax-ename->vla-object ent) 'getattributes))
       )
   )
   (if (and (setq src (myentsel "\nSelect source block: "))
            (setq des (myentsel "\nSelect destination block: "))
            (setq src (mapcar '(lambda ( x ) (cons (vla-get-tagstring x) (vla-get-textstring x))) src))
       )
       (foreach att des
         (if (setq val (cdr (assoc (vla-get-tagstring att) src)))
               (vla-put-textstring att val)
         )
       )
   )
   (princ)
)
(vl-load-com) (princ)

David Bethel 发表于 2022-7-5 18:10:22

在普通AutoLisp中，可能：
 

;;;COPY ATTRIButes From Source To Targets Based on TAGNAMES
(defun c:atts2t (/ ss sn an ad sl i tn td tg)
(while (not sn)
      (and (princ "\nSelect SOURCE Insert")
             (setq ss (ssget '((0 . "INSERT")(66 . 1))))
             (= (sslength ss) 1)
             (setq sn (ssname ss 0)
                   an (entnext sn)
                   ad (entget an))))

(while (= "ATTRIB" (cdr (assoc 0 ad)))
      (setq sl (cons (cons (cdr (assoc 2 ad)) (cdr (assoc 1 ad))) sl)
            an (entnext an)
            ad (entget an)))

(and (princ "\nSelect TARGET Inserts")
      (setq ss (ssget '((0 . "INSERT")(66 . 1))))
      (setq i 0)
      (while (setq tn (ssname ss i))
             (if (not (eq tn sn))
               (progn
                   (setq td (entget tn)
                         an (entnext tn)
                         ad (entget an))
                   (princ (strcat "\n" (cdr (assoc 2 td))))
                   (while (= "ATTRIB" (cdr (assoc 0 ad)))
                        (setq tg (cdr (assoc 2 ad)))
                        (and (assoc tg sl)
                               (entmod (subst (cons 1 (cdr (assoc tg sl)))
                                              (assoc 1 ad) ad)))
                        (setq an (entnext an)
                              ad (entget an)))
                   (entupd tn)))
             (setq i (1+ i))))
(prin1))

 
-大卫

Lee Mac 发表于 2022-7-5 18:26:54

还有一个：
https://www.theswamp.org/index.php?topic=43082.msg483004#msg483004

polhub 发表于 2022-7-5 18:48:22

多亏了你们俩，他们都做了我需要的事。出于好奇，有什么方法可以自动化这个过程吗？我的意思是，如果我有一个具有特定名称的源块，比如具有名为ID的属性标记的设备和具有名为CONNECTION的属性标记的目标块，还有一个名为ID的属性标记，是否有一种方法，如果两个块接触，信息可以自动传输（当然，当lisp运行时）。

David Bethel 发表于 2022-7-5 19:06:15

不客气。
 
是的，你可以把它变成sinlge命令。这将是非常具体的项目，需要一个很好的错误捕捉和条件检查位-大卫
页: [1]
查看完整版本: 从一个块复制属性