明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
查看: 3985|回复: 7

可否把CAD所有图纸快速变黑白???

[复制链接]
发表于 2013-3-5 09:32 | 显示全部楼层 |阅读模式
1明经币
比如就是1个文件夹里面有10个CAD图纸,这个图纸除了包含自己画的线线框、还有增加的块,怎么快速把所有CAD图纸变黑白????

比如就是1个文件夹里面有10个CAD图纸,这个图纸除了包含自己画的线线框、还有增加的块,怎么快速把所有CAD图纸变黑白????
以后要是50个图纸,那不是手动1个改好麻烦

最佳答案

发表于 2013-3-5 09:32 | 显示全部楼层
  1. ;|
  2. 参考帖子:
  3. http://bbs.mjtd.com/thread-82677-1-1.html
  4. 自动打开文件夹下所有文件,并执行图形清理、缩放和保存命令

  5. http://bbs.mjtd.com/thread-30159-1-1.html
  6. 修改块内某个实体的所在图层及颜色?(不炸开嵌套块儿的前提下)

  7. 把此lsp文件添加到CAD的启动组
  8. |;


  9. (defun c:Test(/ FILE_LIST FOLD SF SFF RunNow GetFileList qf_getFolder)
  10. (vl-load-com)
  11. ;_Thanks caoyin
  12. ;_http://bbs.mjtd.com/forum.php?mod=viewthread&tid=69986&replyID=&skin=0
  13. (defun GetFileList (dirName / files lst)
  14. (defun path-addBackSlash (path)
  15. (if (not (member (substr path (strlen path)) '("\" "/")))
  16. (strcat path "\")
  17. path
  18. )
  19. )
  20. (setq dirName (path-addBackSlash dirName)
  21. files (mapcar '(lambda (x) (strcat dirName x))
  22. (vl-directory-files dirName "*.dwg" 1)
  23. )
  24. )
  25. (mapcar '(lambda (x)
  26. (setq lst (append lst (GetFileList (strcat dirName x))))
  27. )
  28. (vl-remove-if
  29. '(lambda (x) (member x '("." "..")))
  30. (vl-directory-files dirName nil -1)
  31. )
  32. )
  33. (append files lst)
  34. )
  35. ;; 本代码仅提供作为应用上的参考, 而未声明或隐含任何保证; 对于任何特殊
  36. ;; 用途之适应性, 以及商业销售所隐含作出的保证, 在此一概予以否认.
  37. ;; ========================================================
  38. ;; 作者:秋枫,参考了灯火的VBA程序
  39. ;; 用法:(qf_getFolder msg)
  40. ;; 例子:(qf_getFolder "选择文件夹:")
  41. ;; 返回值:字符串,文件夹路径,如果点了cancel, 返回nil
  42. ;; http://www.mjtd.com/Functions/ArticleShow.asp?ArticleID=302
  43. (defun qf_getFolder (msg / WinShell shFolder path catchit)
  44. (vl-load-com)
  45. (setq winshell (vlax-create-object "Shell.Application"))
  46. (setq shFolder (vlax-invoke-method WinShell 'BrowseForFolder 0 msg 1))
  47. (setq
  48. catchit (vl-catch-all-apply
  49. '(lambda ()
  50. (setq shFolder (vlax-get-property shFolder 'self))
  51. (setq path (vlax-get-property shFolder 'path))
  52. )
  53. )
  54. )
  55. (if (vl-catch-all-error-p catchit)
  56. nil
  57. path
  58. )
  59. )
  60. (setq fold (qf_getFolder "选择文件所在目录:"))
  61. (if fold
  62. (progn
  63. (setq file_list (GetFileList fold))
  64. (if file_list
  65. (progn
  66. (setq sf (strcat (getvar "TEMPPREFIX") "批处理文件20100806.scr"))
  67. (setq sff (open sf "w"))
  68. (mapcar '(lambda (x)
  69. ;;;           (princ (strcat "open "" x ""\n" "zoom e qsave close\n") sff)
  70. (princ (strcat "open "" x ""\n" "zoom e (changeblockcolorto7) qsave close\n") sff)
  71. )
  72. file_list
  73. )
  74. (close sff)
  75. (princ (strcat "\n目录下" fold "\n\t共有DWG文件数: " (itoa (length file_list))))
  76. (initget "Y N")
  77. (setq RunNow (getkword "\n是否立刻执行[是(Y)/否(N)]:<否>"))
  78. (if (= RunNow "Y")
  79. (progn
  80. (command "._script" sf)
  81. (princ "\n处理完成")
  82. )
  83. (princ "\n放弃立刻执行")
  84. )
  85. )
  86. (princ "\n目录下没有DWG文件")
  87. )
  88. )
  89. (princ "\n请选择目录")
  90. )
  91. (princ)
  92. )

  93. ;;_修改颜色
  94. (defun changeblockcolorto7 (/ SS ENAME I)
  95. (setq ss (ssget "x" (list (cons -4 "<not") (cons 0 "INSERT") (cons -4 "not>"))))
  96. (if ss
  97. (progn
  98. (command "change" ss "" "p" "c" 7 "")
  99. )
  100. )
  101. (setq ss (ssget "x" '((0 . "INSERT"))))
  102. (if ss
  103. (progn
  104. (setq i -1)
  105. (while (setq ename (ssname ss (setq i (1+ i))))
  106. (BLK_COL ename 7)
  107. )
  108. )
  109. )
  110. )
  111. ;;BY LUCAS(龙龙仔)
  112. ;;把图块顏色改为byblock(供参考)
  113. ;;不同的这个块的顏色不一样
  114. ;;(不包括属性,标註,引线,公差-------通常我会保留这些给网友自行解决)
  115. ;;_(BLK_COL ename color) (BLK_COL (car (entsel)) 7)
  116. (defun BLK_COL (ent clr / EG2 EN2 EN3 NAM NM2 CHBLK)
  117. (defun CHBLK (EN2 NAM CLR)
  118. (while EN2
  119. (setq EG2        (entget EN2)
  120. EN2        (entnext (cdr (assoc -1 EG2)))
  121. )
  122. (if (assoc 62 EG2)
  123. (setq EG2 (subst (cons 62 CLR) (assoc 62 EG2) EG2))
  124. (setq EG2 (append EG2 (list (cons 62 CLR))))
  125. )
  126. (entmod EG2)
  127. (if (= (cdr (assoc 0 EG2)) "INSERT")
  128. (progn
  129. (setq        NM2 (cdr (assoc 2 EG2))
  130. EN3 (cdr (assoc -2 (tblsearch "block" NM2)))
  131. )
  132. (CHBLK EN3 NM2 CLR)
  133. )
  134. )
  135. )
  136. (setvar "cmdecho" 1)
  137. (princ)
  138. )
  139. (setvar "cmdecho" 0)
  140. ;;;  (if (setq ENT (entsel "\nSelect blocks that needs color changed: "))
  141. (if ENT
  142. (progn
  143. ;;;      (setq CLR (acad_colordlg 7))
  144. (setq NAM (cdr (assoc 2 (entget ENT))))
  145. (setq EN2 (cdr (assoc -2 (tblsearch "block" NAM))))
  146. (CHBLK EN2 NAM 0)
  147. (setq EG2 (entget ENT))
  148. (if (assoc 62 EG2)
  149. (setq EG2 (subst (cons 62 CLR) (assoc 62 EG2) EG2))
  150. (setq EG2 (append EG2 (list (cons 62 CLR))))
  151. )
  152. (entmod EG2)
  153. (entupd ENT)
  154. )
  155. )
  156. (princ)
  157. )
回复

使用道具 举报

发表于 2013-3-10 00:12 | 显示全部楼层
图纸变白是什么意思 ?是所有的图元的颜色 包括块内的图元的颜色修改为白色?
回复

使用道具 举报

 楼主| 发表于 2013-3-12 10:48 | 显示全部楼层
gufeng 发表于 2013-3-10 00:12
图纸变白是什么意思 ?是所有的图元的颜色 包括块内的图元的颜色修改为白色?

嗯,是的,能把文件夹里面的CAD图都变黑白
回复

使用道具 举报

发表于 2013-3-13 15:30 | 显示全部楼层
gufeng 发表于 2013-3-12 17:16

谢谢楼上的分享!
先收藏,再试试,学习学习。
回复

使用道具 举报

 楼主| 发表于 2013-3-13 17:04 | 显示全部楼层
gufeng 发表于 2013-3-5 09:32

我看了下,还需要多回复帖子才能看到,谢谢,先收藏起来
回复

使用道具 举报

发表于 2013-3-13 21:08 | 显示全部楼层
回帖看下!
回复

使用道具 举报

发表于 2014-3-28 09:02 来自手机 | 显示全部楼层
我来看一下
回复

使用道具 举报

您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号 )  
©2000-2023 明经通道 版权所有 本站代码,在未取得本站及作者授权的情况下,不得用于商业用途

GMT+8, 2024-3-29 13:13 , Processed in 0.280859 second(s), 26 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

快速回复 返回顶部 返回列表