 ; Blora - rearrange blocks.
 ; Copyright 1996 by Rocket Software
 ; For those who would rather be hang gliding down Mount Everest.
 (DEFUN C:BLORA (/ ss num txb xa incr incrp txa enn nna ya yb txh yy nn)
  (setvar "cmdecho" 0)
  (command "undo" "mark")
  (prompt "Pick blocks: ")
  (setq ss (ssget (list (cons 0 "INSERT"))))
;----------------------Request parameters-------------------------
  (setq xa (getpoint "\nPick startpoint:"))
  (if (/= (type incr) 'real) (setq incr 6))
  (setq incrp (getdist xa (strcat "\nLine spacing <" (rtos incr 2 2) ">:")))
  (if incrp (setq incr incrp))
;--------------------------Main Loop------------------------------
  (setq num 0)
  (while (setq txa (ssname ss 0))             ; first entity name
         (setq enn 1)                         ; entity to test - initialize
         (setq nna (entget txa))              ; the whole thing
         (setq ya (cdr (assoc 10 nna)))       ; Y insertion
;----------------------Find highest entity------------------------
         (while (setq txb (ssname ss enn))                 ; next entity
                (setq yb (cdr (assoc 10 (entget txb))))    ; Y insertion
                (if (> (cadr yb) (cadr ya))                ; if txb highest
                    (progn
                         (setq txa txb)                    ; next becomes txa
                         (setq nna (entget txa))           ; get whole thing
                         (setq ya (cdr (assoc 10 nna)))))  ; and Y insertion
                (setq enn (1+ enn)))                       ; next entity
;-----------------------------------------------------------------
         (setq num (1+ num))
         (setq yy (cdr (assoc 10 nna)))
         (setq nn (list (car yy) (cadr xa)))
         (command "move" txa "" yy nn)
         (setq xa (list (car xa) (- (cadr xa) incr)))
         (ssdel txa ss))
;------------------------Main Loop End---------------------------
  (setq ss nil)
  (if (> num 0)
      (progn    
            (if (= num 1)
                (prompt "\n1 line put on vertical hold")
                (prompt (strcat "\n" (ITOA num) " lines stratified")))
            (if (= num 4) (prompt "\n ...by Nubian slave girls."))))
 (princ))