在t之间复制属性值

itacad · 发表于 2022-7-5 13:19:49

您好，我发现有很多lisp用于将属性从一个bloch复制到另一个bloch，但通常该操作应用于两个相等的块。
我有两组不同的块，结构相同：
-从第一系列块中，我需要带有标记SIGLA的属性（无论块的名称如何）
-从第二组块中，我需要具有标记名的属性（无论块的名称如何）
下一个描述适用于两个方向。
我想选择具有SIGLA标记属性的任何块，获取其值并将其复制到具有名称标记属性的任何块中，即使没有编译。
我只想点击方块。
你见过/开发过这样的东西吗？
提前感谢

Emmanuel Delay · 发表于 2022-7-5 13:32:40

如果属性可见，则该脚本会满足您的要求。例如，将每个名称属性设置为“”，这样你就可以选择它作为目标。（这对你来说可能不现实，不确定）

但我会看看是否能符合你的特定目的。

Emmanuel Delay · 发表于 2022-7-5 13:35:53

这应该行得通
命令TTCB，但请随意重命名此命令

copy


(vl-load-com)
;; To copy/paste from fixed attributes, source tag:  "SIGLA",  destination tag:  "NAME"
;; TTC Block
(defun c:ttcb ( / sText)
  (defun TCC_copyAttribute (source / blk )
    (if (setq blk (entsel "\nSelect source block: "))
          (setq sText (LM:vl-getattributevalue (vlax-ename->vla-object (car blk)) source))
        )
  )
  (defun TCC_pasteAttribute (dest / blk)
    (if (setq blk (entsel "\nSelect destination block: "))
          (LM:vl-setattributevalues (vlax-ename->vla-object (car blk)) (list (cons dest sText))  )
        )
  ) 
  
  (while (TCC_copyAttribute  "SIGLA")
    (TCC_pasteAttribute  "NAME")
  )
  
) 
;; Get Attribute Value  -  Lee Mac
;; Returns the value held by the specified tag within the supplied block, if present.
;; blk - [vla] VLA Block Reference Object
;; tag - [str] Attribute TagString
;; Returns: [str] Attribute value, else nil if tag is not found.
(defun LM:vl-getattributevalue ( blk tag )
    (setq tag (strcase tag))
    (vl-some '(lambda ( att ) (if (= tag (strcase (vla-get-tagstring att))) (vla-get-textstring att))) (vlax-invoke blk 'getattributes))
)
;; Set Attribute Values  -  Lee Mac
;; Sets attributes with tags found in the association list to their associated values.
;; blk - [vla] VLA Block Reference Object
;; lst - [lst] Association list of ((<tag> . <value>) ... )
;; Returns: nil
(defun LM:vl-setattributevalues ( blk lst / itm )
    (foreach att (vlax-invoke blk 'getattributes)
        (if (setq itm (assoc (vla-get-tagstring att) lst))
            (vla-put-textstring att (cdr itm))
        )
    )
)

BIGAL · 发表于 2022-7-5 13:44:58

这是一个开始，允许拾取直接返回标记名和块名的属性

copy


(setq ans  (entget (car (nentsel "pick block 1"))))
(setq tag1 (cdr (assoc 2 ans)))
(setq obj (vlax-ename->vla-object (cdr(assoc 330 ans))))
(setq blk1 (vla-get-EffectiveName obj))
(setq ans  (entget (car (nentsel "pick block 2"))))
(setq tag2 (assoc ans))
(setq obj (vlax-ename->vla-object (cdr(assoc 330 ans))))
(setq blk2 (vla-get-EffectiveName obj))

itacad · 发表于 2022-7-5 13:47:05

您好，Emmanuel Delay，不幸的是，lisp ttc在这种情况下不合适，因为准确地说，目标属性可能不可见或未编译（结果是，如果不是块，我就没有什么可点击的）

对于Bigal：在代码中没有指定属性的标记（SIGLA和NAME），为什么？

BIGAL · 发表于 2022-7-5 13:53:22

这就是代码的思想，使用nentsel返回属性标记名，我需要更改为“Pick block1 attribute”“Pick block 2 attribute”

那里

添加

copy


Code updated in prior post mistake fixed also

copy


(setq ans  (entget (car (nentsel "pick block 1 attribute"))))
(setq tag1 (cdr (assoc 2 ans)))
(setq obj (vlax-ename->vla-object (cdr(assoc 330 ans))))
(setq blk1 (vla-get-EffectiveName obj))
(setq ans  (entget (car (nentsel "pick block 2 attribute"))))
(setq tag2 (cdr (assoc 2 ans)))
(setq obj (vlax-ename->vla-object (cdr(assoc 330 ans))))
(setq blk2 (vla-get-EffectiveName obj))
(alert (strcat "You picked block1 \ntagname = " tag1 "\nName =" blk1 "\nYou picked block 2  \ntagname = " tag2 "\nName =" blk2 ))