[编程交流] 更改所有对象的命令

(defun c:Test (/ ss i e l n)
 ;;     Tharwat 11.Dec.2013    ;;
 (or doc (setq doc (vla-get-activedocument (vlax-get-acad-object))))
 (if (setq ss (ssget "_:L" '((0 . "INSERT"))))
   (progn
     (vla-StartUndoMark doc)
     (repeat (setq i (sslength ss))
       (setq e (entget (ssname ss (setq i (1- i)))))
       (if (not (member (setq n (cdr (assoc 2 e))) l))
         (progn
           (setq l (cons n l))
           (vlax-for x (vla-item (vla-get-blocks doc) n)
             (if (/= (vla-get-layer x) "0")
               (vla-put-layer x "0")
             )
           )
         )
       )
     )
     (vla-EndUndoMark doc)
     (vla-regen doc AcAllViewports)
   )
 )
 (princ)
)
(vl-load-com)

(defun c:cb0 ()
     (command "-refedit" pause "O" "A" "N" "CHPROP" "all" "" "LA" "0" "" "REFCLOSE" "" "")
 )

 
; Load function, then enter FIXBLOCK to redefine selected blocks
;  so that all entities are on layer '0'.
;
(defun c:FIX (/ ss cnt b donelist bredef)
 (defun bredef (b / e el)
   (setq e (tblobjname "BLOCK" b))
   (while e
     (setq el (entget e))
     (setq el (subst '(8 . "0") (assoc 8 el) el))
     (setq el (if (assoc 62 el) (subst '(62 . 0) (assoc 62 el) el) (append el '((62 . 0)))))
     (entmake el)
     (setq e (entnext e))
   )
   (if (/= "ENDBLK" (cdr (assoc 0 el))) (entmake '((0 . "ENDBLK") (8 . "0") (62 . 0))))
 )
 (if (> (logand (cdr (assoc 70 (tblsearch "layer" "0"))) 1) 0)
   (princ "\nLayer 0 must be thawed before running FIXBLOCK!\n")
   (if (setq ss (ssget '((0 . "INSERT"))))
     (progn
       (setq cnt (sslength ss))
       (while (>= (setq cnt (1- cnt)) 0)
         (if (not (member (setq b  (cdr (assoc 2 (entget (ssname ss cnt))))) donelist))
           (progn
             (bredef b)
             (setq donelist (cons b donelist))
           )
         )
       )
       (princ (strcat "\n" (itoa (sslength ss)) " blocks redefined\n"))
     )
     (princ "\nNo blocks selected!\n")
   )
 )
 (princ)
)
;End-of-file

(defun c:b20 ( / e i l n s x )
   (if (setq s (ssget '((0 . "INSERT"))))
       (repeat (setq i (sslength s))
           (if (not (member (setq n (cdr (assoc 2 (entget (ssname s (setq i (1- i))))))) l))
               (progn
                   (setq l (cons n l)
                         e (tblobjname "block" n)
                   )
                   (while (setq e (entnext e))
                       (setq x (entget e))
                       (entmod (subst '(8 . "0") (assoc 8 x) x))
                   )
               )
           )
       )
   )
   (command "_.regen")
   (princ)
)[color=#C00000][font=Consolas][/font][/color]