找回密码
 立即注册

QQ登录

只需一步,快速开始

扫一扫,访问微社区

查看: 3800|回复: 52

[每日一码] 修改实体(包括块内实体)的颜色

  [复制链接]

已领礼包: 51个

财富等级: 招财进宝

发表于 2016-9-5 09:53:55 | 显示全部楼层 |阅读模式

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

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

×
修改实体或块内实体的颜色

[it618postdisplay>0]
  1. ;修改实体和图块内的颜色
  2. (defun c:blcc () (pl:block-color) (princ))
  3. (defun c:encc () (pl:block-ent-color) (princ))


[/it618postdisplay]
  1. (vl-load-com)
  2. (defun pl:block-ent-color (/ adoc blocks color ent lays)
  3.     (setq adoc  (vla-get-activedocument (vlax-get-acad-object))
  4.           lays  (vla-get-layers adoc)
  5.           color (acad_colordlg 256)
  6.     )
  7.     (if color
  8.         (progn (setvar "errno" 0)
  9.                (vla-startundomark adoc)
  10.                (while (and (not (vl-catch-all-error-p
  11.                                     (setq ent (vl-catch-all-apply
  12.                                                   (function nentsel)
  13.                                                   '("\nSelect entity <Exit>:")
  14.                                               )
  15.                                     )
  16.                                 )
  17.                            )
  18.                            (/= 52 (getvar "errno"))
  19.                       )
  20.                    (if ent
  21.                        (progn (setq ent (vlax-ename->vla-object (car ent))
  22.                                     lay (vla-item lays (vla-get-layer ent))
  23.                               )
  24.                               (if (= (vla-get-lock lay) :vlax-true)
  25.                                   (progn (setq layloc (cons lay layloc))
  26.                                          (vla-put-lock lay :vlax-false)
  27.                                   )
  28.                               )
  29.                               (vl-catch-all-apply (function vla-put-color) (list ent color))
  30.                               (vla-regen adoc acallviewports)
  31.                        )
  32.                        (princ "\nNothing selection! Try again.")
  33.                    )
  34.                )
  35.                (foreach i layloc (vla-put-lock i :vlax-true))
  36.                (vla-endundomark adoc)
  37.         )
  38.     )
  39.     (princ)
  40. )

  41. (defun pl:block-color (/ adoc blocks color ins lays)
  42.     (setq adoc   (vla-get-activedocument (vlax-get-acad-object))
  43.           blocks (vla-get-blocks adoc)
  44.           lays   (vla-get-layers adoc)
  45.           color  (acad_colordlg 256)
  46.     )
  47.     (if color
  48.         (progn (setvar "errno" 0)
  49.                (vla-startundomark adoc)
  50.                (while (and (not (vl-catch-all-error-p
  51.                                     (setq ins (vl-catch-all-apply
  52.                                                   (function entsel)
  53.                                                   '("\nSelect block <Exit>:")
  54.                                               )
  55.                                     )
  56.                                 )
  57.                            )
  58.                            (/= 52 (getvar "errno"))
  59.                       )
  60.                    (if ins
  61.                        (progn (setq ins (vlax-ename->vla-object (car ins)))
  62.                               (if (= (vla-get-objectname ins) "AcDbBlockReference")
  63.                                   (if (vlax-property-available-p ins 'path)
  64.                                       (princ "\nThis is external reference! Try pick other.")
  65.                                       (progn (_pl:block-color blocks ins color lays)
  66.                                              (vla-regen adoc acallviewports)
  67.                                       )
  68.                                   )
  69.                                   (princ "\nThis isn't block! Try pick other.")
  70.                               )
  71.                        )
  72.                        (princ "\nNothing selection! Try again.")
  73.                    )
  74.                )
  75.                (vla-endundomark adoc)
  76.         )
  77.     )
  78.     (princ)
  79. )

  80. (defun _pl:block-color (blocks ins color lays / lay layfrz layloc)
  81.     (vlax-for e (vla-item blocks (vla-get-name ins))
  82.         (setq lay (vla-item lays (vla-get-layer e)))
  83.         (if (= (vla-get-freeze lay) :vlax-true)
  84.             (progn (setq layfrz (cons lay layfrz)) (vla-put-freeze lay :vlax-false))
  85.         )
  86.         (if (= (vla-get-lock lay) :vlax-true)
  87.             (progn (setq layloc (cons lay layloc)) (vla-put-lock lay :vlax-false))
  88.         )
  89.         (vl-catch-all-apply (function vla-put-color) (list e color))
  90.         (if (and (= (vla-get-objectname e) "AcDbBlockReference")
  91.                  (not (vlax-property-available-p e 'path))
  92.             )
  93.             (_pl:block-color blocks e color lays)
  94.         )
  95.         (foreach i layfrz (vla-put-freeze i :vlax-true))
  96.         (foreach i layloc (vla-put-lock i :vlax-true))
  97.     )
  98. )

  99. (progn
  100. (princ "\BLCC - Changes color of the chosen blocks")
  101. (princ "\nENCC - Changes color of the chosen objects (may be  element of the block)")
  102. (princ))


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

已领礼包: 3198个

财富等级: 富可敌国

发表于 2016-9-5 09:57:33 | 显示全部楼层
看看,向大师学习
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

已领礼包: 5578个

财富等级: 富甲天下

发表于 2016-9-5 09:58:44 | 显示全部楼层
感谢版主!向版主学习!
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

已领礼包: 10个

财富等级: 恭喜发财

发表于 2016-9-5 10:08:07 | 显示全部楼层
向大师学习。
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

已领礼包: 10个

财富等级: 恭喜发财

发表于 2016-9-5 10:18:37 | 显示全部楼层
谢了大师,程序很好用,但是发现不能修改属性的颜色,能不能提供个代码修改下属性的颜色呢?

点评

http://bbs.xdcad.net/thread-705328-1-1.html  详情 回复 发表于 2016-9-5 16:29
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

已领礼包: 51个

财富等级: 招财进宝

发表于 2016-9-5 10:46:29 | 显示全部楼层
这个给力啊
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

已领礼包: 40个

财富等级: 招财进宝

发表于 2016-9-5 11:10:38 | 显示全部楼层
用XDRX API写这个,如下,而且修改完颜色后不会重新生成图形。

  1. (defun c:tt()
  2.    (if (and (setq clr (xdrx_color_select))
  3.             (setq e (xdrx_entsel "\n拾取块实体<退出>:" '((0 . "INSERT"))))
  4.        )
  5.      (progn
  6.        (xdrx_entity_setproperty (xdrx_block_getentities t (car e)) "color" clr)
  7.        (xdrx_block_update (car e))
  8.      )
  9.    )
  10.    (princ)
  11. )


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

使用道具 举报

已领礼包: 3701个

财富等级: 富可敌国

发表于 2016-9-5 13:42:10 | 显示全部楼层
回复学习学习!
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

已领礼包: 2963个

财富等级: 家财万贯

发表于 2016-9-5 14:20:12 | 显示全部楼层
回复学习,快乐学习
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

发表于 2016-9-5 15:39:30 | 显示全部楼层
学习学习~~~~~~~~~~~~~~~~~~~~~~~~~~~~
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复

使用道具 举报

已领礼包: 40个

财富等级: 招财进宝

发表于 2016-9-5 16:29:50 | 显示全部楼层
lisp_beginner 发表于 2016-9-5 10:18
谢了大师,程序很好用,但是发现不能修改属性的颜色,能不能提供个代码修改下属性的颜色呢?

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

使用道具 举报

已领礼包: 8710个

财富等级: 富甲天下

发表于 2016-9-5 17:49:16 | 显示全部楼层
跟Lispboy学习。
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

已领礼包: 194个

财富等级: 日进斗金

发表于 2016-9-11 10:49:58 | 显示全部楼层
测试下功能
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

已领礼包: 67个

财富等级: 招财进宝

发表于 2016-9-17 11:41:33 | 显示全部楼层
向兩位大師致敬!
感謝分享!學習了~~
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

已领礼包: 717个

财富等级: 财运亨通

发表于 2016-9-24 15:59:56 | 显示全部楼层
楼主  真是  高产  
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

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

本版积分规则

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

GMT+8, 2024-3-29 06:36 , Processed in 0.198650 second(s), 57 queries , Gzip On.

Powered by Discuz! X3.5

© 2001-2024 Discuz! Team.

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