设为首页收藏本站转
发帖领奖家园QQ群申请版主版主评价切换到宽版

 找回密码
 立即注册

QQ登录

只需一步，快速开始

扫一扫，访问微社区

晓东CAD家园-论坛»论坛 › ╃CAD编程开发 › A/VLISP › 【炫翔】批量多种改层色
返回列表 发新帖
查看: 1685|回复: 9

[原创] 【炫翔】批量多种改层色

[复制链接]
炫翔

已领礼包: 1742个

财富等级: 堆金积玉
发表于 2013-8-16 09:34:25 | 显示全部楼层 |阅读模式
【广而告之】积分规则、D豆获取攻略       窝窝空间装扮攻略

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要 登录 才可以下载或查看，没有账号？立即注册

×
1.gif
  1. ;功能：取得实体DXF组码对应的值。参数：DXF为组码 ；ent为实体名。;返回值：DXF组码值表
  2. (defun KX-get-dxf (DXF ent)
  3.     (cond ((= (type ent) 'ename)
  4.             (cdr (assoc DXF (entget ent)))
  5.              )
  6.           ((= (type ent) 'list)
  7.            (cdr (assoc DXF ent))
  8.            )
  9.     )
  10. )


  13. ;;功能：更换图元。参数：sname为实体名；DXF为组码；newvalue为新值  ;返回值：新对象
  14. (defun KX-SubUpd (sname DXF newvalue)
  15.    (entmod
  16.      (subst
  17.        (cons DXF newvalue)   
  18.        (assoc DXF (entget sname))   
  19.        (entget sname)
  20.      )
  21.    )
  22. (entupd sname)
  23. )

  25. ;改变对象颜色 sname为实体名 col为颜色号
  26. (defun KX-put-color(sname col)
  27.       (vla-put-color (vlax-ename->vla-object sname) col)
  28. (PRINC)
  29. )

  31. ;批量匹配图层改色
  32. ;(KX-LAY-COL lname COL)  lname为层名  CO为颜色
  33. (defun KX-LAY-COL (lname coL)
  34. (if (setq newl (tblobjname "layer" lname))
  35.    (progn
  36.      (KX-SubUpd newl 62 col)
  37.     (if (SETQ ss (ssget "X" (list (cons 8 lname))))
  38.       (progn
  39.           (setq X -1)
  40.         (while (setq s1 (ssname ss (setq X (1+ X))))      
  41.            (KX-put-color s1 coL)
  42.          )
  43.        )
  44.      )
  45.    )
  46.   )
  47. )



  51. ;程序一 （批量匹配图层改色）
  52. (defun c:XX()
  53.   (vl-load-com)
  54.    (KX-LAY-COL "1" 1)
  55.    (KX-LAY-COL "2" 2)
  56.    (KX-LAY-COL "3" 3)
  57.    (KX-LAY-COL "4" 4)
  58.    (KX-LAY-COL "5" 5)
  59. (PRINC)
  60. )

  62. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  63. ;程序二 （输入层名或直接选对象改其颜色）
  64. (defun c:XX1()
  65.   (vl-load-com)
  66.    (initget "A S")
  67. (setq enda (getkword "\n[A 输入层名 / S 选取对象直接改色] <A>")
  68.        enda (if enda enda "A")
  69.   )
  70.     (cond
  71.        ((= enda "S") (setq lname (strcase (KX-get-dxf 8 (car (entsel)))))
  72.           (setq co (acad_colordlg 7))
  73.            (KX-LAY-COL lname co)
  74.        )
  75.        ((= enda "A") (setq lname (strcase (getstring "\n层名:")))   
  76.             (setq co (acad_colordlg 7))
  77.            (KX-LAY-COL lname co)))
  78. (PRINC)
  79. )

  81. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  82. ;程序三 （综合改层色）
  83. (defun c:XX2()
  84.   (vl-load-com)
  85.    (KX-LAY-COL "1" 1)
  86.    (KX-LAY-COL "2" 2)
  87.    (KX-LAY-COL "3" 3)
  88.    (KX-LAY-COL "4" 4)
  89.    (KX-LAY-COL "5" 5)
  90.    (initget "A S")
  91. (setq enda (getkword "\n[A 输入层名 / S 选取对象直接改色] <A>")
  92.        enda (if enda enda "A")
  93.   )
  94.     (cond
  95.        ((= enda "S") (setq lname (strcase (KX-get-dxf 8 (car (entsel)))))
  96.           (setq co (acad_colordlg 7))
  97.            (KX-LAY-COL lname co)
  98.        )
  99.        ((= enda "A") (setq lname (strcase (getstring "\n层名:")))   
  100.         (setq co (acad_colordlg 7))
  101.                (KX-LAY-COL lname co)
  102.        )
  103.     )
  104. (PRINC)
  105. )

论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复

使用道具 举报

Free-Lancer
发表于 2013-8-16 11:15:38 | 显示全部楼层
不用这么复杂吧，修改 Layer Object 的 Color ，实体用 chprop 修改实体为 bylayer

点评

炫翔
方法很多的，这个只是不用COMMAND  发表于 2013-8-16 11:21
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

Free-Lancer
发表于 2013-8-16 12:13:07 | 显示全部楼层
【广而告之】积分规则、D豆获取攻略       窝窝空间装扮攻略
有时候 Command 的效率比别的都高!

点评

ysq101
从来不用图层的学习一下  详情 回复 发表于 2013-8-17 11:56
炫翔
这倒是真的，比如:删除  发表于 2013-8-16 13:33
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

ysq101

已领礼包: 685个

财富等级: 财运亨通
发表于 2013-8-17 11:56:55 | 显示全部楼层
Free-Lancer 发表于 2013-8-16 12:13
有时候 Command 的效率比别的都高!

从来不用图层的学习一下

点评

newer
如同你从来都不用图层的话，说明你CAD还没入门呢。  详情 回复 发表于 2013-8-17 12:30
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

sicky111

已领礼包: 6468个

财富等级: 富甲天下
发表于 2013-8-17 12:04:22 | 显示全部楼层
【广而告之】积分规则、D豆获取攻略       窝窝空间装扮攻略
学习方法。
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复

使用道具 举报

newer

已领礼包: 40个

财富等级: 招财进宝
发表于 2013-8-17 12:30:22 | 显示全部楼层
ysq101 发表于 2013-8-17 11:56
从来不用图层的学习一下

如同你从来都不用图层的话，说明你CAD还没入门呢。

点评

ysq101
话不能这么说吧。。。CAD从R12用到现在还没入门？？？ 用不用图层只是个人习惯和行业不同而已，我更喜欢用颜色来管理对象，省去管理设置图层 （我是模具行业，除了标注是用燕秀来标，自己分到标注层）  详情 回复 发表于 2013-8-17 17:29
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

ysq101

已领礼包: 685个

财富等级: 财运亨通
发表于 2013-8-17 17:29:56 | 显示全部楼层
【广而告之】积分规则、D豆获取攻略       窝窝空间装扮攻略
newer 发表于 2013-8-17 12:30
如同你从来都不用图层的话，说明你CAD还没入门呢。

话不能这么说吧。。。CAD从R12用到现在还没入门？？？
用不用图层只是个人习惯和行业不同而已，我更喜欢用颜色来管理对象，省去管理设置图层

（我是模具行业，除了标注是用燕秀来标，自己分到标注层）
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

hodnes
发表于 2013-8-18 12:38:47 | 显示全部楼层
好东西啊，谢谢分享~~~~~~~~~~~~~
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

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

本版积分规则

QQ|申请友链|Archiver|手机版|小黑屋|辽公网安备|晓东CAD家园 ( 辽ICP备15016793号 )

GMT+8, 2024-5-1 23:57 , Processed in 0.240472 second(s), 46 queries , Gzip On.

Powered by Discuz! X3.5

© 2001-2024 Discuz! Team.

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