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

q2284555

膜拜大佬，

lxl217114

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

很好使，如果能把相近的替换完标记值以后，删除原块就完美了。

飞雪神光

lxl217114 发表于 2024-1-9 15:32
很好使，如果能把相近的替换完标记值以后，删除原块就完美了。

加个entdel 删了就行了

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.         (entdel ty)
    
25.         (princ"\n覆盖属性块：")
    
26.         (setq ss(ssget '((0 . "insert"))))
    
27.         (foreach ty (vl-remove-if-not '(lambda (x) (= (type x) 'ENAME)) (mapcar 'cadr (ssnamex ss)))
    
28.                 (foreach x sxlst
    
29.                         (setq
    
30.                                 bj(car x)
    
31.                                 sx(cdr x)
    
32.                         )
    
33.                         (lm-set-attribute ty bj sx)
    
34.                 )
    
35.         )
    
36.         (princ)
    
37. )

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

lxl217114

飞雪神光 发表于 2024-1-9 20:48
加个entdel 删了就行了

大佬，如果方便的话。
看看如图的这样可以实现么？

附件

飞雪神光

lxl217114 发表于 2024-1-10 10:35
大佬，如果方便的话。
看看如图的这样可以实现么？

可以用红框查找对应的 原图签和新图签进行替换 也可以试试这个
http://bbs.mjtd.com/forum.php?mo ... mp;page=1#pid968104

飞雪神光

lxl217114 发表于 2024-1-10 10:35
大佬，如果方便的话。
看看如图的这样可以实现么？

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.         (defun ss-enlst (ss / enlst)
    
20.                 (cond
    
21.                         ((= (type ss) 'PICKSET)
    
22.                                 (vl-remove-if-not '(lambda (x) (= (type x) 'ENAME)) (mapcar 'cadr (ssnamex SS)))
    
23.                         )
    
24.                         ((= (type ss) 'LIST)
    
25.                                 (setq enlst (ssadd))
    
26.                                 (last (mapcar '(lambda (x) (ssadd x enlst)) ss))
    
27.                         )
    
28.                 )
    
29.         )
    
30.         (defun lm-Get-LwPts(en / x)
    
31.                 (mapcar
    
32.                         'cdr
    
33.                         (vl-remove-if-not
    
34.                                 '(lambda(x)
    
35.                                          (= (car x) 10)
    
36.                                  )
    
37.                                 (entget en)
    
38.                         )
    
39.                 )
    
40.         )
    
41.         (setq ss(ssget '((0 . "LWPOLYLINE")(8 . "jm-创建块图框"))))
    
42.         (foreach ty (ss-enlst ss)
    
43.                 (setq pts (lm-Get-LwPts ty))
    
44.                 (setq yss(ssget "cp" pts '((0 . "INSERT")(8 . "图签")(2 . "原始图签"))))
    
45.                 (if (and yss (> (sslength yss) 0))
    
46.                         (progn
    
47.                                 (setq
    
48.                                         ty (ssname yss 0)
    
49.                                         obj(vlax-ename->vla-object ty)
    
50.                                         sxlst (get-insert-Tag&value ty)
    
51.                                 )
    
52.                                 (entdel ty)
    
53.                                 (setq xss(ssget "cp" pts '((0 . "INSERT")(2 . "新图签"))))
    
54.                                 (foreach ty (vl-remove-if-not '(lambda (x) (= (type x) 'ENAME)) (mapcar 'cadr (ssnamex xss)))
    
55.                                         (foreach x sxlst
    
56.                                                 (setq
    
57.                                                         bj(car x)
    
58.                                                         sx(cdr x)
    
59.                                                 )
    
60.                                                 (lm-set-attribute ty bj sx)
    
61.                                         )
    
62.                                 )
    
63.                         )
    
64.                 )
    
65.         )
    
66.         (princ)
    
67. )

(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 />         (defun ss-enlst (ss / enlst)<br />                 (cond<br />                         ((= (type ss) 'PICKSET)<br />                                 (vl-remove-if-not '(lambda (x) (= (type x) 'ENAME)) (mapcar 'cadr (ssnamex SS)))<br />                         )<br />                         ((= (type ss) 'LIST)<br />                                 (setq enlst (ssadd))<br />                                 (last (mapcar '(lambda (x) (ssadd x enlst)) ss))<br />                         )<br />                 )<br />         )<br />         (defun lm-Get-LwPts(en / x)<br />                 (mapcar<br />                         'cdr<br />                         (vl-remove-if-not<br />                                 '(lambda(x)<br />                                          (= (car x) 10)<br />                                  )<br />                                 (entget en)<br />                         )<br />                 )<br />         )<br />         (setq ss(ssget '((0 . "LWPOLYLINE")(8 . "jm-创建块图框"))))<br />         (foreach ty (ss-enlst ss)<br />                 (setq pts (lm-Get-LwPts ty))<br />                 (setq yss(ssget "cp" pts '((0 . "INSERT")(8 . "图签")(2 . "原始图签"))))<br />                 (if (and yss (> (sslength yss) 0))<br />                         (progn<br />                                 (setq<br />                                         ty (ssname yss 0)<br />                                         obj(vlax-ename->vla-object ty)<br />                                         sxlst (get-insert-Tag&value ty)<br />                                 )<br />                                 (entdel ty)<br />                                 (setq xss(ssget "cp" pts '((0 . "INSERT")(2 . "新图签"))))<br />                                 (foreach ty (vl-remove-if-not '(lambda (x) (= (type x) 'ENAME)) (mapcar 'cadr (ssnamex xss)))<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 />                         )<br />                 )<br />         )<br />         (princ)<br /> )

newmooooon

lxl217114 发表于 2024-1-10 10:35
大佬，如果方便的话。
看看如图的这样可以实现么？

2. (defun c:sbb(/ i en ss_Block Block_Name att_list)
   
3.         (setq att_list '(2 8 41 42 43 50))
   
4.         (princ "\n源块：")
   
5.         (if sb_source_block (princ (strcat "默认:" (cdr (assoc 2 sb_source_block)))))
   
6.         (setq en (ssget "_+.:E:S" '((0 . "INSERT"))))
   
7.         (if en
   
8.                 (setq sb_source_block (nw_get_assocs (entget (ssname en 0)) att_list))
   
9.         )
   
10.         (princ "\n需要被替换的块：")
    
11.         (setq ss_Block (ssget ":S" '((0 . "INSERT"))))
    
12.         (while ss_Block
    
13.                 (setq i -1)
    
14.                 (while (setq en (ssname ss_Block (setq i (1+ i))))
    
15.                         (setq en (entget en))
    
16.                         (entmod (nw_set_assocs en sb_source_block))
    
17.                 )
    
18.                 (setq ss_Block (ssget ":S" '((0 . "INSERT"))))
    
19.         )
    
20. )
    
21. 
    
22. ;;返回图元中所有群码在dxf_lst中的表
    
23. (defun nw_get_assocs(en_data dxf_lst)
    
24.         (if (= 'ENAME (type en_data))
    
25.                 (setq en_data (entget en_data))
    
26.         )
    
27.         (vl-remove-if-not '(lambda(x) (member (car x) dxf_lst)) en_data)
    
28. )
    
29. 
    
30. ;;修改指定群码表
    
31. (defun nw_set_assocs(en_data assoc_lst1 / x y)
    
32.         (foreach x assoc_lst1
    
33.                 (if (setq y (assoc (car x) en_data))
    
34.                         (setq en_data (subst x y en_data))
    
35.                         (setq en_data (cons x en_data))
    
36.                 )
    
37.         )
    
38. )
    

(defun c:sbb(/ i en ss_Block Block_Name att_list)<br />         (setq att_list '(2 8 41 42 43 50))<br />         (princ "\n源块：")<br />         (if sb_source_block (princ (strcat "默认:" (cdr (assoc 2 sb_source_block)))))<br />         (setq en (ssget "_+.:E:S" '((0 . "INSERT"))))<br />         (if en<br />                 (setq sb_source_block (nw_get_assocs (entget (ssname en 0)) att_list))<br />         )<br />         (princ "\n需要被替换的块：")<br />         (setq ss_Block (ssget ":S" '((0 . "INSERT"))))<br />         (while ss_Block<br />                 (setq i -1)<br />                 (while (setq en (ssname ss_Block (setq i (1+ i))))<br />                         (setq en (entget en))<br />                         (entmod (nw_set_assocs en sb_source_block))<br />                 )<br />                 (setq ss_Block (ssget ":S" '((0 . "INSERT"))))<br />         )<br /> )<br /> <br /> ;;返回图元中所有群码在dxf_lst中的表<br /> (defun nw_get_assocs(en_data dxf_lst)<br />         (if (= 'ENAME (type en_data))<br />                 (setq en_data (entget en_data))<br />         )<br />         (vl-remove-if-not '(lambda(x) (member (car x) dxf_lst)) en_data)<br /> )<br /> <br /> ;;修改指定群码表<br /> (defun nw_set_assocs(en_data assoc_lst1 / x y)<br />         (foreach x assoc_lst1<br />                 (if (setq y (assoc (car x) en_data))<br />                         (setq en_data (subst x y en_data))<br />                         (setq en_data (cons x en_data))<br />                 )<br />         )<br /> )<br />

自用的，只刷块，不刷属性
带记忆的块刷

lxl217114

newmooooon 发表于 2024-1-10 12:55
自用的，只刷块，不刷属性
带记忆的块刷

厉害的，厉害的。

lxl217114

飞雪神光 发表于 2024-1-10 11:30

还有一丢丢问题：
就是在图框是如下情况会①不是矩形 ②是图块③外部参照④没有矩形、没有图块、没有外部参照的图框
会失效

飞雪神光

lxl217114 发表于 2024-1-10 13:38
还有一丢丢问题：
就是在图框是如下情况会①不是矩形 ②是图块③外部参照④没有矩形、没有图块、没有外 ...

这就是开始不停地加需求了么