匹配块的特性
我需要一个或多个lisp来匹配块的属性。当我选择一个“源块”时，我将选择多个目标
块以匹配比例、颜色、线型、旋转、文字样式，
等每件事
谢谢
块没有文字样式属性。
颜色和线型应使用MATCHPROP命令。
这就留下了一些与比例和旋转相匹配的东西。。。。。。
您没有更改*所有*插入的属性，对吗？ 对的
只是我选择的块。 以下是有效的代码。。。
;;匹配块
;;将doner块的特性匹配到选定块
;;特性包括x、y、z比例因子、旋转、颜色、图层、，
;; 线型和线型比例
（默认c:mb（/srcblk ensel srcobj prop blkobj blk color linetype
旋转x比例y比例z比例图层线型比例线宽打印样式名称
)
（if（setq srcblk（car（entsel“\n选择源块：”））
（setq srcobj（vlax ename->vla object srcblk）
x比例（vla get xscalefactor srcobj）
y比例（vla get yscalefactor srcobj）
z尺度（vla get zscalefactor srcobj）
旋转（vla get rotation srcobj）
颜色（vla get color srcobj）
线型（vla get linetype srcobj）
层（vla get layer srcobj）
线型比例（vla get linetypescale srcobj）
线宽（vla get lineweight srcobj）
)
)
（while（progn
（提示“\n选择目标块：”）
（setq blk（ssget“+：E:S”））
)
（setq blkobj（vlax ename->vla对象（ssname blk 0）））
（提示“\***有一个。***”）
（vla put xscalefactor blkobj x-scale）
（vla put yscalefactor blkobj y标尺）
（vla put zscalefactor blkobj z尺度）
（vla put rotation blkobj rotation）
（vla put Color blkobj Color）
（vla put线型blkobj线型）
（vla put layer blkobj layer）
（vla put linetypescale blkobj linetypescale）
（vla put线宽blkobj线宽）
)
（普林斯）
)
（提示“\***匹配加载的块，输入MB以运行。***”）
（普林斯） 您好-
嗯。。。这听起来正是我需要的
但我不明白你在底部“代码”上写的所有东西
那是什么？
当我看到这样的东西时，我通常只是放松，然后慢慢后退
看起来很复杂！
我是否要将其复制到记事本中并像Lisp程序一样“运行”它？
谢谢-
总费用 您也可以尝试以下方法：
加载此lisp后，从命令行将其调用为：
Command: mpr_block 多亏了Katty测试了代码。修正了一些愚蠢的错误：
(defun c:mpr_block (/ *kpblc-activedoc*
selset ent
item _kpblc-layer-status-restore
_kpblc-layer-status-save
*error*
)
(defun *error* (msg)
(_kpblc-layer-status-restore)
(vla-endundomark *kpblc-activedoc*)
(princ msg)
(princ)
) ;_ end of defun
(defun _kpblc-layer-status-restore (/ item)
(if *kpblc-list-layer-status*
(progn
(foreach item *kpblc-list-layer-status*
(vla-put-layeron (car item) (cdr (assoc "on" (cdr item))))
(vla-put-lock (car item) (cdr (assoc "lock" (cdr item))))
(if (not (equal (vla-get-activelayer *kpblc-activedoc*) (car item)))
(vla-put-freeze (car item) (cdr (assoc "freeze" (cdr item))))
) ;_ end of if
) ;_ end of foreach
(setq *kpblc-list-layer-status* nil)
) ;_ end of progn
) ;_ end of if
) ;_ end of defun
(defun _kpblc-layer-status-save (layers-on / item)
(if *kpblc-list-layer-status*
(setq *kpblc-list-layer-status* nil)
) ;_ end of if
(vlax-for item (vla-get-layers *kpblc-activedoc*)
(setq *kpblc-list-layer-status*
(append *kpblc-list-layer-status*
(list
(list item
(cons "freeze" (vla-get-freeze item))
(cons "lock" (vla-get-lock item))
(cons "on" (vla-get-layeron item))
) ;_ end of list
) ;_ end of list
) ;_ end of append
) ;_ end of setq
(if layers-on
(progn
(vla-put-layeron item :vlax-true)
(vla-put-lock item :vlax-false)
(if (not (equal (vla-get-activelayer *kpblc-activedoc*) item))
(vla-put-freeze item :vlax-false)
) ;_ end of if
) ;_ end of progn
) ;_ end of if
) ;_ end of vlax-for
) ;_ end of defun
(vl-load-com)
(setq *kpblc-activedoc* (vla-get-activedocument (vlax-get-acad-object)))
(vla-startundomark *kpblc-activedoc*)
(if (and (setq ent (entsel "\nSelect the block for source prop <Exit> : "))
(= (cdr (assoc 0 (entget (car ent)))) "INSERT")
(setq ent (vlax-ename->vla-object (car ent)))
) ;_ end of and
(progn
(_kpblc-layer-status-save t)
(if (setq selset (ssget '((0 . "INSERT"))))
(while (and selset
(> (sslength selset) 0)
) ;_ end of and
(setq item (ssname selset 0))
(ssdel item selset)
(foreach prop '("color" "layer" "xscalefactor"
"yscalefactor" "zscalefactor" "rotation"
"linetype" "lineweight" "linetypescale"
)
(if (and (vlax-property-available-p ent prop t)
(vlax-property-available-p (vlax-ename->vla-object item) prop t)
) ;_ end of and
(vlax-put-property (vlax-ename->vla-object item) prop (vlax-get-property ent prop))
) ;_ end of if
) ;_ end of foreach
) ;_ end of while
) ;_ end of if
(_kpblc-layer-status-restore)
) ;_ end of progn
) ;_ end of if
(vla-regen *kpblc-activedoc* acactiveviewport)
(vla-endundomark *kpblc-activedoc*)
(princ)
) ;_ end of defun 嘿，伙计们，太棒了。。。。。但是
可以对其进行修改以处理动态块吗？ 非常好，非常感谢 只是为了好玩。。。
此外，kbplc的效率极低，因为它每次试图编辑一个选定块时都会检索源对象的属性。
页:
[1]
2