home *** CD-ROM | disk | FTP | other *** search
- ;Copy Objects to another layer leave originals where they are
- ;
- ; ********Patrick J. McKee, author********
- ; ****Copyright 1992, Power Key tm****
- ;
- (defun C:CTL ()
- (setq oer *error* *error* err2)
- (setq ss (ssget))
- (SETQ UL1(GETSTRING "\nLayer to copy entities to : "))
- (setq counter 0)
- (prompt " COPYING OBJECTS.......")
- (PRINC "\n")
- (while
- (setq e (ssname ss counter))
- (setq l (cdr (assoc 8 (entget e))))
- (setq S (ssget "X" (list (cons 8 l))))
- (progn
- (setvar"cmdecho"0)
- (command "copy" s "" "0,0" "0,0")
- (command "CHANGE" s "" "P" "LA" UL1 ""))
- (setq counter (+ counter 1))
- (setvar"cmdecho"1)
- (princ "\nCOPYING TO LAYER......" )))