;| CC.lsp  Continuous Copy
CC.lsp continuously copies selected object(s) along a specified 2D or 3D
vector at a specified interval as long as you keep hitting the spacebar.

Use horizontally in current UCS: parking stripes, bolt holes.
Use vertically in current UCS: shelves, stacked boxes. (ORTHO helps.)
Use along any 2D or 3D vector in any UCS: posts on a ramp, stair treads.
The UCS does not have to be changed to create copies along a 3D vector.

by Bill Gilliss
bill at realerthanreal dot com
Comments and suggestions always welcome.

No warranty, either expressed or implied, is made as to the fitness of this 
information for any particular purpose.  All materials are to be considered 
'as-is', and use thereof should be considered as at your own risk.

ver 1.0 1993 or so  - 2D only, in tribute to AutoArchitect's sorely missed
                      Continuous Copy routine
ver 2.0 Jan 25 2010 - initial public release with 3D vector capability;
                      integer, CAL and U options; reporting; error-handling
                      
Keywords: AutoCAD AutoLISP continuous copy multiple 3D vector
=============================================================================

DIRECTION OF VECTOR
  The direction of the vector can be assigned by specifying a pair of 2D
  or 3D points on the screen, or by entering the second point in any valid
  AutoCAD angular format, such as
    2D relative:  @1,1
    3D relative:  @1,1,1
    planar:       @1<45
    cylindrical:  @1<45,1
    spherical:    @1<45<45

  Note: a vector of @0,0,0 is not permitted (i.e., specifying the same point
  twice). For multiple copies in place, use any vector and set interval to 0.

