我知道是怎么会事情。--这个错误主要来源于没有考虑当颜色随块即为0的情况。
龙版主的程序的确比我以前的快了10-20倍。但是可能隐含一点错误（不能满足随颜色分层,且对填充图案之类的可能运算不正确）
下面我上传得一个.dwg格式的文件可以反映这个程序还需要作小许改动，才能满足速度和正确率都保持不变。
(defun C:ddd (/ *DOC *OBJ *LAY blocks layers)
(vl-load-com)
(setq *OBJ (vlax-get-acad-object))
(setq *DOC (vla-get-activedocument *OBJ))
(setq *LAY (vla-get-layers *DOC)) ;取得层集合
(table)
(setq blocks (vla-get-blocks *DOC)) ;取得塊集合
(vlax-for block blocks ;遍歷塊集合
(vlax-for n block ;遍歷單個塊
(ccb n)
)
)
(princ)
)
(defun ccb (object / colour laynam laycol)
(setq colour (itoa (vla-get-color object))) ;取得物体颜色号
(cond
( (or (= colour "256") (= colour "0")) ;如果物体颜色随层或随块
(setq laynam (vla-get-layer object)) ;取得物体所在层名
(setq laycol (cdr (assoc laynam layers)));取得层颜色
(setq colour (itoa laycol))
(ML)
)
( (ML)
(vla-put-color object 256) ;否则改变物体颜色为随层
)
)
(vla-put-layer object colour) ;对物体改层到颜色号层
)
(defun ML (/ layobj)
(if (not (assoc colour layers)) ;如果颜色号不在图层表中
(progn
(setq layers (cons (cons colour laycol) layers))
;重新构造图层表
(setq layobj (vla-add *LAY colour)) ;创建颜色号图层
(vla-put-color layobj colour) ;对颜色号层赋色
)
)
)
(defun table (/ name color Nname)
(vlax-for n *LAY ;遍历层集合
(setq name (vla-get-name n)) ;取得层名
(setq color (vla-get-color n)) ;取得层颜色
(setq layers (cons (cons name color) layers));获得层名和颜色号表
(setq Nname (read name))
(if (= (type Nname) (type 1)) ;如果层名是整数
(if (= (strlen (itoa Nname)) (strlen name))
(if (and (> Nname 0) (< Nname 256)) ;并且>0,<256
(if (/= color Nname) ;如果层颜色不等于层名
(vla-put-color n Nname) ;则改层颜色为层名
)
)
)
)
)
)
;;顺便把以前的那个关于所有颜色随层的程序贴上来。
(defun C:ccc (/ Obj blocklist block n)
(vl-load-com)
(setq *OBJ (vlax-get-acad-object))
(setq *DOC (vla-get-activedocument *OBJ))
(setq *MSP (vla-get-modelspace *DOC))
(setq blocklist (vla-get-blocks *DOC));取得块集合
(vlax-for block blocklist ;遍历块集合
(vlax-for n block ;遍历单个块
(if (/= (vla-get-color n) 256)
(vla-put-color n 256)
)
)
)
(princ "\n操作已经全部完成!")
(princ)
)
<p>highflybir版主的13楼里的程序做得相当完美了</p><p>2位版主的讨论让我们晚辈学了不少东西</p><p>再次感谢2位版主</p> <p>说实在话，这个程序还不够完美，因为要考虑如下情况</p><p>1、对于图层中有冻结或者锁住的情况下，会出错。</p><p>2、对于有XREF的情况下，会出错。</p><p>3、可能不于其他二次开发软件不兼容。</p><p>4、对于颜色为0的情况有可能也判断不对。</p><p>5、如果不是整个图形对象，而是选择集的话，则这个程序不适用。</p><p>6、是否有更优的算法？</p><p>7、以及其他种种未考虑到的情况。</p><p>总体来说，是一个基本满足要求的程序.</p><p>如果要更正上述几点的话，程序可能变得很长了。</p> 以下代码应该能更使13楼的程序更完美些吧.
麻烦highflybir版主指教下
(defun C:dddd(/ Obj blocklist block n)
(vl-load-com)
(setq AcadObject(vlax-get-acad-object))
(setq AcadDocument (vla-get-activedocument AcadObject))
(setq ModelSpace (vla-get-modelspace AcadDocument))
(vlax-for obj ModelSpace ;取得模型空间对象集合
(if(/= (vla-get-color obj) 256) ;遍历模型空间对象
(vla-put-color obj 256)
)
)
(setq blocklist (vla-get-blocks AcadDocument));取得块集合
(vlax-for block blocklist ;遍历块集合
(vlax-for n block ;遍历单个块
(if(/= (vla-get-color n) 256)
(vla-put-color n 256)
)
)
)
)
能不能用框选的方法选择分层，有的不要全部
页:
1
[2]