wharan 发表于 2023-10-9 19:30
我是这么做的：选定样板图框（图标）的共用属性，如：工程名称、项目编号、阶段、版本号、日期等，然后循环 ...
我是不想打字，所以写个东西直接复制。不怕麻烦的做法是选定所有属性图框，然后ctrl+1特性里统一打字修改，感觉跟你这个差不多。
shujh1989 发表于 2023-10-9 17:45
是可以的。那要把第一个块的属性跟第二个块的每一个属性比较，标签一致的再替换，不一致的跳过。然后去掉 ...
根本不需要比较 也不用考虑跳过 也不需要去掉替换过的再做成列表和比较 直接去覆盖 而不是用被替换的去原数据里找这样操作是反过来的
就像这样 拾取一个原图块 批量覆盖有相同属性的属性块 不考虑数据是否对等(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))
(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)
)
飞雪神光 发表于 2023-10-10 13:07
就像这样 拾取一个原图块 批量覆盖有相同属性的属性块 不考虑数据是否对等
，大神厉害
飞雪神光 发表于 2023-10-10 13:07
就像这样 拾取一个原图块 批量覆盖有相同属性的属性块 不考虑数据是否对等
块参照的属性是以数组形式出现的，也就是无法使用item,因此，不宜针对一个tag在它的所有属性里边查找
(defun getatts(blk);|获取块参照图元(对象)的属性参照,返回值((属性标记 属性值 属性对象)...)以便进一步修改指定标记的属性值|;
(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)
(mapcar(function(lambda(x)(list(strcase(vlax-get-property x'TagString))(vlax-get-property x'TextString)x)))
(vlax-safearray->list(vlax-variant-value(vlax-invoke-method blk'GetAttributes))))))
(defun putatts(enblk lst / a);|enblk属性块图元或对象,lst((标记 值)(标记 值)(标记 值)...)|;
(and(setq a(getatts enblk))
(vl-some(function(lambda(x / b)(and(setq b(assoc(strcase(car x))a))(vlax-put-property(caddr b)'TextString(cadr x)))))lst)))
飞雪神光 发表于 2023-10-10 12:48
根本不需要比较 也不用考虑跳过 也不需要去掉替换过的再做成列表和比较 直接去覆盖 而不是用被替换的去原 ...
A块和B块
标记名称相同的att属性定义
从A块提取标记的数据，赋予给B图块同名的标记。
这样的功能应该蛮实用的。
大神们的没弄懂，我自己修改了下。
(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学习一下
MRAK 膜拜大神
本帖最后由 alexmai 于 2023-12-7 15:19 编辑
我是在"特性"窗口中 一次型修改需要的属性块文字