[求助]全部按颜色分层

鬼魔 · 发表于 2007-1-11 11:08:00

本帖最后由作者于 2007-1-11 11:09:24 编辑

龙龙仔版主10楼这个运行会显示错误,列表缺陷,没法用

我用04版,没装插件

龙龙仔 · 发表于 2007-1-11 12:29:00

;;重貼

(defun TABLE (S / D R)
(while (setq D (tblnext S (null D)))
    (setq R (cons (cons (cdr (assoc 2 D)) (cdr (assoc 62 D)))
    R
     )
    )
)
)
(defun C:DDDD (/ OBJ BLOCKLIST BLOCK N LST)
(vl-load-com)
(setq *OBJ (vlax-get-acad-object))
(setq *DOC (vla-get-activedocument *OBJ))
(setq LAYSEL (vla-get-layers *DOC))
(setq LST (TABLE "Layer"))
(setq BLOCKLIST (vla-get-blocks *DOC)) ;取得塊集合
(vlax-for BLOCK BLOCKLIST  ;遍歷塊集合
    (vlax-for N BLOCK   ;遍歷單個塊
      (CCBB N)
    )
)
(princ)
)
(defun ML ()
(if (not (assoc LAYCOL LST))
    (progn
      (setq LST (cons (cons LAYCOL LAYCOL) LST))
      (setq LAYOBJ (vla-add LAYSEL LAYCOL))
      (vla-put-color LAYOBJ LAYCOL)
    )
)
)
(defun CCBB (OBJ / LAYCOL LAYNAM)
(setq LAYCOL (itoa (vla-get-color OBJ)))
(if (= LAYCOL "256")
    (progn
      (setq LAYNAM (vla-get-layer OBJ))
      (setq LAYCOL (cdr (assoc LAYNAM LST)))
      (ML)
    )
    (progn
      (ML)
      (vla-put-color OBJ 256)
    )
)
(vla-put-layer OBJ LAYCOL)
)

鬼魔 · 发表于 2007-1-11 20:19:00

本帖最后由作者于 2007-1-11 20:24:15 编辑

龙龙仔版主,个别图纸运行时会出现以下内容,无法运行

是怎么回事

错误: AutoCAD.Application: 参数 Color (位于 IAcadLayer::put_Color 中) 无效

highflybir · 发表于 2007-1-11 23:51:00

本帖最后由作者于 2007-1-13 10:43:54 编辑

我知道是怎么会事情。--这个错误主要来源于没有考虑当颜色随块即为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: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)
)

鬼魔 · 发表于 2007-1-12 00:48:00

highflybir版主的13楼里的程序做得相当完美了

2位版主的讨论让我们晚辈学了不少东西

再次感谢2位版主

highflybir · 发表于 2007-1-12 12:12:00

说实在话，这个程序还不够完美，因为要考虑如下情况

1、对于图层中有冻结或者锁住的情况下，会出错。

2、对于有XREF的情况下，会出错。

3、可能不于其他二次开发软件不兼容。

4、对于颜色为0的情况有可能也判断不对。

5、如果不是整个图形对象，而是选择集的话，则这个程序不适用。

6、是否有更优的算法？

7、以及其他种种未考虑到的情况。

总体来说，是一个基本满足要求的程序.

如果要更正上述几点的话，程序可能变得很长了。

鬼魔 · 发表于 2007-1-13 00:25:00

以下代码应该能更使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)
)
)
)
)

q274592467 · 发表于 2016-10-21 14:04:15

能不能用框选的方法选择分层，有的不要全部

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

[求助]全部按颜色分层

本帖子中包含更多资源