【已解决】下面的代码为什么不能与贱人工具一起使用啊，加载贱人工具，代码
本帖最后由 yangchao2005090 于 2019-8-14 09:34 编辑(defun C:tt2 (/ COL SS CNT IDX BLKNAME DONELIST)
(defun GRP (GCC EL) (cdr (assoc GCC EL)))
(defun UPDATE (BNAME / ENAME ELIST)
(setq ENAME (tblobjname "BLOCK" BNAME))
(if
(and ENAME
(zerop (logand 52 (GRP 70 (entget ENAME '("*")))))
)
(progn
(while ENAME
(setq col (Vlax-Get (Vlax-Ename->Vla-Object ENAME) 'Color ))
(if (= 256 col)
(setq col (vlax-get (vla-item (vla-get-layers (vla-get-activedocument (vlax-get-acad-object)))
(Vlax-Get (Vlax-Ename->Vla-Object ENAME) 'Layer ))"color"))
)
(if (or (= "INSERT" (GRP 0 (entget ENAME)))
(= "DIMENSION" (GRP 0 (entget ENAME)))
)
(UPDATE (GRP 2 (entget ENAME)))
)
(setq ELIST (entget ENAME '("*"))
ELIST (subst '(8 . "0") (assoc 8 ELIST) ELIST)
ELIST (if (assoc 62 ELIST)
(subst (cons 62 COL) (assoc 62 ELIST) ELIST)
(append ELIST (list (cons 62 COL)))
)
)
(entmod ELIST)
(setq ENAME (entnext ENAME))
)
't
)
)
)
(if (> (logand (GRP 70 (tblsearch "layer" "0")) 1) 0)
(princ "\nLayer 0 must be thawed before running FIXBLOCK!\n")
(progn
(if
(progn
;(setq col 0)
;(setq COL (acad_colordlg 7))
(setq CNT 0
SS(ssget "x" '((0 . "INSERT")))
)
)
(progn
(setq IDX (sslength SS))
(while (>= (setq IDX (1- IDX)) 0)
(setq ex (ssname SS IDX))
(if
(not
(member (setq BLKNAME (GRP 2 (entget ex)))
DONELIST
)
)
(progn
(if (UPDATE BLKNAME)
(setq CNT (1+ CNT))
)
(setq DONELIST (cons BLKNAME DONELIST))
)
)
)
)
(while (setq BLKNAME (GRP 2 (tblnext "BLOCK" (not BLKNAME))))
(if (UPDATE BLKNAME COL)
(setq CNT (1+ CNT))
)
)
)
(princ (strcat "\n"
(itoa CNT)
" block"
(if (= CNT 1)
""
"s"
)
" redefined New Color\n"
)
)
)
)
(command "_.REGEN")
(princ)
)
本帖最后由 ketxu 于 2019-9-4 09:31 编辑
First Thanks for sharing :) Maybe it have same command name ?
页:
[1]