;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;                                                        ;;;;
;;;; Copyright (c) Jun. 1996 by Takehiko Nagakura.          ;;;;
;;;; All rights reserved.                                   ;;;;
;;;;                                                        ;;;;
;;;; Do not copy, use, modify or distribute this software   ;;;;
;;;; without written permission by Nagakura. Nagakura will  ;;;;
;;;; not be responsible for any consequence of its use.     ;;;;
;;;;                                                        ;;;;
;;;; Takehiko Nagakura  (e-mail: takehiko@mit.edu)          ;;;;
;;;;    Massachusetts Institute of Technology               ;;;;
;;;;    77 Massachusetts Ave. 10-472M, Cambridge, MA 02139  ;;;;
;;;;                                                        ;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;; Last updated Feb 2, 2001 by TN 

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;  This program illustrates different ways of making repetitive structures
;  using AutoLISP commands, while, repeat, if, and, or.
; 
;  use of functions
;
;(c:demo)
;
;(dome_row_while  xpos ypos xwidth ywidth 
;                  number_of_horizontal_bays)
;(dome_row_repeat xpos ypos xwidth ywidth
;                  number_of_horizontal_bays)
;(dome_matrix     xpos ypos xwidth ywidth
;                  number_of_horizontal_bays
;                  number_of_vertical_bays)
;(alternate_bays  xpos ypos xwidth ywidth
;                  number_of_horizontal_bays)
;(cornered_matrix xpos ypos xwidth ywidth
;                  number_of_horizontal_bays
;                  number_of_vertical_bays)
;
;The above functions use the following functions to generate
;two types of unit bays.
;
;( pendentive         xpos ypos xwidth ywidth )
;( crsoss_vault       xpos ypos xwidth ywidth )


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; some preparations 
;
(command "osnap" "off")
(if (null (member "geom3d.arx" (arx))) (arxload "geom3d"))  ; for R2000 

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; First, I set up 2 layers I need.
; This has to be processed only once when this file is loaded.
(command "layer" "new" "pendentive" "color" "cyan" "pendentive" "")
(command "layer" "new" "cross_vault" "color" "yellow" "cross_vault" "")

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; a simple loop using WHILE 
(defun dome_row_while (xpos ypos xwidth ywidth num_bay / count)
  (setq count 0)
  (while (< count num_bay)
	  (pendentive xpos ypos xwidth ywidth)    
	  (setq xpos (+ xpos xwidth)) 
	  (setq count (+ 1 count)) 
     ;(print (list count x y))  ; uncomment this for debugging
  ) ; close while
 (redraw)
) ; close defun

; (dome_row_while 0 0 2 3 4)  ; use this for test

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; a simple loop using REPEAT
(defun dome_row_repeat (xpos ypos xwidth ywidth num_bay )
   (repeat num_bay
       (pendentive xpos ypos xwidth ywidth)
       (setq xpos (+ xpos xwidth)) 
   )
 (redraw)
)

; (dome_row_repeat 0 0 2 3 4)  ; use this for test

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; a 2 dimensional loop    
(defun dome_matrix (xpos ypos xwidth ywidth num_bay_x num_bay_y / y_start)
   (setq y_start ypos)            ; records the first ypos
   (repeat num_bay_x
      (repeat num_bay_y
         (pendentive xpos ypos xwidth ywidth)
         (setq ypos (+ ypos ywidth))
      ) ; repeat num_bay_y
      (setq ypos y_start)         ; rewinds ypos back to y_start
      (setq xpos (+ xpos xwidth)) 
   ) ; repeat num_bay_x
 (redraw)
)

; (dome_matrix 0 0 4 5 2 3)  ; use this for test

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; a loop that alternates dome and cross-vault 
(defun alternate_bays (xpos ypos xwidth ywidth num_bay / x y count)
  (setq count 0)
  (while (< count num_bay)
    (if (= 0 (rem count 2))
      (pendentive  xpos ypos xwidth ywidth)  ; count is an even number, then draw pendentive
      (cross_vault xpos ypos xwidth ywidth)  ; count is an odd number, then draw cross-vault
    ) ; close if
	(setq xpos (+ xpos xwidth))
    (setq count (+ count 1))
  ) ; close while
  (redraw)
) ; close defun

; (alternate_bays 0 0 2 3 5)   ; use this for test

 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; a dome matrix with special corner conditions     
(defun cornered_matrix (xpos ypos xwidth ywidth num_bay_x num_bay_y
		 / x_count y_count y_start )

   (setq x_count 1)
   (setq y_start ypos)            ; records the first ypos

   (repeat num_bay_x
      (setq y_count 1)            ; rewinds the counter

	  (repeat num_bay_y
         (if (and (or (= x_count 1) (= x_count num_bay_x))
                  (or (= y_count 1) (= y_count num_bay_y)))
            (progn ; needs this to execute more than one command
              (pendentive xpos ypos xwidth ywidth)  ; draw pendentives at the corners
              (print "Making a corner bay...")
             ) ; end progn
            
            (progn
              (cross_vault xpos ypos xwidth ywidth) ; otherwise, just draw cross_vault
              (print "Making a regular bay...")
             ) ; end progn
         ) ; if
         (setq ypos (+ ypos ywidth))
         (setq y_count (+ y_count 1))
      ) ; repeat num_bay_y

	  (setq ypos y_start)         ; rewinds ypos back to y_start
      (setq xpos (+ xpos xwidth)) 
      (setq x_count (+ x_count 1))
   ) ; repeat num_bay_x

 (redraw)
)

