此代码不支持选择单一图块修改颜色， 求高手把它改为可以选择单一图块修改颜色
1、目前此程序对Mtext中颜色无效，求优化求优化求优化2、求高手把它改为可以选择单一图元、图块修改颜色 求优化 求优化求优化
;;这是一个改全图颜色程序
;; 求高手把它改为对单一图元、图块修改颜色
;;改好了记得上传!!
;;By 龙龙仔(LUCAS)
(defun C:CHGBLKENTCOL (/ BLKCOL DOC OBJ COL)
(vl-load-com)
(arxload "acetutil.arx" NIL)
(defun CHGCOL (OBJ BCL COL / ATT CATT ENT1 ENT ENTNAME)
(vlax-for ENT OBJ
(setq ENTNAME (vla-get-objectname ENT))
(if (= ENTNAME "AcDbBlockReference")
(progn
(if (= (vl-catch-all-apply 'vla-get-hasattributes (list ENT))
:vlax-true
)
(progn
(setq ATT (vlax-variant-value (vla-getattributes ENT))
CATT (vlax-variant-value
(vla-getconstantattributes ENT)
)
)
(if (safearray-value ATT)
(foreach ENT1 (vlax-safearray->list ATT)
(vla-put-color ENT1 COL)
)
)
(if (safearray-value CATT)
(foreach ENT1 (vlax-safearray->list CATT)
(vla-put-color ENT1 COL)
)
)
)
)
(CHGCOL (vla-item BCL (vla-get-name ENT)) BCL COL)
;;(VLA-UPDATE ENT)
)
(if (vlax-property-available-p ENT 'COLOR)
(vla-put-color ENT COL)
)
)
(if (or (= ENTNAME "AcDbLeader") (= ENTNAME "AcDbFcf"))
(vla-put-dimensionlinecolor ENT COL)
)
(if (= ENTNAME "AcDbFcf")
(vla-put-textcolor ENT COL)
)
)
)
(setq COL (acad_colordlg 7))
(setq BLKCOL (vla-get-blocks
(setq DOC (vla-get-activedocument
(vlax-get-acad-object)
)
)
)
)
(acet-ui-progress "颜色转换中..." (vla-get-count BLKCOL))
(vlax-for OBJ BLKCOL
(if ;;(and
;;(= (vla-get-islayout OBJ) :vlax-false)
(= (vla-get-isxref OBJ) :vlax-false)
;;)
(CHGCOL OBJ BLKCOL COL)
)
(acet-ui-progress -1)
)
(acet-ui-progress)
;;(setvar "DIMCLRD" COL)
;;(setvar "DIMCLRE" COL)
;;(setvar "DIMCLRT" COL)
(vla-regen DOC acallviewports)
(vlax-release-object DOC)
(vlax-release-object BLKCOL)
(princ)
)
本帖最后由 zhangrunze 于 2024-4-1 16:35 编辑
感谢分享，可惜这个不支持多行文字改色~
页:
[1]