[求助]请教高手,将选择块内实体修改至0层颜色随层但是处理不了嵌套块(已解决)？

userzhl · 发表于 2009-3-22 23:51:00

本帖最后由作者于 2009-3-30 10:17:01 编辑
(defun c:Ttt (/ ss ssl i blocks el e bn bl)
(if (setq ss (ssget '((0 . "insert"))))
(progn
(setq ssl (sslength ss)
i -1
blocks (vla-get-blocks
(vla-get-activedocument (vlax-get-acad-object))
)
)
(repeat ssl
(setq e (ssname ss (setq i (1+ i)))
el (entget e)
bn (cdr (assoc 2 el))
)
(if (not (vl-position bn bl))
(progn
(vlax-for ent (vla-item blocks bn)
(vla-put-layer ent "0")
(vla-put-color ent acBylayer)
(setq bl (cons bn bl))
)
)
)
)
)
)
(princ)
)

caoyin · 发表于 2009-3-23 14:38:00

参考29楼的程序

http://www.mjtd.com/bbs/dispbbs.asp?boardid=3&replyid=118821&id=72404&page=1&skin=0&landlord=0&Star=3

userzhl · 发表于 2009-3-23 17:46:00

上面链接的这个程序，对多重块无效哦。

highflybir · 发表于 2009-3-24 01:53:00

本帖最后由作者于 2009-3-24 2:06:38 编辑

;;;运行命令test
(defun c:test (/ i ent sel obj)
(setq *App (vlax-get-acad-object))
(setq *Doc (vla-get-ActiveDocument *APP))
(setq *BLK (vla-get-blocks *DoC))
(setq i 0)
;;(save_layer_status)
;;(unlock_all_layers)
(if (setq sel (ssget))
(repeat (sslength sel)
(setq ent (ssname sel i))
(setq obj (vlax-ename->vla-object ent))
(change-color obj)
(setq i (1+ i))
)
(princ "\n你没有选择物体!")
)
;;(restore_layer_status)
(princ)
)
;;;主要函数
(defun change-color (obj / name blks)
(if (/= (vla-get-objectname obj) "AcDbBlockReference")
(vla-put-color obj AcByLayer) ; 要加出错处理，因为有的可能被锁定
(progn
(foreach Att (vlax-invoke Obj 'GetAttributes)
(vla-put-Color Att AcByLayer) ; 这一行用于处理属性随层
)
(setq name (vla-get-name obj)) ; 取得块名
(setq blks (vla-item *BLK name))
(vlax-for n blks
(change-color n) ; 递归进去，用于处理嵌套
)
(vla-update obj) ; 用以更新数据，或程序完成后用Regen
)
)
)

主要的函数只有几行，需注意出错处理，楼主可以自己补充更完整。

ayunger · 发表于 2009-3-24 08:18:00

到 http://ayungerstudio.ys168.com下载【一个非常好用的autoCAD工具集】中就有，命令：ayBLKLayer及ayBLKColor，位于安装后【ay工具】菜单【图块类】中。

userzhl · 发表于 2009-3-24 08:18:00

本帖最后由作者于 2009-3-24 8:24:44 编辑

楼上的highflybir,程序处理不了.试试这个文件:

liminnet · 发表于 2009-3-24 09:47:00

提示: 作者被禁止或删除内容自动屏蔽

liminnet · 发表于 2009-3-24 09:47:00

提示: 作者被禁止或删除内容自动屏蔽

highflybir · 发表于 2009-3-24 10:01:00

本帖最后由作者于 2009-3-24 16:05:29 编辑

改了一下

;;;主要函数
(defun change-color (obj / name blks)
(vla-put-layer obj "0") ; 如果不改为0层，则有的可能不变色
(vla-put-color obj AcByLayer) ; 要加出错处理，因为有的可能被锁定
(if (or
(= (vla-get-objectname obj) "AcDbBlockReference")
(= (vla-get-objectname obj) "AcDbMInsertBlock")
)
(progn
(foreach Att (vlax-invoke Obj 'GetAttributes)
(vla-put-layer Att "0")
(vla-put-Color Att AcByLayer) ; 这一行用于处理属性随层
)
(setq name (vla-get-name obj)) ; 取得块名
(setq blks (vla-item *BLK name))
(vlax-for n blks
(change-color n) ; 递归进去，用于处理嵌套
)
)
)
)

userzhl · 发表于 2009-3-24 11:17:00

本帖最后由作者于 2009-3-24 11:19:36 编辑

[求助]highflybir,你的程序处理不了这几个

账号		自动登录	找回密码
密码			注册

[求助]请教高手,将选择块内实体修改至0层颜色随层但是处理不了嵌套块(已解决)？

楼上的程序处理不了.

本帖子中包含更多资源

[求助]highflybir,你的程序处理不了这几个

本帖子中包含更多资源

liminnet liminnet 当前离线积分 9754 明经币个注册时间 2007-8-22 在线时间小时威望金钱个贡献激情	发表于 2009-3-24 09:47:00 \| 显示全部楼层提示: 作者被禁止或删除内容自动屏蔽

	回复支持反对使用道具举报显身卡