 ; Scram: Scale Copy Rotate And Move.
 ; Copyright 1992  Rocket Software
 ; Alright, it's not U.N.C.L.E., T.H.U.N.D.E.R., S.P.E.C.T.R.E., the A.R.M.
 ; or the B.R.A.I.N.  Still, acronym generation will be one of the last
 ; creative acts to be taken over by computers. 
 (DEFUN C:SCRAM (/ hi bl ncyc pa mpa ss nrota movv)
  (setvar "cmdecho" 0)
  (command "undo" "m")
  (setq hi (getvar "highlight"))
  (setq bl (getvar "blipmode"))
  (setq ss (ssget))
  (if (null cyc) (setq cyc 6))
  (setq ncyc cyc)
  (setq cyc (getint (strcat "\nNumber of cycles <" (itoa cyc) ">: ")))
  (if (null cyc) (setq cyc ncyc) (setq ncyc cyc))
  (if ppa
     (progn
          (setq pa (getpoint ppa "\nOperation base point: "))
          (if (null pa) (setq pa ppa) (setq ppa pa)))
     (progn
          (setq pa (getpoint "\nOperation base point: "))
          (setq ppa pa)))
  (if (and mpax mpay)
      (progn
           (setq movv (getpoint pa (strcat "\nMovement per cycle <"
                                            (rtos mpax 2 2) ","
                                            (rtos mpay 2 2) ">: ")))
           (if (null movv)
               (setq movv (list (+ (car pa) mpax) (+ (cadr pa) mpay)))))
      (progn
           (setq movv (getpoint pa "\nMovement per cycle <0>: "))
           (if (null movv) (setq movv pa))
           (setq mpax (- (car movv) (car pa)))
           (setq mpay (- (cadr movv) (cadr pa)))))
  (if (/= movv pa)
      (progn
           (setq mpa (strcase (getstring "\nMove base point <Y>: ")))
           (if (or (= mpa "") (= mpa "Y") (= mpa "YES"))
               (setq mpa T)
               (setq mpa ()))))
  (if (null rota) (setq rota 0))
  (setq nrota rota)
  (setq rota (getangle pa (strcat "\nRotation increment <"
                                  (rtos rota 2 2)">: ")))
  (if rota
      (setq rota (* rota (/ 180 pi)))
      (setq rota nrota))
  (if (null scal) (setq scal 1))
  (setq nscal scal)
  (setq scal (getdist pa (strcat "\nIncremental scale factor <"
                                 (rtos scal 2 2) ">: ")))
  (if (null scal) (setq scal nscal))
  (if (= scal 0) (setq scal 1))
  (setvar "blipmode" 0)
  (setvar "highlight" 0)
  (while (> ncyc 0)
         (grtext -2 (itoa ncyc))
         (setq ncyc (1- ncyc))
         (command "copy" ss "" "0,0" "0,0")
         (if (/= scal 1)
             (command "scale" ss "" pa scal))
         (if (/= rota 0)
             (command "rotate" ss "" pa rota))
         (if (/= movv pa)
             (command "move" ss "" pa movv))
         (if mpa
            (progn
                 (setq pa (list (+ (car pa) mpax)
                                (+ (cadr pa) mpay)))
                 (setq movv (list (+ (car movv) mpax)
                                (+ (cadr movv) mpay))))))
  (setvar "blipmode" bl)
  (setvar "highlight" hi)
  (redraw)
 (princ))