社区 › 源码共享 › 块改色插件

yefei812678 发表于 2024-2-26 11:10:18

块改色插件

本帖最后由 yefei812678 于 2024-2-26 11:23 编辑


选择颜色能不能改成，下面这种直接输入色号的方式


(defun c:gk (/ ChBlkColor SS blks I Obj BnLst)
(defun ChBlkColor (Blks Obj Color / BlkName oName)
    (if (and (= (vla-get-ObjectName obj) "AcDbBlockReference")
             (= (vla-get-HasAttributes obj) :vlax-true)
      )
      (foreach x (vlax-invoke obj 'getattributes)
      (vla-put-color x Color)
      )
    )
    (setq BlkName (vla-get-name obj))
    (if (not (member BlkName bnlst))
      (progn
      (setq bnlst (cons BlkName BnLst))
      (vlax-for X (vla-item Blks BlkName)
          (setq oName (vla-get-ObjectName X))
          (cond ((wcmatch oName "*Dimension,AcDbLeader,AcDbFcf")
               (vla-put-DimensionLineColor X Color)
               (if (wcmatch oName "*Dimension")
               (progn
                     (vla-put-ExtensionLineColor X Color)
                     (if (setq BlkName (assoc 2 (entget (vlax-vla-object->ename X))))
                     (vlax-for X (vla-item Blks (cdr BlkName))
                         (vla-put-color X Color)
                     )
                     )
                   )
               )
               (if (wcmatch oName "*Dimension,AcDbFcf")
                   (vla-put-TextColor X Color)
               )
                )
                ((= oName "AcDbBlockReference")
               (ChBlkColor Blks X Color)
                )
          )
          (vla-put-color X Color)
      )
      )
    )
    (vla-UpDate obj)
)
(if (and (setq ss (ssget '((0 . "insert"))))
         (or $ChBlkColor$ (setq $ChBlkColor$ 7))
         (setq $ChBlkColor$ (acad_colordlg $ChBlkColor$))
      )
    (progn
      (setq blks (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object))))
      (repeat (setq i (sslength ss))
      (setq obj (vlax-ename->vla-object (ssname ss (setq i (1- i)))))
      (ChBlkColor Blks Obj $ChBlkColor$)
      )
    )
)
(princ)
)

飞雪神光 发表于 2024-2-26 13:26:27

(defun c:gk (/ ChBlkColor SS blks I Obj BnLst)
(defun ChBlkColor (Blks Obj Color / BlkName oName)
    (if (and (= (vla-get-ObjectName obj) "AcDbBlockReference")
                                        (= (vla-get-HasAttributes obj) :vlax-true)
      )
      (foreach x (vlax-invoke obj 'getattributes)
      (vla-put-color x Color)
      )
    )
    (setq BlkName (vla-get-name obj))
    (if (not (member BlkName bnlst))
      (progn
      (setq bnlst (cons BlkName BnLst))
      (vlax-for X (vla-item Blks BlkName)
          (setq oName (vla-get-ObjectName X))
          (cond ((wcmatch oName "*Dimension,AcDbLeader,AcDbFcf")
                                                                        (vla-put-DimensionLineColor X Color)
                                                                        (if (wcmatch oName "*Dimension")
                                                                                (progn
                                                                                        (vla-put-ExtensionLineColor X Color)
                                                                                        (if (setq BlkName (assoc 2 (entget (vlax-vla-object->ename X))))
                                                                                                (vlax-for X (vla-item Blks (cdr BlkName))
                                                                                                        (vla-put-color X Color)
                                                                                                )
                                                                                        )
                                                                                )
                                                                        )
                                                                        (if (wcmatch oName "*Dimension,AcDbFcf")
                                                                                (vla-put-TextColor X Color)
                                                                        )
                )
                                                ((= oName "AcDbBlockReference")
                                                        (ChBlkColor Blks X Color)
                                                )
          )
          (vla-put-color X Color)
      )
      )
    )
    (vla-UpDate obj)
)
(if (and
                                (setq ss (ssget '((0 . "insert"))))
                                (or $ChBlkColor0$ (setq $ChBlkColor0$ 7))
                        )
    (progn
                        (setq $ChBlkColor$ (getint (strcat "\n请输入颜色号(1-255)<" (itoa $ChBlkColor0$) ">:")))
                        (if (null $ChBlkColor$)
                                (setq $ChBlkColor$ $ChBlkColor0$)
                                (setq $ChBlkColor0$ $ChBlkColor$)
                        )
                        (setq blks (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object))))
      (repeat (setq i (sslength ss))
      (setq obj (vlax-ename->vla-object (ssname ss (setq i (1- i)))))
      (ChBlkColor Blks Obj $ChBlkColor$)
      )
    )
)
(princ)
)

yefei812678 发表于 2024-2-26 11:12:42

选择颜色能不能改成，下面这种直接输入色号的方式

yefei812678 发表于 2024-2-26 13:55:30

飞雪神光 发表于 2024-2-26 13:26


非常感谢 非常感谢

wangsr 发表于 2024-2-26 23:48:34

不错插件谢谢分享

atone 发表于 2024-3-12 09:32:03

飞雪神光 发表于 2024-2-26 13:26


感谢分享，赞

czb203 发表于 2024-4-7 10:27:00

感谢大神的热心分享，点赞

Pegasus 发表于 2024-6-3 19:56:19

未知名称: ExtensionLineColor

查看完整版本: 块改色插件