块改色插件

yefei812678

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

(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)
)

飞雪神光

1. (defun c:gk (/ ChBlkColor SS blks I Obj BnLst)
   
2.   (defun ChBlkColor (Blks Obj Color / BlkName oName)
   
3.     (if (and (= (vla-get-ObjectName obj) "AcDbBlockReference")
   
4.                                         (= (vla-get-HasAttributes obj) :vlax-true)
   
5.         )
   
6.       (foreach x (vlax-invoke obj 'getattributes)
   
7.         (vla-put-color x Color)
   
8.       )
   
9.     )
   
10.     (setq BlkName (vla-get-name obj))
    
11.     (if (not (member BlkName bnlst))
    
12.       (progn
    
13.         (setq bnlst (cons BlkName BnLst))
    
14.         (vlax-for X (vla-item Blks BlkName)
    
15.           (setq oName (vla-get-ObjectName X))
    
16.           (cond ((wcmatch oName "*Dimension,AcDbLeader,AcDbFcf")
    
17.                                                                         (vla-put-DimensionLineColor X Color)
    
18.                                                                         (if (wcmatch oName "*Dimension")
    
19.                                                                                 (progn
    
20.                                                                                         (vla-put-ExtensionLineColor X Color)
    
21.                                                                                         (if (setq BlkName (assoc 2 (entget (vlax-vla-object->ename X))))
    
22.                                                                                                 (vlax-for X (vla-item Blks (cdr BlkName))
    
23.                                                                                                         (vla-put-color X Color)
    
24.                                                                                                 )
    
25.                                                                                         )
    
26.                                                                                 )
    
27.                                                                         )
    
28.                                                                         (if (wcmatch oName "*Dimension,AcDbFcf")
    
29.                                                                                 (vla-put-TextColor X Color)
    
30.                                                                         )
    
31.                 )
    
32.                                                 ((= oName "AcDbBlockReference")
    
33.                                                         (ChBlkColor Blks X Color)
    
34.                                                 )
    
35.           )
    
36.           (vla-put-color X Color)
    
37.         )
    
38.       )
    
39.     )
    
40.     (vla-UpDate obj)
    
41.   )
    
42.   (if (and
    
43.                                 (setq ss (ssget '((0 . "insert"))))
    
44.                                 (or $ChBlkColor0$ (setq $ChBlkColor0$ 7))
    
45.                         )
    
46.     (progn
    
47.                         (setq $ChBlkColor$ (getint (strcat "\n请输入颜色号(1-255)<" (itoa $ChBlkColor0$) ">:")))
    
48.                         (if (null $ChBlkColor$)
    
49.                                 (setq $ChBlkColor$ $ChBlkColor0$)
    
50.                                 (setq $ChBlkColor0$ $ChBlkColor$)
    
51.                         )
    
52.                         (setq blks (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object))))
    
53.       (repeat (setq i (sslength ss))
    
54.         (setq obj (vlax-ename->vla-object (ssname ss (setq i (1- i)))))
    
55.         (ChBlkColor Blks Obj $ChBlkColor$)
    
56.       )
    
57.     )
    
58.   )
    
59.   (princ)
    
60. )

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

yefei812678

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

yefei812678

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

非常感谢 非常感谢

wangsr

不错插件谢谢分享

atone

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

感谢分享，赞

czb203

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

Pegasus

未知名称: ExtensionLineColor