社区 › Auto Lisp › 块匹配/复制属性

sandman 发表于 2022-7-5 20:18:28

块匹配/复制属性

大家好，我是新手。
一直在尝试宏和LISP。主要通过谷歌搜索！
我一直坚持的一件事是，找不到类似的东西：
 
键入LISP命令，将所有属性从“REV”块复制到“REVHISTORY”块。（所有ATT标签都是相同的，只是名称）。
 
我见过他们，你选择一个源和目标块，但不是基于块名，这可以做到吗？
 
提前感谢

BIGAL 发表于 2022-7-5 20:44:34

2种方法首先使用标记获取块1属性写入块2属性，第二种方法更简单，如果块2是块1的副本，则在创建时，您可以使用VL获取“属性”，然后将每个属性放入另一个块中。
 
为了进一步解释，无论块外观如何，autocad都会按创建顺序保留块属性信息，以便（vlax ename->vla object（ssname SS1 0））'getattributes）检索它们。可以对任意两个块执行此操作，只要它们具有相同数量的属性。是，选择区块1选择区块2全部完成。
 
请张贴图纸

BIGAL 发表于 2022-7-5 20:59:13

看看这个，你需要在代码中向下滚动到我的代码部分http://www.cadtutor.net/forum/showthread.php?90519-用于从csv文件编译块属性的AutoLisp

Lee Mac 发表于 2022-7-5 21:16:11

以下假设活动布局中每个块只有一个参考，并且两个块都不是动态的：
(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)

BIGAL 发表于 2022-7-5 21:27:58

这里是从一个块到另一个块的副本，唯一的条件是，基于OP的原始语句，它们都具有相同数量的属性。第二个块与第一个块相同
 

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

查看完整版本: 块匹配/复制属性