;;;     COPYTO.LSP
;;;
;;;     Created 1/21/98 by Randy Kintzley
;;;
;;;     Copyright © 1998 by Autodesk, Inc.
;;;
;;;     Permission to use, copy, modify, and distribute this software
;;;     for any purpose is restricted by the terms and conditions of
;;;     the AutoCAD Express Tools Software License Agreement.
;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; COPYTOLAYER  Copies a selection set to specified layer leaving original
;	    selection set in tact. New entities will reside on user specified 
;           layer. An optional base point prompt follows specifying a layer name.
;           This can be exited by pressing return, or you can pick a base point 
;           and a second base point to place the new objects in the desired location.
;
(defun c:copytolayer ( / )
 (acet-copytolayer-main (getvar "cmddia")) 
);defun c:copytolayer
 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun c:-copytolayer ( / )
 (acet-copytolayer-main 0)
);defun c:-copytolayer
 
 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;if the cmddia flag is 1 then the dialog will be invoked.
;if the cmddia=0 then use the command line.
(defun acet-copytolayer-main ( cmddia / ss la p1 lk )
 
 (acet-error-init
  (list (list   "cmdecho" 0
              "highlight" nil
               "limcheck" 0
                 "cmddia" cmddia
        );list
        T      ;use undo
  );list
 );acet-error-init
 
(if (and (setq ss (ssget))
         (setq ss (car (acet-ss-filter
                         (list
                           ss			;selection set
                           '(("LAYERUNLOCKED")) ;remove object on locked layers
                           T                    ;print why 
                         );list
                       )
                  )
         );setq
    );and
    (progn
     (if (or (not acet:copytolayer)
             (not (tblobjname "layer" acet:copytolayer))
         );or
         (setq acet:copytolayer "0")
     );if
     (setq la (acet-ui-table-name-get 
                 (list "Specify the destination layer name" 
                       acet:copytolayer
                       "layer"
                       3                         ;;;bit sum  1=allow new and... 2=disable xref dependant
                       nil
                       "acet1503.hlp"
                       "copytolayer"
                 );list
              );acet-ui-table-name-get
     );setq
     (if la
         (progn
           (setq ss (acet-copytolayer ss la))
           (if (setq lk (acet-layer-locked la))
               (command "_.-layer" "_un" la "")
           ) 
           (setvar "highlight" 1)
           (acet-safe-command T nil (list "_.select" ss))
           (if (setq p1 (getpoint "\nBase point or <return> to finish: "))
               (progn
                (acet-safe-command nil T '("")) ;end the select command
                (acet-safe-command T nil (list "_.move" ss ""))
                (setvar "cmdecho" 1)
                (princ "\n")
                (command p1) 
                (while (wcmatch (getvar "cmdnames") "*MOVE*")
                 (command pause)
                );while
               );progn then
               (acet-safe-command nil T '(""));end the select command
           );if
           (acet-cmd-exit) ;and any active command.
           (if lk
               (command "_.-layer" "_lock" la "")
           )
           (setq acet:copytolayer la)
         );progn then
     );if
    );progn then
    (princ "\nNothing valid selected.")
);if
 
(acet-error-restore)
);defun acet-copytolayer-main
 
 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun acet-copytolayer ( ss la / na )
 
 (if ss
     (progn
      (if (not (tblobjname "layer" la))
          (acet-layer-copy (getvar "clayer") la)
      );if
 
      (setq na (entlast));setq
      (command "_.copy" ss "" "0,0" "0,0")
      (if (and (setq ss (acet-ss-new na));setq
               (> (sslength ss) 0)
          );and
          (progn
           (command "_.chprop" ss "" "_la" la "");command
           (princ (strcat "\n" (itoa (sslength ss)) 
                          " objects copied and placed on layer \""
                          (xstrcase la) "\"."
                  );strcat 
           );princ
          );progn then
      );if
     );progn then
 );if
 ss
);defun acet-copytolayer
 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;acet-layer-copy - creates a new layer.
;takes two layer names source and target.
(defun acet-layer-copy ( la la2 / na e1)
 
 (setq na (tblobjname "layer" la)
       e1 (entget na '("*"))
       e1 (subst (cons 2 la2) (assoc 2 e1) e1)
 );setq
 (entmake e1)
 
);defun acet-layer-copy


(princ)