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

明经CAD社区

 找回密码
 注册

QQ登录

只需一步，快速开始

搜索
明经CAD社区»社区 › 开发篇 › AutoLISP/Visual LISP 编程技术 › 一键将所有选择内容更改为251号颜色，含所有块、块内文 ...
12下一页
返回列表 发新帖
查看: 2270|回复: 13

[源码] 一键将所有选择内容更改为251号颜色，含所有块、块内文字、尺寸标志及所有尺寸内容

  [复制链接]
小毛草
发表于 2025-1-17 13:39:56 | 显示全部楼层 |阅读模式
本帖最后由 小毛草 于 2025-1-22 18:26 编辑

  2. (defun c:ts (/ ss doc blks)
  3.   (vl-load-com) ; 加载 ActiveX 支持
  4.   (setvar "cmdecho" 0) ; 关闭命令回显

  6.   ;; 解锁所有图层
  7.   (command "layer" "u" "*" "s" "0" "")

  9.   ;; 获取当前文档和块集合
  10.   (setq doc (vla-get-ActiveDocument (vlax-get-acad-object)))
  11.   (setq blks (vla-get-blocks doc))

  13.   ;; 遍历所有块并修改块名为 _archtick 的块颜色
  14.   (vlax-for blk blks
  15.     (if (= (vla-get-name blk) "_archtick")
  16.       (vlax-for obj blk
  17.         (vla-put-color obj 251) ; 修改块内对象颜色
  18.       )
  19.     )
  20.   )

  22.   ;; 选择对象
  23.   (setq ss (ssget)) ; 选择对象

  25.   ;; 如果选择集不为空
  26.   (if ss
  27.     (progn
  28.       ;; 遍历选择集并修改颜色
  29.       (vlax-for obj (vla-get-ActiveSelectionSet doc)
  30.         (ChColor obj) ; 调用递归函数修改颜色
  31.       )
  32.       ;; 清除选择集
  33.       (vla-delete (vla-get-ActiveSelectionSet doc))
  34.       (princ "\n所有选择对象颜色已修改为 251 号色。")
  35.     )
  36.     (princ "\n未选择到任何对象。")
  37.   )
  38.   (princ)
  39. )

  41. ;; 递归函数：修改对象及其子对象的颜色
  42. (defun ChColor (obj / blkName)
  43.   ;; 修改当前对象的颜色
  44.   (vla-put-color obj 251)

  46.   ;; 如果是块参照，递归处理块内的对象
  47.   (if (and (= (vla-get-ObjectName obj) "AcDbBlockReference")
  48.            (setq blkName (vla-get-name obj)))
  49.     (progn
  50.       ;; 递归处理块内对象
  51.       (vlax-for subObj (vla-item blks blkName)
  52.         (ChColor subObj) ; 递归处理块内对象
  53.       )
  54.       ;; 处理块内的属性文字
  55.       (if (= (vla-get-HasAttributes obj) :vlax-true)
  56.         (foreach att (vlax-invoke obj 'GetAttributes)
  57.           (vla-put-color att 251) ; 修改属性文字颜色
  58.         )
  59.       )
  60.     )
  61.   )

  63.   ;; 如果是属性文字，修改颜色
  64.   (if (= (vla-get-ObjectName obj) "AcDbAttributeDefinition")
  65.     (vla-put-color obj 251)
  66.   )

  68.   ;; 如果是多行文字或单行文字，修改颜色
  69.   (if (wcmatch (vla-get-ObjectName obj) "*Text")
  70.     (vla-put-color obj 251)
  71.   )

  73.   ;; 如果是尺寸标注，修改尺寸线、尺寸文字、尺寸界线等颜色
  74.   (if (wcmatch (vla-get-ObjectName obj) "*Dimension")
  75.     (progn
  76.       (vla-put-DimensionLineColor obj 251) ; 尺寸线颜色
  77.       (vla-put-ExtensionLineColor obj 251) ; 尺寸界线颜色
  78.       (vla-put-TextColor obj 251) ; 尺寸文字颜色
  79.     )
  80.   )

  82.   ;; 如果是天正自定义对象，修改颜色
  83.   (if (IsTCHObject obj) ; 判断是否为天正自定义对象
  84.     (progn
  85.       (vla-put-color obj 251) ; 修改天正自定义对象颜色
  86.       ;; 如果是天正块参照，递归处理块内对象
  87.       (if (and (= (vla-get-ObjectName obj) "AcDbBlockReference")
  88.                (setq blkName (vla-get-name obj)))
  89.         (vlax-for subObj (vla-item blks blkName)
  90.           (ChColor subObj) ; 递归处理块内对象
  91.         )
  92.       )
  93.     )
  94.   )
  95. )

  97. ;; 判断是否为天正自定义对象
  98. (defun IsTCHObject (obj)
  99.   ;; 天正自定义对象通常以 "TCH_" 开头
  100.   (wcmatch (vla-get-ObjectName obj) "*TCH_*")
  101. )

(defun c:ts (/ ss doc blks)
  (vl-load-com) ; 加载 ActiveX 支持
  (setvar "cmdecho" 0) ; 关闭命令回显

  ;; 解锁所有图层
  (command "layer" "u" "*" "s" "0" "")

  ;; 获取当前文档和块集合
  (setq doc (vla-get-ActiveDocument (vlax-get-acad-object)))
  (setq blks (vla-get-blocks doc))

  ;; 遍历所有块并修改块名为 _archtick 的块颜色
  (vlax-for blk blks
    (if (= (vla-get-name blk) "_archtick")
      (vlax-for obj blk
        (vla-put-color obj 251) ; 修改块内对象颜色
      )
    )
  )

  ;; 选择对象
  (setq ss (ssget)) ; 选择对象

  ;; 如果选择集不为空
  (if ss
    (progn
      ;; 遍历选择集并修改颜色
      (vlax-for obj (vla-get-ActiveSelectionSet doc)
        (ChColor obj) ; 调用递归函数修改颜色
      )
      ;; 清除选择集
      (vla-delete (vla-get-ActiveSelectionSet doc))
      (princ "\n所有选择对象颜色已修改为 251 号色。")
    )
    (princ "\n未选择到任何对象。")
  )
  (princ)
)

;; 递归函数：修改对象及其子对象的颜色
(defun ChColor (obj / blkName)
  ;; 修改当前对象的颜色
  (vla-put-color obj 251)

  ;; 如果是块参照，递归处理块内的对象
  (if (and (= (vla-get-ObjectName obj) "AcDbBlockReference")
           (setq blkName (vla-get-name obj)))
    (progn
      ;; 递归处理块内对象
      (vlax-for subObj (vla-item blks blkName)
        (ChColor subObj) ; 递归处理块内对象
      )
      ;; 处理块内的属性文字
      (if (= (vla-get-HasAttributes obj) :vlax-true)
        (foreach att (vlax-invoke obj 'GetAttributes)
          (vla-put-color att 251) ; 修改属性文字颜色
        )
      )
    )
  )

  ;; 如果是属性文字，修改颜色
  (if (= (vla-get-ObjectName obj) "AcDbAttributeDefinition")
    (vla-put-color obj 251)
  )

  ;; 如果是多行文字或单行文字，修改颜色
  (if (wcmatch (vla-get-ObjectName obj) "*Text")
    (vla-put-color obj 251)
  )

  ;; 如果是尺寸标注，修改尺寸线、尺寸文字、尺寸界线等颜色
  (if (wcmatch (vla-get-ObjectName obj) "*Dimension")
    (progn
      (vla-put-DimensionLineColor obj 251) ; 尺寸线颜色
      (vla-put-ExtensionLineColor obj 251) ; 尺寸界线颜色
      (vla-put-TextColor obj 251) ; 尺寸文字颜色
    )
  )

  ;; 如果是天正自定义对象，修改颜色
  (if (IsTCHObject obj) ; 判断是否为天正自定义对象
    (progn
      (vla-put-color obj 251) ; 修改天正自定义对象颜色
      ;; 如果是天正块参照，递归处理块内对象
      (if (and (= (vla-get-ObjectName obj) "AcDbBlockReference")
               (setq blkName (vla-get-name obj)))
        (vlax-for subObj (vla-item blks blkName)
          (ChColor subObj) ; 递归处理块内对象
        )
      )
    )
  )
)

;; 判断是否为天正自定义对象
(defun IsTCHObject (obj)
  ;; 天正自定义对象通常以 "TCH_" 开头
  (wcmatch (vla-get-ObjectName obj) "*TCH_*")
)

  2. (defun c:ts (/ ss doc blks)
  3.   (vl-load-com) ; 加载 ActiveX 支持
  4.   (setvar "cmdecho" 0) ; 关闭命令回显

  6.   ;; 解锁所有图层
  7.   (command "layer" "u" "*" "s" "0" "")

  9.   ;; 获取当前文档和块集合
  10.   (setq doc (vla-get-ActiveDocument (vlax-get-acad-object)))
  11.   (setq blks (vla-get-blocks doc))

  13.   ;; 遍历所有块并修改块名为 _archtick 的块颜色
  14.   (vlax-for blk blks
  15.     (if (= (vla-get-name blk) "_archtick")
  16.       (vlax-for obj blk
  17.         (vla-put-color obj 251) ; 修改块内对象颜色
  18.       )
  19.     )
  20.   )

  22.   ;; 选择对象
  23.   (setq ss (ssget)) ; 选择对象

  25.   ;; 如果选择集不为空
  26.   (if ss
  27.     (progn
  28.       ;; 遍历选择集并修改颜色
  29.       (vlax-for obj (vla-get-ActiveSelectionSet doc)
  30.         (ChColor obj) ; 调用递归函数修改颜色
  31.       )
  32.       ;; 清除选择集
  33.       (vla-delete (vla-get-ActiveSelectionSet doc))
  34.       (princ "\n所有选择对象颜色已修改为 251 号色。")
  35.     )
  36.     (princ "\n未选择到任何对象。")
  37.   )
  38.   (princ)
  39. )

  41. ;; 递归函数：修改对象及其子对象的颜色
  42. (defun ChColor (obj / blkName)
  43.   ;; 修改当前对象的颜色
  44.   (vla-put-color obj 251)

  46.   ;; 如果是块参照，递归处理块内的对象
  47.   (if (and (= (vla-get-ObjectName obj) "AcDbBlockReference")
  48.            (setq blkName (vla-get-name obj)))
  49.     (progn
  50.       ;; 递归处理块内对象
  51.       (vlax-for subObj (vla-item blks blkName)
  52.         (ChColor subObj) ; 递归处理块内对象
  53.       )
  54.       ;; 处理块内的属性文字
  55.       (if (= (vla-get-HasAttributes obj) :vlax-true)
  56.         (foreach att (vlax-invoke obj 'GetAttributes)
  57.           (vla-put-color att 251) ; 修改属性文字颜色
  58.         )
  59.       )
  60.     )
  61.   )

  63.   ;; 如果是属性文字，修改颜色
  64.   (if (= (vla-get-ObjectName obj) "AcDbAttributeDefinition")
  65.     (vla-put-color obj 251)
  66.   )

  68.   ;; 如果是多行文字或单行文字，修改颜色
  69.   (if (wcmatch (vla-get-ObjectName obj) "*Text")
  70.     (vla-put-color obj 251)
  71.   )

  73.   ;; 如果是尺寸标注，修改尺寸线、尺寸文字、尺寸界线等颜色
  74.   (if (wcmatch (vla-get-ObjectName obj) "*Dimension")
  75.     (progn
  76.       (vla-put-DimensionLineColor obj 251) ; 尺寸线颜色
  77.       (vla-put-ExtensionLineColor obj 251) ; 尺寸界线颜色
  78.       (vla-put-TextColor obj 251) ; 尺寸文字颜色
  79.     )
  80.   )

  82.   ;; 如果是天正自定义对象，修改颜色
  83.   (if (IsTCHObject obj) ; 判断是否为天正自定义对象
  84.     (progn
  85.       (vla-put-color obj 251) ; 修改天正自定义对象颜色
  86.       ;; 如果是天正块参照，递归处理块内对象
  87.       (if (and (= (vla-get-ObjectName obj) "AcDbBlockReference")
  88.                (setq blkName (vla-get-name obj)))
  89.         (vlax-for subObj (vla-item blks blkName)
  90.           (ChColor subObj) ; 递归处理块内对象
  91.         )
  92.       )
  93.     )
  94.   )
  95. )

  97. ;; 判断是否为天正自定义对象
  98. (defun IsTCHObject (obj)
  99.   ;; 天正自定义对象通常以 "TCH_" 开头
  100.   (wcmatch (vla-get-ObjectName obj) "*TCH_*")
  101. )

(defun c:ts (/ ss doc blks)
  (vl-load-com) ; 加载 ActiveX 支持
  (setvar "cmdecho" 0) ; 关闭命令回显


  ;; 解锁所有图层
  (command "layer" "u" "*" "s" "0" "")


  ;; 获取当前文档和块集合
  (setq doc (vla-get-ActiveDocument (vlax-get-acad-object)))
  (setq blks (vla-get-blocks doc))


  ;; 遍历所有块并修改块名为 _archtick 的块颜色
  (vlax-for blk blks
    (if (= (vla-get-name blk) "_archtick")
      (vlax-for obj blk
        (vla-put-color obj 251) ; 修改块内对象颜色
      )
    )
  )


  ;; 选择对象
  (setq ss (ssget)) ; 选择对象


  ;; 如果选择集不为空
  (if ss
    (progn
      ;; 遍历选择集并修改颜色
      (vlax-for obj (vla-get-ActiveSelectionSet doc)
        (ChColor obj) ; 调用递归函数修改颜色
      )
      ;; 清除选择集
      (vla-delete (vla-get-ActiveSelectionSet doc))
      (princ "\n所有选择对象颜色已修改为 251 号色。")
    )
    (princ "\n未选择到任何对象。")
  )
  (princ)
)


;; 递归函数：修改对象及其子对象的颜色
(defun ChColor (obj / blkName)
  ;; 修改当前对象的颜色
  (vla-put-color obj 251)


  ;; 如果是块参照，递归处理块内的对象
  (if (and (= (vla-get-ObjectName obj) "AcDbBlockReference")
           (setq blkName (vla-get-name obj)))
    (progn
      ;; 递归处理块内对象
      (vlax-for subObj (vla-item blks blkName)
        (ChColor subObj) ; 递归处理块内对象
      )
      ;; 处理块内的属性文字
      (if (= (vla-get-HasAttributes obj) :vlax-true)
        (foreach att (vlax-invoke obj 'GetAttributes)
          (vla-put-color att 251) ; 修改属性文字颜色
        )
      )
    )
  )


  ;; 如果是属性文字，修改颜色
  (if (= (vla-get-ObjectName obj) "AcDbAttributeDefinition")
    (vla-put-color obj 251)
  )


  ;; 如果是多行文字或单行文字，修改颜色
  (if (wcmatch (vla-get-ObjectName obj) "*Text")
    (vla-put-color obj 251)
  )


  ;; 如果是尺寸标注，修改尺寸线、尺寸文字、尺寸界线等颜色
  (if (wcmatch (vla-get-ObjectName obj) "*Dimension")
    (progn
      (vla-put-DimensionLineColor obj 251) ; 尺寸线颜色
      (vla-put-ExtensionLineColor obj 251) ; 尺寸界线颜色
      (vla-put-TextColor obj 251) ; 尺寸文字颜色
    )
  )


  ;; 如果是天正自定义对象，修改颜色
  (if (IsTCHObject obj) ; 判断是否为天正自定义对象
    (progn
      (vla-put-color obj 251) ; 修改天正自定义对象颜色
      ;; 如果是天正块参照，递归处理块内对象
      (if (and (= (vla-get-ObjectName obj) "AcDbBlockReference")
               (setq blkName (vla-get-name obj)))
        (vlax-for subObj (vla-item blks blkName)
          (ChColor subObj) ; 递归处理块内对象
        )
      )
    )
  )
)


;; 判断是否为天正自定义对象
(defun IsTCHObject (obj)
  ;; 天正自定义对象通常以 "TCH_" 开头
  (wcmatch (vla-get-ObjectName obj) "*TCH_*")
)

"觉得好，就打赏"
打赏
还没有人打赏，支持一下
回复

使用道具 举报

小毛草
 楼主| 发表于 2025-1-17 14:05:34 | 显示全部楼层
本帖最后由 小毛草 于 2025-1-25 11:20 编辑

应该可以框选的，我这边用2016是可以框选多个进行选择的,还可以用下面这个一键恢复原有颜色！可以试一下！

复制代码
  2. (defun c:s11 (/ ss doc blks)
  3.   (vl-load-com) ; 加载 ActiveX 支持
  4.   (setvar "cmdecho" 0) ; 关闭命令回显

  6.   ;; 获取当前文档和块集合
  7.   (setq doc (vla-get-ActiveDocument (vlax-get-acad-object))
  8.         blks (vla-get-blocks doc))

  10.   ;; 提示用户选择对象
  11.   (princ "选择对象颜色随层: ")
  12.   (setq ss (ssget)) ; 选择对象

  14.   ;; 如果选择集不为空
  15.   (if ss
  16.     (progn
  17.       ;; 遍历选择集并修改颜色为随层
  18.       (vlax-for obj (vla-get-ActiveSelectionSet doc)
  19.         (ChColorToByLayer obj) ; 调用递归函数修改颜色
  20.       )
  21.       ;; 清除选择集
  22.       (vla-delete (vla-get-ActiveSelectionSet doc))
  23.       (princ "\n所有选择对象颜色已修改为随层。")
  24.     )
  25.     (princ "\n未选择到任何对象。")
  26.   )
  27.   (setvar "cmdecho" 1)
  28.   (princ)
  29. )

  31. ;; 递归函数：修改对象及其子对象的颜色为随层
  32. (defun ChColorToByLayer (obj / blkName)
  33.   ;; 修改当前对象的颜色为随层
  34.   (vla-put-Color obj 256) ; 256 是 ByLayer 的颜色索引

  36.   ;; 如果是块参照，递归处理块内的对象
  37.   (if (and (= (vla-get-ObjectName obj) "AcDbBlockReference")
  38.            (setq blkName (vla-get-name obj)))
  39.     (progn
  40.       ;; 递归处理块内对象
  41.       (vlax-for subObj (vla-item blks blkName)
  42.         (ChColorToByLayer subObj) ; 递归处理块内对象
  43.       )
  44.       ;; 处理块内的属性文字
  45.       (if (= (vla-get-HasAttributes obj) :vlax-true)
  46.         (foreach att (vlax-invoke obj 'GetAttributes)
  47.           (vla-put-Color att 256) ; 修改属性文字颜色为随层
  48.         )
  49.       )
  50.     )
  51.   )

  53.   ;; 如果是属性文字，修改颜色为随层
  54.   (if (= (vla-get-ObjectName obj) "AcDbAttributeDefinition")
  55.     (vla-put-Color obj 256)
  56.   )

  58.   ;; 如果是多行文字或单行文字，修改颜色为随层
  59.   (if (wcmatch (vla-get-ObjectName obj) "*Text")
  60.     (vla-put-Color obj 256)
  61.   )

  63.   ;; 如果是尺寸标注，修改尺寸线、尺寸文字、尺寸界线等颜色为随层
  64.   (if (wcmatch (vla-get-ObjectName obj) "*Dimension")
  65.     (progn
  66.       (vla-put-DimensionLineColor obj 256) ; 尺寸线颜色为随层
  67.       (vla-put-ExtensionLineColor obj 256) ; 尺寸界线颜色为随层
  68.       (vla-put-TextColor obj 4) ; 尺寸文字颜色为随层
  69.     )
  70.   )
  71. )
  72. ;;;改对象颜色为以图层颜色为线形颜色

回复 支持 反对

使用道具 举报

shujh1989
发表于 2025-1-22 16:29:58 | 显示全部楼层
本帖最后由 shujh1989 于 2025-1-22 16:31 编辑
sky899150 发表于 2025-1-17 14:53
对天正的那个标高图元不起作用

天正标高是要修改天正文字的颜色。
(if (and
                (= (vlax-get-property obj 'ObjectName) "TDbSymbElevation" )
                (vlax-property-available-p obj 'TextLayer) ; 检查TextLayer属性是否存在
                 (wcmatch (vlax-get-property obj 'Layer) "*DIM_ELEV*" ))
      (vlax-put-property obj 'TextColor 256)
     )  
回复 支持 反对

使用道具 举报

小毛草
 楼主| 发表于 2025-1-17 16:13:27 | 显示全部楼层
惜惜2 发表于 2025-1-17 15:38
块中块不支持啊，属性赋值也不行

应该可以吧，我试了2016是可以的！
回复 支持 反对

使用道具 举报

mequan
发表于 2025-1-17 13:57:03 | 显示全部楼层
试用了一下，发现不能框选多个进行修改，只能点选
回复 支持 反对

使用道具 举报

qazxswk
发表于 2025-1-17 14:21:14 | 显示全部楼层
试试修改多重引线。
回复 支持 反对

使用道具 举报

sky899150
发表于 2025-1-17 14:53:49 | 显示全部楼层
对天正的那个标高图元不起作用

本帖子中包含更多资源

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

x
回复 支持 反对

使用道具 举报

小毛草
 楼主| 发表于 2025-1-17 15:21:44 | 显示全部楼层
不一定支持天正文件格式，我这边不用天正！
回复 支持 反对

使用道具 举报

惜惜2
发表于 2025-1-17 15:38:24 | 显示全部楼层
块中块不支持啊，属性赋值也不行
回复 支持 反对

使用道具 举报

惜惜2
发表于 2025-1-17 17:07:05 | 显示全部楼层
小毛草 发表于 2025-1-17 16:13
应该可以吧，我试了2016是可以的！

属性的值不行

本帖子中包含更多资源

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

x
回复 支持 反对

使用道具 举报

cghdy
发表于 2025-1-20 14:11:19 | 显示全部楼层
同名块也会被修改颜色，建议遍历块时将要修改的块改下名再改颜色
回复 支持 反对

使用道具 举报

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

本版积分规则

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

GMT+8, 2025-2-23 04:41 , Processed in 0.184687 second(s), 28 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

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