所有明经币求 求大神写个块改色lisp，必谢
本帖最后由 wchsunshine 于 2022-3-12 22:04 编辑https://pcsdata.baidu.com/thumbnail/7fdd3bfd3gd29ba369a52940541b5314?fid=3540102627-16051585-627604157646761&rt=pr&sign=FDTAER-yUdy3dSFZ0SVxtzShv1zcMqd-dqJWLcOmr%2FzsDRAVlqnhw%2BD1GLg%3D&expires=2h&chkv=0&chkbd=0&chkpc=&dp-logid=2476492628&dp-callid=0&time=1612094400&size=c1600_u1600&quality=100&vuk=-&ft=video QQ 1615388511
试试这个
看了一下，首先visual lisp中块的群码表中没有对应颜色的群码表，ActiveX对象中也没用对应颜色的属性，就算是更改图层属性也没办法更改块的颜色，所以我的理解是块是一个透明的塑料袋，他的颜色是内部的图元表达出来的，所以要修改颜色，只能从内部图元入手，目前有个思路
新建一个图层颜色设置为目标颜色
建一个容器将图层放在里面
先nentsel获取块内对象，更改图元图层，这种比较简单但是比较麻烦，另外还有一种方法，就是给块的activex对象加颜色属性，但是我还不会
这个功能 其他软件 如浩辰有的 ，但AUTOCAD没有，希望大神开发一个。 本帖最后由 you_boss 于 2021-2-24 18:13 编辑
(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")
)这是我能想到最简洁的方法了
使用方法：先点击具有目标颜色的图元，再点击块内需要改变颜色的图元就可以了，只需点击两次
you_boss 发表于 2021-2-24 18:10
(defun c:cc1()
(setq a_date(vlax-ename->vla-object (car(nentsel"\n点击目标颜色"))))
...
测试了 不行。
坐等解决， Sonnenblumen楼的下不了，没有明经币了充值也充不了，伤心，坐等好心人。 帮你一个，不用谢 本帖最后由 you_boss 于 2021-3-16 09:06 编辑
wchsunshine 发表于 2021-3-14 21:03
测试了 不行。
坐等解决， Sonnenblumen楼的下不了，没有明经币了充值也充不了，伤心，坐等好心人。
不会的，我测试了能用才发的，不知道你是怎么加载的，复制代码进入cad内置的lisp编译器加载，还是直接放进文件夹加载的，如果是后一种可能是少了一段语句(vl-load-com)，把这段语句加到cc1()后面，因为这里用了vla对象，需要加载一些东西，你那边可能没加载,另外就是最后那个regen，因为这是修改块内部了，要更新整改图所以时间比较就大概要一秒多 (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)
)
页:
[1]