AutoCad里的线条如何全部变成白色

RT。客户发来的图纸花花绿绿的，里面有各种颜色。我要把图纸里所有的线条变成白色，然后将图粘贴进word里。那么问题来了，图纸里有非常多的图块，这些图块不能变成白色，目前我的做法是将这些图块一一炸开，然后选择线条变成白色。由于图块数量非常之多，导致这个过程非常浪费时间，请问各位大侠，有没有方便的方法可以将图纸全部变成白色？

请上传文件

有点麻烦的做法  
1.打印成PDF，设置黑白打印
2.将PDF文件另存为图片格式

大鹿 发表于 2014-12-16 11:47
请上传文件

文件请见附件，图是我随便画的。
另外，打印成PDF再保存图片也太麻烦了，因为我在word里要插入非常多的图，而且不是只做一次，是天天这么做。请鹿大帮忙！~

沒有AutoCAD，代碼憑空想像的。
有勞測試。

1. (defun c:allwhite()
   
2. (command "chprop" "all" "" "c" "7" "")
   
3. (command "layer" "c" "7" "*" "")
   
4. (setq eachblock(tblnext "BLOCK" T))
   
5. (while eachblock
   
6.         (setq eachblockname(cdr(assoc 2)))
   
7.         (setq ent(cdr (last (tblsearch "BLOCK" eachblockname))))
   
8.         (setq entl(entget ent))
   
9.         (setq entl(subst '(62 . 7)(assoc 62 entl)entl))
   
10.         (entmod entl)
    
11.         (setq eachblock(tblnext "BLOCK"))
    
12. )
    
13. (princ))

复制代码

漏了一點，以下代碼為準：

1. (defun c:allwhite()
   
2. (command "chprop" "all" "" "c" "7" "")
   
3. (command "layer" "c" "7" "*" "")
   
4. (setq eachblock(tblnext "BLOCK" T))
   
5. (while eachblock
   
6.         (setq eachblockname(cdr(assoc 2)))
   
7.         (setq ent(cdr (last (tblsearch "BLOCK" eachblockname))))
   
8.         (while ent
   
9.                 (setq entl(entget ent))
   
10.                 (setq entl(subst '(62 . 7)(assoc 62 entl)entl))
    
11.                 (entmod entl)
    
12.                 (setq ent(entnext ent))
    
13.         )
    
14.         (setq entl(entget ent))
    
15.         (setq eachblock(tblnext "BLOCK"))
    
16. )
    
17. (princ))

复制代码

Francis 发表于 2014-12-17 02:46
漏了一點，以下代碼為準：

多谢闷大，深夜里还在回复我的帖子，为我的问题编写代码，感动~~
您的代码测试如下：
1、在客户的图纸里测试，第一张图纸里，所有的线条完美地全部变成白色，第二张却没变。
2、在我昨天随便画的那张图里测试，图块没变成白色。
不管是变白的还是没变白的，控制台最后都显示的是 错误：参数太少。
图纸中的很多图块里面还镶嵌有图块。比如：图纸中的小车是个图块，小车的车轮是镶嵌在小车内的图块，车轮上的螺钉是镶嵌在车轮内的图块。。。。甚至还有更下层的。不知道是不是这样的原因呢？

gaowengang 发表于 2014-12-17 10:27
多谢闷大，深夜里还在回复我的帖子，为我的问题编写代码，感动~~
您的代码测试如下：
1、在客户的图纸 ...

不好意思，第6句有誤，提取每一個圖塊時沒給圖塊的圖元，導致缺乏參數，請改為以下代碼再試一次。

1.         (setq eachblockname(cdr(assoc 2 (entget eachblock))))
   

复制代码

Francis 发表于 2014-12-17 10:55
不好意思，第6句有誤，提取每一個圖塊時沒給圖塊的圖元，導致缺乏參數，請改為以下代碼再試一次。

回闷大：
测试结果如下图。白天一整天登陆不了论坛，下班了才能登陆。未能及时回复测试结果，抱歉。
还有些问题。。

發現第14句是多餘的，以下代碼改正了，並加上了註解，希望可讓樓主解決問題。

1. (defun c:allwhite()
   
2. (setvar "cmdecho" 0);暫停傳回信息到指令列
   
3. (command "chprop" "all" "" "c" "7" "") ;所有圖元改為白色，不包括塊內的圖元
   
4. (command "layer" "c" "7" "*" "") ;所有圖層改為白色
   
5. (setq eachblock(tblnext "BLOCK" T)) ;獲取在圖塊區第一個圖塊
   
6. (while eachblock ;處理每一個圖塊，直到最後一個圖塊
   
7.         (setq eachblockname(cdr(assoc 2 (entget eachblock)))) ;獲取圖塊的名稱
   
8.         (setq ent(cdr (last (tblsearch "BLOCK" eachblockname)))) ;利用圖塊名稱搜尋它內含的第一個圖元
   
9.     (while ent ;處理每一個圖元，直到塊內最後一個圖元
   
10.         (setq entl(entget ent)) ;獲取圖元的資料清單
    
11.         (princ entl)(princ "\n") ;強制傳回圖元的資料清單到指令列（成功後刪除此行）
    
12.         (setq entl(subst '(62 . 7)(assoc 62 entl)entl)) ;修改圖元的資料清單
    
13.         (princ entl)(princ "\n")(princ "\n") ;強制傳回修改後的資料清單到指令列（成功後刪除此行）
    
14.         (entmod entl) ;更新圖元
    
15.         (setq ent(entnext ent)) ;下一個圖元
    
16.     ) ;完結 while ent
    
17.         (setq eachblock(tblnext "BLOCK")) ;下一個圖塊
    
18. ) ;完結 while eachblock
    
19. (setvar "cmdecho" 1);開啟傳回信息到指令列
    
20. (princ)) ;避開傳回不必要的信息

复制代码