设为首页收藏本站CAD论坛CAD教程CAD下载明经币充值
切换到宽版

明经CAD社区

 找回密码
 注册

QQ登录

只需一步，快速开始

搜索
明经CAD社区»社区 › 应用篇 › AutoCAD工具插件 › 请问有没有改变多个图层中所有块的颜色的工具
12下一页
返回列表 发新帖
查看: 4224|回复: 10

请问有没有改变多个图层中所有块的颜色的工具

[复制链接]
cqhaart
发表于 2014-6-12 11:46:49 | 显示全部楼层 |阅读模式
现在想把原始图做为底图，要把图中的所有东西都变成8号灰色，但图中块啊什么的太多，很多改不颜色，要一个一个的改很麻烦，想问问有没有啥工具能一次改，还能把这些东西都集中到一个图层上去的工具呢？
回复

使用道具 举报

edata
发表于 2014-6-12 18:19:49 | 显示全部楼层
  1. (defun c:tt(/ doc ss obj en subobj color ent sk_lay)
  2.   (vl-load-com)
  3.   (setq sk_lay(sk_getdcl))
  4.   (setq color (acad_colordlg 8))  
  5.   (if(and (or sk_lay color)
  6.           (setq ss(ssget))
  7.           )
  8.     (progn
  9.       (setq doc (vla-get-ActiveDocument (vlax-get-acad-object)))
  10.       ;(setq sk_lay "0")      
  11.       (while(setq ent(ssname ss 0))
  12.         (setq obj (vlax-ename->vla-object ent))
  13.         (and sk_lay(vla-put-layer (vlax-ename->vla-object ent) sk_lay))
  14.         (and color(vla-put-color (vlax-ename->vla-object ent) Color))       
  15.         (defun sk_block_col(obj /)
  16.           (vlax-for SubObj                    
  17.                     (vla-item (vla-get-blocks doc)
  18.                               (vla-get-name obj) ;获得块名
  19.                               )      ;获取当前文档中的所有块，按照名字从中找到操作者选择的块，返回块中所有对象的集合
  20.             (and sk_lay(vla-put-layer SubObj sk_lay))
  21.             (if (= (vla-get-ObjectName SubObj) "AcDbBlockReference")             
  22.               (sk_block_col SubObj)
  23.               (progn               
  24.                 (if (= (vla-get-ObjectName SubObj) "AcDbAttributeDefinition")
  25.                   (sk_att_lay_col ENT (vla-get-TagString  SubObj) sk_lay  Color)
  26.                   (and Color(vla-put-color SubObj Color))
  27.                   )               
  28.               )
  29.               ) ;obj依次为块内每一个图元的对象
  30.             )   ;调用自己，递归，遍历引用中的每层引用
  31.           )
  32.         (if (= (vla-get-ObjectName obj) "AcDbBlockReference") (progn (sk_block_col obj)))       
  33.         (setq ss (ssdel ent ss))
  34.       )
  35.       (vla-regen doc 1)
  36.       (vlax-release-object obj)
  37.       (vlax-release-object doc)
  38.     )  
  39.   )  
  40.   (princ)
  41.   )
  42. (defun sk_getdcl(/ lay_lst sk_lay dcl f s sk_lay_index DCL_ID )
  43.   (vlax-map-collection (vla-get-Layers (vla-get-activedocument (vlax-get-acad-object))) '(lambda (x) (setq lay_lst (cons (vla-get-name x) lay_lst))))
  44.   (setq lay_lst (reverse(mapcar 'vl-princ-to-string lay_lst)))
  45.   (setq DCL (vl-filename-mktemp nil nil ".Lsp"))
  46.         (setq f (open dcl "w"))
  47.         (foreach s '("ch_block_color:dialog {"
  48.                      "    label = \"参数设置\" ;"
  49.                      "    :boxed_row {"
  50.                      "        label = \"设置\" ;"
  51.                      "        :list_box {"
  52.                      "            fixed_height = true ;"
  53.                      "            fixed_width = true ;"
  54.                      "            height = 24 ;"
  55.                      "            label = \"图层选择\" ;"
  56.                      "            width = 30 ;"
  57.                      "            key = sk_lay ;"
  58.                      "       }"
  59.                      "    }"
  60.                      "ok_cancel;"
  61.                      "}"
  62.                     )
  63.           (write-line s f)
  64.         )
  65.         (close f)
  66.   (setq DCL_ID (load_dialog DCL))
  67.   (vl-file-delete dcl)
  68.    (new_dialog "ch_block_color" DCL_ID)
  69.    (start_list "sk_lay")
  70.    (mapcar 'add_list lay_lst)   
  71.    (end_list)
  72.   (action_tile "accept" "(setq sk_lay_index(get_tile \"sk_lay\"))(done_dialog 1) ")
  73.   (action_tile "cancel" "(done_dialog)")
  74.   (start_dialog )
  75.   (unload_dialog DCL_ID)  
  76.   (if sk_lay_index
  77.     (setq sk_lay (nth (atoi sk_lay_index) lay_lst)) nil)
  78.   sk_lay
  79.   )

  81. ;;;日期：zml84 于 2010-05-08                                        *
  82. ;;;日期：modfiy by edata@2014-6-12                                  *
  83. ;;;add layer
  84. (defun sk_att_lay_col (EN ATTNAME sk_lay Color / RETURN E TEST ENT)
  85.   (setq        E EN
  86.         RETURN NIL
  87.         TEST t
  88.   )
  89.   (while (and TEST (setq E (entnext E)))
  90.     (setq ENT (entget E))
  91.     (cond ((not (= (cdr (assoc 0 ENT)) "ATTRIB")) (setq TEST NIL))
  92.           ((= "SEQEND" (cdr (assoc 0 ENT))) (setq TEST NIL))
  93.           ((= (cdr (assoc 2 ENT)) ATTNAME)
  94.            (and sk_lay(setq ENT (subst(cons 8 sk_lay)(assoc 8 ENT) ENT)))
  95.             (if (and Color(assoc 62 ENT))
  96.              (setq ENT (subst(cons 62 Color)(assoc 62 ENT) ENT))
  97.              (setq ENT (cons (cons 62 Color) ENT))
  98.            )
  99.            (entmod ENT)
  100.            (entupd EN)
  101.            (setq RETURN t)
  102.           )
  103.     )
  104.   )
  105.   RETURN
  106.   )

评分

参与人数 1明经币 +1 收起 理由
lucas_3333 + 1 乐于助人奖！

查看全部评分

回复 支持 反对

使用道具 举报

cqhaart
 楼主| 发表于 2014-6-13 13:26:53 | 显示全部楼层
有点高端了，慢慢看怎么用
回复 支持 反对

使用道具 举报

cqhaart
 楼主| 发表于 2014-6-13 13:54:47 | 显示全部楼层
这代码如何用呢，还真不知道
回复 支持 反对

使用道具 举报

cqhaart
 楼主| 发表于 2014-6-13 14:04:35 | 显示全部楼层
不错，会用了，谢谢，很好用
回复 支持 反对

使用道具 举报

yiqisese
发表于 2014-10-16 12:52:56 | 显示全部楼层
整理图纸的时候用的上
回复 支持 反对

使用道具 举报

蘇_小粒
发表于 2015-1-27 16:30:10 | 显示全部楼层
可以用吗？我想找一个可以吧嵌套块全部批量改0层的lsp，不懂论坛有没有，没怎么搜到
回复 支持 反对

使用道具 举报

＿Levin
发表于 2015-7-28 20:20:08 | 显示全部楼层
edata 发表于 2014-6-12 18:19

请问下大神，能不能做到不要对话框呢？（有对话框感觉点来点去，速度就慢了）图层直接弄到2图层，颜色250，加个DASH虚线进去，线型比例是15，要怎么做呢？
回复 支持 反对

使用道具 举报

edata
发表于 2015-7-29 15:45:01 | 显示全部楼层
如果没有线型则需要加载，我只改了自动生成dashed（acadiso.lin）.
需要其他线型需要自行加载。
  1. (defun c:tt(/ doc ss obj en subobj color ent sk_lay sk_ltype sk_ltscale)
  2.   (vl-load-com)
  3.   (setq sk_lay "2")
  4.   (setq color 250)
  5.   (setq sk_ltype "dashed")
  6.   (setq sk_ltscale 15)
  7.   (if(and (or (and sk_lay (tblobjname "layer" sk_lay))  color)
  8.           (setq ss(ssget))
  9.           )
  10.     (progn
  11.       (or (tblobjname "layer" sk_lay) (setq sk_lay nil))
  12.       (or (tblobjname "ltype" sk_ltype)
  13.           (entmake
  14.             '((0 . "LTYPE")
  15.               (5 . "23D")
  16.               (100 . "AcDbSymbolTableRecord")
  17.               (100 . "AcDbLinetypeTableRecord")
  18.               (2 . "DASHED")
  19.               (70 . 0)
  20.               (3 . "Dashed __ __ __ __ __ __ __ __ __ __ __ __ __ _")
  21.               (72 . 65)
  22.               (73 . 2)
  23.               (40 . 19.05)
  24.               (49 . 12.7)
  25.               (74 . 0)
  26.               (49 . -6.35)
  27.               (74 . 0)
  28.              )
  29.           ))
  30.       (or (tblobjname "ltype" sk_ltype) (setq sk_ltype nil))
  31.       (setq doc (vla-get-ActiveDocument (vlax-get-acad-object)))
  32.       ;(setq sk_lay "0")      
  33.       (while(setq ent(ssname ss 0))
  34.         (setq obj (vlax-ename->vla-object ent))
  35.         (and sk_lay(vla-put-layer (vlax-ename->vla-object ent) sk_lay))
  36.         (and color(vla-put-color (vlax-ename->vla-object ent) Color))
  37.         (and sk_ltype(vla-put-linetype (vlax-ename->vla-object ent) sk_ltype))
  38.         (and sk_ltscale(vla-put-linetypescale (vlax-ename->vla-object ent) sk_ltscale))
  39.         (defun sk_block_col(obj /)
  40.           (vlax-for SubObj                    
  41.                     (vla-item (vla-get-blocks doc)
  42.                               (vla-get-name obj) ;获得块名
  43.                               )      ;获取当前文档中的所有块，按照名字从中找到操作者选择的块，返回块中所有对象的集合
  44.             (and sk_lay(vla-put-layer SubObj sk_lay))
  45.             (and sk_ltype(vla-put-linetype SubObj sk_ltype))
  46.             (and sk_ltscale(vla-put-linetypescale SubObj sk_ltscale))
  47.             (if (= (vla-get-ObjectName SubObj) "AcDbBlockReference")              
  48.               (sk_block_col SubObj)
  49.               (progn               
  50.                 (if (= (vla-get-ObjectName SubObj) "AcDbAttributeDefinition")
  51.                   (sk_att_lay_col ENT (vla-get-TagString  SubObj) sk_lay  Color)
  52.                   (and Color(vla-put-color SubObj Color))
  53.                   )               
  54.               )
  55.               ) ;obj依次为块内每一个图元的对象
  56.             )   ;调用自己，递归，遍历引用中的每层引用
  57.           )
  58.         (if (= (vla-get-ObjectName obj) "AcDbBlockReference") (progn (sk_block_col obj)))        
  59.         (setq ss (ssdel ent ss))
  60.       )
  61.       (vla-regen doc 1)
  62.       (vlax-release-object obj)
  63.       (vlax-release-object doc)
  64.     )  
  65.   )  
  66.   (princ)
  67.   )


  70. ;;;日期：zml84 于 2010-05-08                                        *
  71. ;;;日期：modfiy by edata@2014-6-12                                  *
  72. ;;;add layer
  73. (defun sk_att_lay_col (EN ATTNAME sk_lay Color / RETURN E TEST ENT)
  74.   (setq        E EN
  75.         RETURN NIL
  76.         TEST t
  77.   )
  78.   (while (and TEST (setq E (entnext E)))
  79.     (setq ENT (entget E))
  80.     (cond ((not (= (cdr (assoc 0 ENT)) "ATTRIB")) (setq TEST NIL))
  81.           ((= "SEQEND" (cdr (assoc 0 ENT))) (setq TEST NIL))
  82.           ((= (cdr (assoc 2 ENT)) ATTNAME)
  83.            (and sk_lay(setq ENT (subst(cons 8 sk_lay)(assoc 8 ENT) ENT)))
  84.             (if (and Color(assoc 62 ENT))
  85.              (setq ENT (subst(cons 62 Color)(assoc 62 ENT) ENT))
  86.              (setq ENT (cons (cons 62 Color) ENT))
  87.            )
  88.            (entmod ENT)
  89.            (entupd EN)
  90.            (setq RETURN t)
  91.           )
  92.     )
  93.   )
  94.   RETURN
  95.   )
回复 支持 反对

使用道具 举报

＿Levin
发表于 2015-7-30 17:38:18 | 显示全部楼层
edata 发表于 2015-7-29 15:45
如果没有线型则需要加载，我只改了自动生成dashed（acadiso.lin）.
需要其他线型需要自行加载。

大师，想把原始图做为底图，一般都是复制一份在旁边的，刚才试了下你这个，已经接近完美了，但原图的图块也跟着变成了250色[em0]，能否把选中的块也改名（例如加 _222防止跟其他块重名）主要是不想变的同名图块也跟着变色了。。，可以再修改一下的话，就完美了
回复 支持 反对

使用道具 举报

12下一页
返回列表 发新帖
高级模式
B Color Image Link Quote Code Smilies
您需要登录后才可以回帖 登录 | 注册

本版积分规则

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

GMT+8, 2024-11-25 18:00 , Processed in 0.196878 second(s), 25 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

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