; (cornered_matrix 0 0 2 3 3 4)   ; use this for test

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;Now try this for getting examples
(defun c:demo ()
  (command "ucs" "world")

  (command "vpoint" (list -1 -1 1))
  (command "zoom" "window" (list -20 -1) (list  5 50))
  (command "ucsicon" "origin") 			
  (command "isolines" 30)

  (dome_row_while 0 0 2 3 4)
  ;(dome_row_repeat 0 0 2 3 4)

  (command "ucs" "origin" (list 0 6))
  (dome_matrix 0 0 2 3 3 2)

  (command "ucs" "origin" (list 0 10))
  (alternate_bays 0 0 2 3 5)

  (command "ucs" "origin" (list 0 6))
  (cornered_matrix 0 0 2 3 3 3)

  (command "ucs" "world")
)


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; This function places a pendentive dome at the specified
; coordinates in the current UCS. It preserves the current UCS
; system by saving it at the beginning and retrieving it at the end.
(defun pendentive (xpos ypos xwidth ywidth / hx hy radius semic hemis brect bx pd) 
  ;1) set up local coordinate system  
  (command "ucs" "delete" "temp_ucs")      ; deletes the previous definition
  (command "ucs" "save" "temp_ucs")        ; saves the current UCS
  (command "ucs" "origin" (list xpos ypos)); moves the UCS origin to xpos, ypos
  (command "layer" "set" "pendentive" "")

 ;2) set up local variables
  (setq hx (/ xwidth 2.0))	; make sure to divide by 2.0, not 2
  (setq hy (/ ywidth 2.0))
  (setq radius (sqrt (+ (* hx hx) (* hy hy)))) ;sqrt does square root
 
 ;3) makes a hemisphere 
  (command "pline" (list 0 0) (list radius 0)
		"Arc" "Second" (list 0 radius) (list (- radius) 0)
		"Line" "close")
  (setq semic (entlast)) ; now the value of semic is an entity name. 
  (command "revolve" semic "" (list 0 0) (list 1 0) 180); revolves a solid 
  (setq hemis (entlast))

 ;4) makes a box
  (setq brect (base_rect xwidth ywidth)) ; Now brect is an entity name 
  (command "extrude" brect "" (+ radius 1) 0)
  (setq bx (entlast))
 
  ;5) intersect the box and hemisphere
  (command "intersect" bx hemis "")
  (setq pd (entlast))
  
  ;6) clean up
  (command "ucs" "restore" "temp_ucs")	; restore the UCS back to world
  bx   ; this function returns an entity name of a solid pendentive dome 
)

;(pendentive 0 0 2 3)
;The function above uses this function.
(defun base_rect (xwidth ywidth / xr xl yh yl)
  (setq xr (/ xwidth 2.0))
  (setq xl (- xr))
  (setq yh (/ ywidth 2.0))
  (setq yl (- yh))
  (command "pline" (list xr yh) (list xl yh) (list xl yl) (list xr yl) "c")
  (entlast)  ; this function returns an entity name, which is a rectangular pline
)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun cross_vault (xpos ypos xwidth ywidth / hx hy section cyl_1 cyl_2 cv)
 ;1) moving the UCS   
  (command "ucs" "delete" "temp_ucs")       ; deletes the previous definition
  (command "ucs" "save" "temp_ucs")         ; saves the current UCS
  (command "ucs" "origin" (list xpos ypos)) ; moves the UCS origin to xpos, ypos
 ;2) setting up the local variables
  (command "layer" "set" "cross_vault" "")
  (setq hx (/ xwidth 2.0))
  (setq hy (/ ywidth 2.0))
 ;3) first cylinder 
  (command "pline" (list hx 0) (list hx hy) (list (- hx) hy) (list (- hx) 0) "c")
  (setq section (entlast))
  (command "revolve" section "" '(0 0) '(1 0) 180) 
  (setq cyl_1 (entlast))
 ;4) second cylinder
  (command "pline" (list 0 hy) (list hx hy) (list hx (- hy)) (list 0 (- hy)) "c")
  (setq section (entlast))
  (command "revolve" section "" '(0 1) '(0 0) 180)
  (setq cyl_2 (entlast))
 ;5) union two cylinders 
  (command "union" cyl_1 cyl_2 "") 
  (setq cv (entlast))
  (command "ucs" "restore" "temp_ucs")   ; restore the UCS back to previous one 
  cv
)

;(cross_vault 0 0 2 2.5)