膜拜大佬，
飞雪神光 发表于 2023-10-10 13:07
就像这样 拾取一个原图块 批量覆盖有相同属性的属性块 不考虑数据是否对等
很好使，如果能把相近的替换完标记值以后，删除原块就完美了。
lxl217114 发表于 2024-1-9 15:32
很好使，如果能把相近的替换完标记值以后，删除原块就完美了。
加个entdel 删了就行了(defun c:tt(/ bj get-insert-tag&value lm-set-attribute obj ss ss-enlst sx sxlst ty)
(defun get-insert-Tag&value (blk / lst)
(if (= (type blk) 'ENAME)
(if (safearray-value(setq lst (vlax-variant-value(vla-getattributes (vlax-ename->vla-object blk)))))
(mapcar'(lambda (x)(cons (vla-get-tagstring x) (vla-get-textstring x)))(vlax-safearray->list lst))
)
nil
)
)
(defun lm-set-attribute(ty biaoji va / att_list)
(setq ty (if(=(type ty)'ename)(vlax-ename->vla-object ty)ty))
(setq att_list (vlax-safeArray->list (vlax-variant-value (vla-getattributes ty))))
(setq xx(vl-some'(lambda(a)(if(=(strcase(vla-get-TagString a))(strcase biaoji))a))att_list))
(if xx
(vla-put-textstring xx va)
)
(princ)
)
(setq
ty(car(entsel "\n原属性块:"))
obj(vlax-ename->vla-object ty)
)
(setq sxlst (get-insert-Tag&value ty))
(entdel ty)
(princ"\n覆盖属性块：")
(setq ss(ssget '((0 . "insert"))))
(foreach ty (vl-remove-if-not '(lambda (x) (= (type x) 'ENAME)) (mapcar 'cadr (ssnamex ss)))
(foreach x sxlst
(setq
bj(car x)
sx(cdr x)
)
(lm-set-attribute ty bj sx)
)
)
(princ)
)
飞雪神光 发表于 2024-1-9 20:48
加个entdel 删了就行了
大佬，如果方便的话。
看看如图的这样可以实现么？
附件
lxl217114 发表于 2024-1-10 10:35
大佬，如果方便的话。
看看如图的这样可以实现么？
可以用红框查找对应的 原图签和新图签进行替换 也可以试试这个
http://bbs.mjtd.com/forum.php?mod=viewthread&tid=189245&page=1#pid968104
lxl217114 发表于 2024-1-10 10:35
大佬，如果方便的话。
看看如图的这样可以实现么？
(defun c:tt(/ bj get-insert-tag&value lm-set-attribute obj ss ss-enlst sx sxlst ty)
(defun get-insert-Tag&value (blk / lst)
(if (= (type blk) 'ENAME)
(if (safearray-value(setq lst (vlax-variant-value(vla-getattributes (vlax-ename->vla-object blk)))))
(mapcar'(lambda (x)(cons (vla-get-tagstring x) (vla-get-textstring x)))(vlax-safearray->list lst))
)
nil
)
)
(defun lm-set-attribute(ty biaoji va / att_list)
(setq ty (if(=(type ty)'ename)(vlax-ename->vla-object ty)ty))
(setq att_list (vlax-safeArray->list (vlax-variant-value (vla-getattributes ty))))
(setq xx(vl-some'(lambda(a)(if(=(strcase(vla-get-TagString a))(strcase biaoji))a))att_list))
(if xx
(vla-put-textstring xx va)
)
(princ)
)
(defun ss-enlst (ss / enlst)
(cond
((= (type ss) 'PICKSET)
(vl-remove-if-not '(lambda (x) (= (type x) 'ENAME)) (mapcar 'cadr (ssnamex SS)))
)
((= (type ss) 'LIST)
(setq enlst (ssadd))
(last (mapcar '(lambda (x) (ssadd x enlst)) ss))
)
)
)
(defun lm-Get-LwPts(en / x)
(mapcar
'cdr
(vl-remove-if-not
'(lambda(x)
(= (car x) 10)
)
(entget en)
)
)
)
(setq ss(ssget '((0 . "LWPOLYLINE")(8 . "jm-创建块图框"))))
(foreach ty (ss-enlst ss)
(setq pts (lm-Get-LwPts ty))
(setq yss(ssget "cp" pts '((0 . "INSERT")(8 . "图签")(2 . "原始图签"))))
(if (and yss (> (sslength yss) 0))
(progn
(setq
ty (ssname yss 0)
obj(vlax-ename->vla-object ty)
sxlst (get-insert-Tag&value ty)
)
(entdel ty)
(setq xss(ssget "cp" pts '((0 . "INSERT")(2 . "新图签"))))
(foreach ty (vl-remove-if-not '(lambda (x) (= (type x) 'ENAME)) (mapcar 'cadr (ssnamex xss)))
(foreach x sxlst
(setq
bj(car x)
sx(cdr x)
)
(lm-set-attribute ty bj sx)
)
)
)
)
)
(princ)
)
本帖最后由 newmooooon 于 2024-1-10 13:02 编辑
lxl217114 发表于 2024-1-10 10:35
大佬，如果方便的话。
看看如图的这样可以实现么？
(defun c:sbb(/ i en ss_Block Block_Name att_list)
(setq att_list '(2 8 41 42 43 50))
(princ "\n源块：")
(if sb_source_block (princ (strcat "默认:" (cdr (assoc 2 sb_source_block)))))
(setq en (ssget "_+.:E:S" '((0 . "INSERT"))))
(if en
(setq sb_source_block (nw_get_assocs (entget (ssname en 0)) att_list))
)
(princ "\n需要被替换的块：")
(setq ss_Block (ssget ":S" '((0 . "INSERT"))))
(while ss_Block
(setq i -1)
(while (setq en (ssname ss_Block (setq i (1+ i))))
(setq en (entget en))
(entmod (nw_set_assocs en sb_source_block))
)
(setq ss_Block (ssget ":S" '((0 . "INSERT"))))
)
)
;;返回图元中所有群码在dxf_lst中的表
(defun nw_get_assocs(en_data dxf_lst)
(if (= 'ENAME (type en_data))
(setq en_data (entget en_data))
)
(vl-remove-if-not '(lambda(x) (member (car x) dxf_lst)) en_data)
)
;;修改指定群码表
(defun nw_set_assocs(en_data assoc_lst1 / x y)
(foreach x assoc_lst1
(if (setq y (assoc (car x) en_data))
(setq en_data (subst x y en_data))
(setq en_data (cons x en_data))
)
)
)
自用的，只刷块，不刷属性
带记忆的块刷
newmooooon 发表于 2024-1-10 12:55
自用的，只刷块，不刷属性
带记忆的块刷
厉害的，厉害的。
飞雪神光 发表于 2024-1-10 11:30
还有一丢丢问题：
就是在图框是如下情况会①不是矩形 ②是图块③外部参照④没有矩形、没有图块、没有外部参照的图框
会失效
lxl217114 发表于 2024-1-10 13:38
还有一丢丢问题：
就是在图框是如下情况会①不是矩形 ②是图块③外部参照④没有矩形、没有图块、没有外 ...
这就是开始不停地加需求了么