iCAx开思网

标题: AutoCad里的线条如何全部变成白色 [打印本页]
作者: gaowengang    时间: 2014-12-16 11:31
标题: AutoCad里的线条如何全部变成白色
RT。客户发来的图纸花花绿绿的，里面有各种颜色。我要把图纸里所有的线条变成白色，然后将图粘贴进word里。那么问题来了，图纸里有非常多的图块，这些图块不能变成白色，目前我的做法是将这些图块一一炸开，然后选择线条变成白色。由于图块数量非常之多，导致这个过程非常浪费时间，请问各位大侠，有没有方便的方法可以将图纸全部变成白色？
作者: 大鹿    时间: 2014-12-16 11:47
请上传文件
作者: wutong490    时间: 2014-12-16 11:56
有点麻烦的做法  
1.打印成PDF，设置黑白打印
2.将PDF文件另存为图片格式
作者: gaowengang    时间: 2014-12-16 13:59
大鹿 发表于 2014-12-16 11:47
请上传文件

文件请见附件，图是我随便画的。
另外，打印成PDF再保存图片也太麻烦了，因为我在word里要插入非常多的图，而且不是只做一次，是天天这么做。请鹿大帮忙！~
作者: Francis    时间: 2014-12-17 02:33
沒有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))
复制代码
作者: Francis    时间: 2014-12-17 02:46
漏了一點，以下代碼為準：
  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))
复制代码
作者: gaowengang    时间: 2014-12-17 10:27
Francis 发表于 2014-12-17 02:46
漏了一點，以下代碼為準：

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

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

不好意思，第6句有誤，提取每一個圖塊時沒給圖塊的圖元，導致缺乏參數，請改為以下代碼再試一次。
  1.         (setq eachblockname(cdr(assoc 2 (entget eachblock))))
复制代码



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

回闷大：
测试结果如下图。白天一整天登陆不了论坛，下班了才能登陆。未能及时回复测试结果，抱歉。
还有些问题。。
作者: Francis    时间: 2014-12-17 19:41
發現第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)) ;避開傳回不必要的信息
复制代码


作者: gaowengang    时间: 2014-12-18 09:14
Francis 发表于 2014-12-17 19:41
發現第14句是多餘的，以下代碼改正了，並加上了註解，希望可讓樓主解決問題。

多谢闷大！
可还是这样显示。
命令: allwhite
; 错误: 参数类型错误: lentityp ((0 . "BLOCK") (2 . "2") (70 . 0) (4 . "") (10 0.0 0.0
0.0) (-2 . <图元名: 7eea2e78>))
命令:




欢迎光临 iCAx开思网 (https://www.icax.org/) Powered by Discuz! X3.3