;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;                                                        ;;;;
;;;; 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 Nov 2, 1996 by TN 

; This file provides a function to make pendentive domes. 
; The program works in AutoCAD R13.
;
; To load this file,
;
;   function                             : description 
;   (pendentive xpos ypos xwidth ywidth) : draws a pendentive dome
;   (base_rect  xwidth ywidth)           : draws a rectangle at UCS origin
;   (c:demo)                             : draws variations of pendentive dome


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; 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
                   / h_xwidth h_ywidth radius semi-c s-hemisphere
                     brect s-box s-pendentive)

  ;1) saves the current UCS
  (command "ucs" "delete" "temp_pendentive") ; deletes the previous definition if any
  (command "ucs" "save"   "temp_pendentive") ; saves the current UCS
  (command "ucs" "origin" (list xpos ypos))  ; moves the UCS origin to xpos, ypos
                                             ; relative to the current UCS

  ;2) sets up local variables
  (setq h_xwidth (/ xwidth 2.0))    ; compute half of xwidth and ywidth 
  (setq h_ywidth (/ ywidth 2.0))    ; make sure to divide by 2.0, not 2
  (setq radius (sqrt (+ (* h_xwidth h_xwidth) (* h_ywidth h_ywidth))))
                                    ; compute the radius 
  ;3) draws a semi-circle 
  (command "pline" (list 0 0) (list radius 0)
		   "Arc" "Second" (list 0 radius) (list (- radius) 0)
		   "Line" "close")

  (setq semi-c (entlast)) ; set the value of semic to the semi-circle 

  ;4) makes a solid hemi-sphere by revolving the semi-circle 
  (command "revolve" semi-c "" (list 0 0) (list 1 0) 180)
  (setq s-hemisphere (entlast)) ; set the value of s-hemisphere to the revolved solid

  ;5) makes a solid box
  (setq brect (base_rect xwidth ywidth))
  ;Now brect is an entity name and solext can take an entity name for input
  (command "extrude" brect "" (+ radius 1) 0)
  (setq s-box  (entlast)) ; set the value of s-box to the extruded solid

  ;6) intersect the 2 solids
  (command "intersect" s-hemisphere s-box "")
  (setq s-pendentive  (entlast)) ; set the value of s-pendentive to the intersected solid

  ;7) restore the UCS 
  (command "ucs" "restore" "temp_pendentive")	; restore the UCS back to world
  s-pendentive ; the funciton returns the solid pendentive 
)


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;The above function uses this function defined below.
;It just draws a rectangle, which has the given vertical and horizontal
;dimentions and is centered at the origin of UCS.
(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 of a rectangular pline
)


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;Now try this for getting examples
(defun c:demo ()
  (command "vpoint" (list -1 -1 1))
  (command "zoom" "window" (list -6 2) (list 18 6))
  (command "ucsicon" "origin") 			
  (command "isolines" 20)

  (command "ucs" "world")
  (pendentive 0 0 2 2)
  (pendentive 4 0 1.8 4)

  (command "ucs" "origin" (list 0 4))
  (command "ucs" "z" 20)
  (pendentive 0 0 1 1) 
  (pendentive 4 0 3 1.5)

  (command "ucs" "world")
  (command "regen")
)