【已解决】下面的代码为什么不能与贱人工具一起使用啊，加载贱人工具，代码

yangchao2005090 · 发表于 2019-8-14 08:33

本帖最后由 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)
)

(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:30

本帖最后由 ketxu 于 2019-9-4 09:31 编辑

First Thanks for sharing :) Maybe it have same command name ?

账号		自动登录	找回密码
密码			注册

[提问] 【已解决】下面的代码为什么不能与贱人工具一起使用啊，加载贱人工具，代码