INTERVAL BETWEEN COPIES
  The interval between copies can be the 2D or 3D distance...
   - between the pair of points that defined the vector [default],
   - between any two other points indicated on the screen, or
   - entered from the keyboard in any valid AutoCAD units format,
     regardless of the current format.

  All distances indicated on the screen are treated as positive; negative
  distances are accepted from the keyboard, in which case copies will be
  placed in the direction opposite to that of the vector.

  The keyboard accepts CAL expressions as shown in the prompt:
     Enter numeric distance, two points, CAL (not 'CAL), or ENTER for vector 
       length [1'-1"]: CAL
     >> Expression: pi*6
     18.8495559

  Previously assigned AutoLISP variables may be used in CAL expressions. For
  instance, if the symbol m has been assigned the value of 8:
     >> Expression: m*6
     48.000000
     
  Note: 'cal can NOT be evaluated correctly at a LISP (getxxx) prompt. An 
  erroneous value will be returned. Use CAL instead, per the prompt. Thank you.

  AutoLISP functions such as (* 8 6)  or (* m 6) are not accepted.

  Note: an interval of 0 is accepted, to enable multiple copies in place.

NUMBER OF COPIES
  In addition to using the Enter key or spacebar to create single copies, the
  user can specify an integer number of copies from the keyboard, either
  instead of or interspersed with use of the spacebar. Negative, fractional,
  and real numbers are not accepted. (To remove copies, see below.)

OPERATION
  Single copies can be undone one at a time with "U" during the routine.
  Entire operation can be undone with "U" after the routine is complete.
  Current number of copies are reported on status line during the routine.
  Total number of copies are reported on command line at end of the routine.

TERMINATION
  X or ESC ends the routine. Either way exits cleanly with the same result.
|;

(defun c:cc ( / olderror myerror *cmdecho *copymode *lunits
                addCopy deleteCopy updateTotal p1 p2 p3 d1 ss1 
                total copyPrompt cop copies obj copyFlag distFlag)
;;-------------------  LOAD EXTERNAL FUNCTIONS  -------------------
(arxload "geomcal")
(vl-load-com)

;;-------------------  DEFINE INTERNAL FUNCTIONS -----------------
(defun beep () (vlr-beep-reaction))

(defun myerror (msg)  ;; error-handler and cleanup
  (command "._undo" "_end")
  (setvar 'cmdecho  *cmdecho)
  (if (getvar 'copymode)
      (setvar 'copymode *copymode)
       )
  (setvar 'lunits   *lunits)
  (if total  ;;don't report if cancelled before any copies made
    (progn
      (if (= total 1) (setq cop " copy ") (setq cop " copies "))
      (if (= (sslength ss1) 1) (setq obj " object.") (setq obj " objects."))
      (princ (strcat "\n" 
              (itoa total) cop "created of " 
              (itoa (sslength ss1)) obj)
              )
      )
    )
  (if (and (= d1 0) (> total 0))
      (progn
        (beep)
        (princ "\nNOTE: COPIES ARE COINCIDENT WITH ORIGINAL OBJECT(S).")
        )
        )
  (grtext)
  (setq *error* olderror)
  )

(defun addCopy ()
  (setq total (1+ total))
  (vl-cmdf "._copy" ss1 "" p1 (cal "p1+total*d1*vec1(p1,p2)"))
  (updateTotal) ;;on status line
)

(defun deleteCopy ()
  (repeat (sslength ss1) (entdel (entlast)))
  (setq total (1- total))
  (updateTotal)
)

(defun updateTotal ()
 (grtext -1 (strcat "========== Copies: " (itoa total) " =========  " ))
)

;;-------------------  INITIALIZE VARIABLES ---------------
(setq olderror *error*
      *error* myerror
      *cmdecho  (getvar 'cmdecho)
      *lunits (getvar 'lunits)
      )
(if (getvar 'copymode)
      (setq *copymode (getvar 'copymode))
      )
      
(setvar 'cmdecho 0)
(if (getvar 'copymode)
    (setvar 'copymode 1)  ;; to be compatible w/ earlier versions of AutoCAD
    )
(setq copyPrompt
 (strcat "\Enter # of copies, U=Undo, spacebar=add 1 copy, X=exit: \n")
 )

;;-------------------  MAIN ROUTINE  -------------------------
(prompt "Select object(s) for continuous copy: ")
(setq ss1 (ssget))

;; GET VECTOR  -- zero not allowed
(setq p1 (getpoint "Start point of vector: "))
(setq p2 p1)
(while (equal p1 p2)
  (initget 32)
  (setq p2 (getpoint p1 "\nEnd point of vector, or angular direction: "))
  (if (equal p1 p2)
      (progn
        (princ "\nPoints must be different. ")
        (beep)
        )
      )
  );while

;; GET INTERVAL  -- zero is allowed
(prompt (strcat "\nEnter numeric distance, two points, CAL (not 'CAL), "
                "or ENTER for vector length ["
                 (rtos (distance p1 p2))
                 "]: "))
(setvar 'lunits 4)    ;; architectural units will accept all unit formats

(setq distFlag nil)
(while (not distFlag)
  (initget "Cal" )     ;; no text input except "CAL" option.
                       ;; can't make transparent 'CAL work or block it, so 
                       ;; provide a working option.
  (setq d1 (getdist))  ;; usually either from keyboard or screen picks     
  (cond
     ( (not d1) ;;Enter or Spacebar
         (setq d1 (distance p1 p2))
         (setq distFlag T)
          )

       ( (numberp d1) ;;any kind of number will do
         (setq distFlag T)
          )

       ( (= d1 "Cal")
         (princ "\n")
         (setq d1 (c:cal))
         (princ d1)
         (if (and d1 (listp d1))  ;;if a non-nil list
             (princ " is a point or a vector, not a distance. ")
             (if d1 (setq distFlag T))
             )
          )

       ( T
          (vlr-beep-reaction)
          (prompt "\nInvalid distance. Try again: ")
          )
      );cond
  )  ;while
  
(setvar 'lunits *lunits) ;;restore previous units for display

(princ
  (strcat "\nInterval between copies: " (rtos d1) " [" (rtos d1 2 8) "]\n")
  )

(princ copyPrompt)
(prompt "\n")

(setq total 0)
(command "._undo" "_begin")

;;  MAIN LOOP TO ADD SUBTRACT COPIES --
(setq copyFlag T) 
(while copyFlag 
  (initget 6 "Undo eXit")     ;;allows positive integers only, no zero
  (setq copies (getint "  ?:")) ;; integer, U, spacebar/Enter, ENTER, X
  (cond
    ( (not copies) ;;ENTER or spacebar
      (princ 1)
      (addCopy)
      )
          
    ( (numberp copies)  ;; positive integer entered
      (repeat copies (addCopy))
      )     

    ( (= copies "Undo")
      (if (> total 0)
        (deleteCopy)
        (progn
          (beep)
          (prompt "\nNo copies to erase.\n")
          (princ copyPrompt)
          )
        )
      )
      
    ( (= copies "eXit")
      (setq CopyFlag nil)
      )      

    (T ;;ignore any other input that slips past (getint)
      (beep)
      (prompt "\nInvalid input; try again.\n")
      (princ copyPrompt)
      )
      
    );cond
  );while

  (myerror) ;; for cleanup
  (princ)
);defun

(prompt "Type CC to run the Continuous Copy routine.")
(princ)