属性块参数复制到另一个属性块

shujh1989

wharan 发表于 2023-10-9 19:30
我是这么做的：选定样板图框（图标）的共用属性，如：工程名称、项目编号、阶段、版本号、日期等，然后循环 ...

我是不想打字，所以写个东西直接复制。不怕麻烦的做法是选定所有属性图框，然后ctrl+1特性里统一打字修改，感觉跟你这个差不多。

飞雪神光

shujh1989 发表于 2023-10-9 17:45
是可以的。那要把第一个块的属性跟第二个块的每一个属性比较，标签一致的再替换，不一致的跳过。然后去掉 ...

根本不需要比较 也不用考虑跳过 也不需要去掉替换过的再做成列表和比较 直接去覆盖 而不是用被替换的去原数据里找  这样操作是反过来的

飞雪神光

就像这样 拾取一个原图块 批量覆盖有相同属性的属性块 不考虑数据是否对等

1. (defun c:tt(/ bj get-insert-tag&value lm-set-attribute obj ss ss-enlst sx sxlst ty)
   
2.         (defun get-insert-Tag&value (blk / lst)
   
3.                 (if (= (type blk) 'ENAME)
   
4.                         (if        (safearray-value(setq        lst (vlax-variant-value(vla-getattributes (vlax-ename->vla-object blk)))))
   
5.                                 (mapcar'(lambda (x)(cons (vla-get-tagstring x) (vla-get-textstring x)))(vlax-safearray->list lst))
   
6.                         )
   
7.                         nil
   
8.                 )
   
9.         )
   
10.         (defun lm-set-attribute(ty biaoji va / att_list)
    
11.                 (setq ty (if(=(type ty)'ename)(vlax-ename->vla-object ty)ty))
    
12.                 (setq att_list (vlax-safeArray->list (vlax-variant-value (vla-getattributes ty))))
    
13.                 (setq xx(vl-some'(lambda(a)(if(=(strcase(vla-get-TagString a))(strcase biaoji))a))att_list))
    
14.                 (if xx
    
15.                         (vla-put-textstring xx va)
    
16.                 )
    
17.                 (princ)
    
18.         )
    
19.         (setq
    
20.                 ty(car(entsel "\n原属性块:"))
    
21.                 obj(vlax-ename->vla-object ty)
    
22.         )
    
23.         (setq sxlst(get-insert-Tag&value ty))
    
24.         (princ"\n覆盖属性块：")
    
25.         (setq ss(ssget '((0 . "insert"))))
    
26.         (foreach ty (vl-remove-if-not '(lambda (x) (= (type x) 'ENAME)) (mapcar 'cadr (ssnamex ss)))
    
27.                 (foreach x sxlst
    
28.                         (setq
    
29.                                 bj(car x)
    
30.                                 sx(cdr x)
    
31.                         )
    
32.                         (lm-set-attribute ty bj sx)
    
33.                 )
    
34.         )
    
35.         (princ)
    
36. )

(defun c:tt(/ bj get-insert-tag&value lm-set-attribute obj ss ss-enlst sx sxlst ty)<br />         (defun get-insert-Tag&value (blk / lst)<br />                 (if (= (type blk) 'ENAME)<br />                         (if        (safearray-value(setq        lst (vlax-variant-value(vla-getattributes (vlax-ename->vla-object blk)))))<br />                                 (mapcar'(lambda (x)(cons (vla-get-tagstring x) (vla-get-textstring x)))(vlax-safearray->list lst))<br />                         )<br />                         nil<br />                 )<br />         )<br />         (defun lm-set-attribute(ty biaoji va / att_list)<br />                 (setq ty (if(=(type ty)'ename)(vlax-ename->vla-object ty)ty))<br />                 (setq att_list (vlax-safeArray->list (vlax-variant-value (vla-getattributes ty))))<br />                 (setq xx(vl-some'(lambda(a)(if(=(strcase(vla-get-TagString a))(strcase biaoji))a))att_list))<br />                 (if xx<br />                         (vla-put-textstring xx va)<br />                 )<br />                 (princ)<br />         )<br />         (setq <br />                 ty(car(entsel "\n原属性块:"))<br />                 obj(vlax-ename->vla-object ty)<br />         )<br />         (setq sxlst(get-insert-Tag&value ty))<br />         (princ"\n覆盖属性块：")<br />         (setq ss(ssget '((0 . "insert"))))<br />         (foreach ty (vl-remove-if-not '(lambda (x) (= (type x) 'ENAME)) (mapcar 'cadr (ssnamex ss)))<br />                 (foreach x sxlst<br />                         (setq <br />                                 bj(car x)<br />                                 sx(cdr x)<br />                         )<br />                         (lm-set-attribute ty bj sx)<br />                 )<br />         )<br />         (princ)<br /> )

shujh1989

飞雪神光 发表于 2023-10-10 13:07
就像这样 拾取一个原图块 批量覆盖有相同属性的属性块 不考虑数据是否对等

，大神厉害

llsheng_73

飞雪神光 发表于 2023-10-10 13:07
就像这样 拾取一个原图块 批量覆盖有相同属性的属性块 不考虑数据是否对等

块参照的属性是以数组形式出现的，也就是无法使用item,因此，不宜针对一个tag在它的所有属性里边查找

1. (defun getatts(blk);|获取块参照图元(对象)的属性参照,返回值((属性标记 属性值 属性对象)...)以便进一步修改指定标记的属性值|;
   
2.   (if(equal(VL-CATCH-ALL-APPLY(function vlax-get-property)(list(setq blk(if(=(type blk)'ename)(vlax-ename->vla-object blk)blk))'HasAttributes)):vlax-true)
   
3.     (mapcar(function(lambda(x)(list(strcase(vlax-get-property x'TagString))(vlax-get-property x'TextString)x)))
   
4.            (vlax-safearray->list(vlax-variant-value(vlax-invoke-method blk'GetAttributes))))))
   
5. (defun putatts(enblk lst / a);|enblk属性块图元或对象,lst((标记 值)(标记 值)(标记 值)...)|;
   
6.   (and(setq a(getatts enblk))
   
7.       (vl-some(function(lambda(x / b)(and(setq b(assoc(strcase(car x))a))(vlax-put-property(caddr b)'TextString(cadr x)))))lst)))

(defun getatts(blk);|获取块参照图元(对象)的属性参照,返回值((属性标记 属性值 属性对象)...)以便进一步修改指定标记的属性值|;<br />   (if(equal(VL-CATCH-ALL-APPLY(function vlax-get-property)(list(setq blk(if(=(type blk)'ename)(vlax-ename->vla-object blk)blk))'HasAttributes)):vlax-true)<br />     (mapcar(function(lambda(x)(list(strcase(vlax-get-property x'TagString))(vlax-get-property x'TextString)x)))<br />            (vlax-safearray->list(vlax-variant-value(vlax-invoke-method blk'GetAttributes))))))<br /> (defun putatts(enblk lst / a);|enblk属性块图元或对象,lst((标记 值)(标记 值)(标记 值)...)|;<br />   (and(setq a(getatts enblk))<br />       (vl-some(function(lambda(x / b)(and(setq b(assoc(strcase(car x))a))(vlax-put-property(caddr b)'TextString(cadr x)))))lst)))

lxl217114

飞雪神光 发表于 2023-10-10 12:48
根本不需要比较 也不用考虑跳过 也不需要去掉替换过的再做成列表和比较 直接去覆盖 而不是用被替换的去原 ...

A块和B块
标记名称相同的att属性定义
从A块提取标记的数据，赋予给B图块同名的标记。
这样的功能应该蛮实用的。

shujh1989

大神们的没弄懂，我自己修改了下。
(defun c:CCT ()
（vl-load-com）
  (setq sourceBlock (car (entsel "\n选择源图框: ")))
  (setq targetBlock (car (entsel "\n选择目标图框: ")))
  
  (if (and sourceBlock targetBlock)
    (progn
      (setq sourceAttributes (vlax-invoke (vlax-ename->vla-object sourceBlock) 'getattributes))
      (setq targetAttributes (vlax-invoke (vlax-ename->vla-object targetBlock) 'getattributes))
      
      (foreach sourceAttribute sourceAttributes
        (setq sourceTag (vla-get-TagString sourceAttribute))
        (setq sourceValue (vla-get-textstring sourceAttribute))
        
        (foreach targetAttribute targetAttributes
          (setq targetTag (vla-get-TagString targetAttribute))
         
          (if (equal sourceTag targetTag)
            (vla-put-textstring targetAttribute sourceValue)
          )
        )
      )
      
      (princ "\n图框信息替换完成。")
    )
    (princ "\n未选择有效的图框。")
  )
  
  (princ)
)

(command "_.undo" "_b")
(princ)

悠悠漂泊

MRAK  学习一下

ywhz

MRAK 膜拜大神

alexmai

我是在"特性"窗口中 一次型修改需要的属性块文字