所有明经币求 求大神写个块改色lisp，必谢

wchsunshine

QQ 1615388511

Sonnenblumen

试试这个

you_boss

看了一下，首先visual lisp中块的群码表中没有对应颜色的群码表，ActiveX对象中也没用对应颜色的属性，就算是更改图层属性也没办法更改块的颜色，所以我的理解是块是一个透明的塑料袋，他的颜色是内部的图元表达出来的，所以要修改颜色，只能从内部图元入手，目前有个思路
新建一个图层颜色设置为目标颜色
建一个容器将图层放在里面
先nentsel获取块内对象，更改图元图层，这种比较简单但是比较麻烦，另外还有一种方法，就是给块的activex对象加颜色属性，但是我还不会

wchsunshine

这个功能 其他软件 如浩辰有的 ，但AUTOCAD没有，希望大神开发一个。

you_boss

(defun c:cc1()
        (setq a_date(vlax-ename->vla-object (car(nentsel"\n点击目标颜色"))))
        (setq a_colo(vla-get-Color a_date))
        (setq b_date(vlax-ename->vla-object (car(nentsel"\n点击需要修改图元"))))
        (vla-put-Color b_date a_colo)
        (command "regen")
)这是我能想到最简洁的方法了
使用方法：先点击具有目标颜色的图元，再点击块内需要改变颜色的图元就可以了，只需点击两次

wchsunshine

you_boss 发表于 2021-2-24 18:10
(defun c:cc1()
        (setq a_date(vlax-ename->vla-object (car(nentsel"\n点击目标颜色"))))
       ...

测试了   不行。
坐等解决， Sonnenblumen楼的下不了，没有明经币了  充值也充不了，伤心，坐等好心人。

xj6019

帮你一个，不用谢

you_boss

wchsunshine 发表于 2021-3-14 21:03
测试了   不行。
坐等解决， Sonnenblumen楼的下不了，没有明经币了  充值也充不了，伤心，坐等好心人。

不会的，我测试了能用才发的，不知道你是怎么加载的，复制代码进入cad内置的lisp编译器加载，还是直接放进文件夹加载的，如果是后一种可能是少了一段语句(vl-load-com)，把这段语句加到cc1()后面，因为这里用了vla对象，需要加载一些东西，你那边可能没加载,另外就是最后那个regen，因为这是修改块内部了，要更新整改图所以时间比较就大概要一秒多

hbllw

(defun c:hy-Change-Block-Color (/ ss ssl i blocks el e bn bl)
  (vl-load-com)
    (or $ChColor$ (setq $ChColor$ 7))
  (setq $ChColor$ (acad_colordlg $ChColor$))
  (princ (strcat  "\n当前颜色编号为："  (itoa $ChColor$)))
    (setq csm nil)
  (initget "A B")   
;;;  (setq csm (getkword "\n ->选择更改方式-->块内图元及所有嵌套块图元<A> / 块内第一层图元<B>: <B>"))
;;;  (setq csm (getkword "\n ->选择更改方式-->块内图元及所有嵌套块图元<A>/块内第一层图元<B>:[(A)/(B)]<B>"))
  (princ (strcat  "\n->选择更改方式-->"))
  (setq csm (getkword "\n 块内第一层图元<A>/块内图元及所有嵌套块图元<B>:[(A)/(B)]<A>"))
;;;  (setq pd001 (getkword "\n ->?????001 [(Y)/(N)]<N>"))
  (if (or (= csm nil) (= csm "A"))
(if (setq ss (SSGET ":S"))
(progn
(setq ssl (sslength ss)
i -1
blocks (vla-get-blocks
(vla-get-activedocument (vlax-get-acad-object))
)
)
(setq
el (entget (ssname ss 0))
bn (cdr (assoc 2 el))
)
(if (not (vl-position bn bl))
(progn
(vlax-for ent (vla-item blocks bn)
;;;(vla-put-layer ent "0")
(vla-put-color ent $ChColor$)
(setq bl (cons bn bl))  
)
)
)
(vla-update (Vlax-Ename->Vla-Object (ssname ss 0)))
)
  (hy-exit))
)
  (if (= csm "B")
    ;;;(lt:ssget '("\n选择要修改颜色的对象: ")))
;;;           (or $ChColor$ (setq $ChColor$ 7))
;;;           (setq $ChColor$ (acad_colordlg $ChColor$))
    (progn
      (setq SS (SSGET ":S")  )
      (setq BLKS  (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object))))
      (defun ChColor (OBJ / oName BlkName)
        (setq oName (vla-get-ObjectName OBJ))
        (cond
          ((wcmatch oName "*Dimension,AcDbLeader,AcDbFcf")
           (vla-put-DimensionLineColor OBJ $ChColor$)
           (if (wcmatch oName "*Dimension")
             (progn
               (vla-put-ExtensionLineColor OBJ $ChColor$)
               (if (setq BlkName (assoc 2 (entget (vlax-vla-object->ename OBJ))))
                 (vlax-for OBJ (vla-item Blks (cdr BlkName))
                   (vla-put-color OBJ $ChColor$)
                 )
               )
             )
           )
           (if (wcmatch oName "*Dimension,AcDbFcf")
             (vla-put-TextColor OBJ $ChColor$)
           )
          )
          ((= oName "AcDbBlockReference")
           (setq BlkName (vla-get-name OBJ))
           (if (not (member BlkName BNLst))
             (progn
               (setq BNLst (cons BlkName BNLst))
               (vlax-for X (vla-item Blks BlkName)
                 (ChColor X)
               )
             )
           )
           (if (= (vla-get-HasAttributes OBJ) :vlax-true)
             (foreach X (vlax-invoke OBJ 'getattributes)
               (vla-put-color X $ChColor$)
             )
           )
          )
        )
        (vla-put-color obj $ChColor$)
      )
      (repeat (setq I (sslength SS))
        (setq OBJ (vlax-ename->vla-object (ssname SS (setq I (1- I)))))
        (ChColor OBJ)
      )
    )
  )
(princ)
)