; The Codewriting Workbook
; Creating Computational Architecture in AutoLISP
; by Robert J. Krawczyk
; Princeton Architectural Press, 2008
; --------------------------------------------------------------------------
; CH06B.LSP
; --------------------------------------------------------------------------
; Disclaimer: The information contained in this file is distributed on an
; "as is" basis, without warranty.  Although every precaution has been taken
; in the preparation of this work, the author and publisher shall not have 
; any liability to any person or entity with respect to any loss or damage
; caused or alleged to be caused directly or indirectly by the information
; contained in this work.
; --------------------------------------------------------------------------
(defun dtr (a) (* pi (/ a 180.0)))
(defun rtd (a) (/ (* a 180.0) pi))
; --------------------------------------------------------------------------
(defun sign (a) (if (< a 0.0) (- 0 1.0) (+ 0 1.0)))
; --------------------------------------------------------------------------
(defun rn (/ modulus multiplier increment random)
  (if (not rnseed) (setq rnseed (getvar "DATE")))
  (setq modulus 65536
   multiplier 25173
   increment  13849
   rnseed (rem (+ (* multiplier rnseed) increment) modulus)
   random  (/ rnseed modulus)
  )
)
;---------------------------------------------------------------------------
; --------------------------------------------------------------------------
(defun rotate2d ( pt ptc ang / pt1 pt2 )
  ; rotate pt ang degrees
  (setq pt1 (list (+ (nth 0 pt) (- 0 (nth 0 ptc))) (+ (nth 1 pt) (- 0 (nth 1 ptc))) (nth 2 pt)))
  (setq pt2 (list (- (* (nth 0 pt1) (cos (dtr ang))) (* (nth 1 pt1) (sin (dtr ang))))
  (+ (* (nth 0 pt1) (sin (dtr ang))) (* (nth 1 pt1) (cos (dtr ang))))
  	  (nth 2 pt)))
  (list (+ (nth 0 pt2) (+ 0 (nth 0 ptc))) (+ (nth 1 pt2) (+ 0 (nth 1 ptc))) (nth 2 pt))
)  
;---------------------------------------------------------------------------
;---------------------------------------------------------------------------
; ZW - zoom window
(defun c:zw ()
 (command "zoom" "w")
)
; ZP - zoom previous
(defun c:zp ()
 (command "zoom" "p") 
) 
; ZE - zoom extents
(defun c:ze ()
 (command "zoom" "e" "zoom" ".9x")
)
; ZX - zoom .9x  
(defun c:zx ()
  (command "zoom" ".9x")
)
;---------------------------------------------------------------------------
; VT - top view
(defun c:vt () 
  (command "vpoint" "r" 270 90)
  (command "zoom" "e" "ucs" "v" "zoom" ".9x")
  (princ)
)
; VL - left view
(defun c:vl () 
  (command "vpoint" "r" 180 0)
  (command "zoom" "e" "ucs" "v" "zoom" ".9x")
  (princ)
)
; VR - right view
(defun c:vr () 
  (command "vpoint" "r" 0 0)
  (command "zoom" "e" "ucs" "v" "zoom" ".9x")
  (princ)
)
; VF - front view
(defun c:vf () 
  (command "vpoint" "r" 270 0)
  (command "zoom" "e" "ucs" "v" "zoom" ".9x")
  (princ)
)
; VB - back view
(defun c:vb () 
  (command "vpoint" "r" 90 0)
  (command "zoom" "e" "ucs" "v" "zoom" ".9x")
  (princ)
)
; VSW - SW view
(defun c:vsw () 
  (command "vpoint" "r" 270 90)
  (command "ucs" "v")
  (command "vpoint" "r" 225 45)
  (command "zoom" "e" "zoom" ".9x")
  (princ)
)
; VSE - SE view
(defun c:vse () 
  (command "vpoint" "r" 270 90)
  (command "ucs" "v")
  (command "vpoint" "r" 315 45)
  (command "zoom" "e" "zoom" ".9x")
  (princ)
)
; VNE - NE view
(defun c:vne () 
  (command "vpoint" "r" 270 90)
  (command "ucs" "v")
  (command "vpoint" "r" 45 45)
  (command "zoom" "e" "zoom" ".9x")
  (princ)
)
;--------------------------------------------------------------------------
;--------------------------------------------------------------------------
;--------------------------------------------------------------------------
(defun prog01 ()
 (graphscr)
 (command ".ERASE" "all" "") 
 ; pyramid panel
 ; lines only
 (setq pnt0 (list 0 0 0))
 (setq xside (getdist pnt0 "\nEnter X side panel:"))
 (setq yside (getdist pnt0 "\nEnter Y side panel:"))
 (setq nx(getint "\nEnter number of X panels:"))
 (setq ny(getint "\nEnter number of Y panels:"))
 (setq zhgt  (getdist pnt0 "\nEnter height:"))
 ; pyramidal panels - lines
 (setq ypos (+ (nth 1 pnt0) (/ yside 2)))
 (repeat ny 
   (setq xpos (+ (nth 0 pnt0) (/ xside 2)))
   (repeat  nx
     ; center top point
     (setq pntc (list xpos ypos zhgt)) 
     (setq pnt1 (list (- xpos (/ xside 2)) (- ypos (/ yside 2)) 0.0))
     (setq pnt2 (list (+ xpos (/ xside 2)) (- ypos (/ yside 2)) 0.0))
     (setq pnt3 (list (+ xpos (/ xside 2)) (+ ypos (/ yside 2)) 0.0))
     (setq pnt4 (list (- xpos (/ xside 2)) (+ ypos (/ yside 2)) 0.0))
     (command ".LINE" pntc pnt1 "")
     (command ".LINE" pntc pnt2 "")
     (command ".LINE" pntc pnt3 "")
     (command ".LINE" pntc pnt4 "")
     ; inc x
     (setq xpos (+ xpos xside))
   )
   ; inc y
   (setq ypos (+ ypos yside))
 )  
 (command ".ZOOM" "e")  
 (princ)
)
;--------------------------------------------------------------------------
(defun prog01a ()
 (graphscr)
 (command ".ERASE" "all" "") 
 ; pyramid panel
 ; 3DFACEs
 (setq pnt0 (list 0 0 0))
 (setq xside (getdist pnt0 "\nEnter X side panel:"))
 (setq yside (getdist pnt0 "\nEnter Y side panel:"))
 (setq nx(getint "\nEnter number of X panels:"))
 (setq ny(getint "\nEnter number of Y panels:"))
 (setq zhgt  (getdist pnt0 "\nEnter height:"))
 ; pyramidal panels - lines
 (setq ypos (+ (nth 1 pnt0) (/ yside 2)))
 (repeat ny 
   (setq xpos (+ (nth 0 pnt0) (/ xside 2)))
   (repeat  nx
     ; center top point
     (setq pntc (list xpos ypos zhgt)) 
     (setq pnt1 (list (- xpos (/ xside 2)) (- ypos (/ yside 2)) 0.0))
     (setq pnt2 (list (+ xpos (/ xside 2)) (- ypos (/ yside 2)) 0.0))
     (setq pnt3 (list (+ xpos (/ xside 2)) (+ ypos (/ yside 2)) 0.0))
     (setq pnt4 (list (- xpos (/ xside 2)) (+ ypos (/ yside 2)) 0.0))
     ; pyramid faces
     (command ".3DFACE" pntc pnt1 pnt2 pntc "") 
     (command ".3DFACE" pntc pnt2 pnt3 pntc "") 
     (command ".3DFACE" pntc pnt3 pnt4 pntc "") 
     (command ".3DFACE" pntc pnt4 pnt1 pntc "") 
     ; base
     (command ".3DFACE" pnt4 pnt3 pnt2 pnt1 "")
     ; inc x
     (setq xpos (+ xpos xside))
   )
   ; inc y
   (setq ypos (+ ypos yside))
 )  
 (command ".ZOOM" "e")  
 (princ)
)
;--------------------------------------------------------------------------
(defun prog02 ()
 (graphscr)
 (command ".ERASE" "all" "") 
 ; pyramid panel
 ; 3DFACEs
 (setq pnt0 (list 0 0 0))
 (setq xside (getdist pnt0 "\nEnter X side panel:"))
 (setq yside (getdist pnt0 "\nEnter Y side panel:"))
 (setq nx(getint "\nEnter number of X panels:"))
 (setq ny(getint "\nEnter number of Y panels:"))
 (setq zhgt  (getdist pnt0 "\nEnter height:"))
 (setq xyoff (getdist pnt0 "\nEnter XY top offset:"))
 ; pyramidal panels - lines
 (setq ypos (+ (nth 1 pnt0) (/ yside 2)))
 (repeat ny 
   (setq xpos (+ (nth 0 pnt0) (/ xside 2)))
   (repeat  nx
     ; random X and Y offset
     (setq xoff (* (rn) xyoff)) 
     (setq yoff (* (rn) xyoff)) 
     ; center top point
     (setq pntc (list (+ (- xpos (/ xyoff 2)) xoff) (+ (- ypos (/ xyoff 2)) yoff) zhgt)) 
     (setq pnt1 (list (- xpos (/ xside 2)) (- ypos (/ yside 2)) 0.0))
     (setq pnt2 (list (+ xpos (/ xside 2)) (- ypos (/ yside 2)) 0.0))
     (setq pnt3 (list (+ xpos (/ xside 2)) (+ ypos (/ yside 2)) 0.0))
     (setq pnt4 (list (- xpos (/ xside 2)) (+ ypos (/ yside 2)) 0.0))
     ; pyramid faces
     (command ".3DFACE" pntc pnt1 pnt2 pntc "") 
     (command ".3DFACE" pntc pnt2 pnt3 pntc "") 
     (command ".3DFACE" pntc pnt3 pnt4 pntc "") 
     (command ".3DFACE" pntc pnt4 pnt1 pntc "") 
     ; base
     (command ".3DFACE" pnt4 pnt3 pnt2 pnt1 "")
     ; inc x
     (setq xpos (+ xpos xside))
   )
   ; inc y
   (setq ypos (+ ypos yside))
 )  
 (command ".ZOOM" "e")  
 (princ)
)
;--------------------------------------------------------------------------
(defun prog03 ()
 (graphscr)
 (command ".ERASE" "all" "") 
 ; pyramid panel
 ; 3DFACEs
 (setq pnt0 (list 0 0 0))
 (setq xside (getdist pnt0 "\nEnter X side panel:"))
 (setq yside (getdist pnt0 "\nEnter Y side panel:"))
 (setq nx(getint "\nEnter number of X panels:"))
 (setq ny(getint "\nEnter number of Y panels:"))
 (setq zhgt  (getdist pnt0 "\nEnter height:"))
 (setq xyoff (getdist pnt0 "\nEnter XY top offset:"))
 (setq xyang (getreal "\nEnter XY top inc angle:"))
 ; pyramidal panels - 3DFACEs
 (setq ypos (+ (nth 1 pnt0) (/ yside 2)))
 (repeat ny 
   (setq xpos (+ (nth 0 pnt0) (/ xside 2)))
   ; random angle start
   (setq ang (* (fix (* (rn) (- (/ 360.0 xyang) 0.1))) xyang))
   (repeat nx
     ; circular xy offset
     (setq xypt (polar (list 0 0 0) (dtr ang) xyoff))
     (setq xoff (nth 0 xypt)) 
     (setq yoff (nth 1 xypt)) 
     ; top center pt
     (setq pntc (list (+ xpos xoff) (+ ypos yoff) zhgt))
     ; four bottom points
     (setq pnt1 (list (- xpos (/ xside 2)) (- ypos (/ yside 2)) 0.0))
     (setq pnt2 (list (+ xpos (/ xside 2)) (- ypos (/ yside 2)) 0.0))
     (setq pnt3 (list (+ xpos (/ xside 2)) (+ ypos (/ yside 2)) 0.0))
     (setq pnt4 (list (- xpos (/ xside 2)) (+ ypos (/ yside 2)) 0.0))
     ; pyramid faces
     (command ".3DFACE" pntc pnt1 pnt2 pntc "") 
     (command ".3DFACE" pntc pnt2 pnt3 pntc "") 
     (command ".3DFACE" pntc pnt3 pnt4 pntc "") 
     (command ".3DFACE" pntc pnt4 pnt1 pntc "") 
     ; base
     (command ".3DFACE" pnt4 pnt3 pnt2 pnt1 "")
     ; inc x
     (setq xpos (+ xpos xside))
     ; inc angle
     (setq ang (+ ang xyang))  
   )
   ; inc y
   (setq ypos (+ ypos yside))
 )  
 (command ".ZOOM" "e")  
 (princ)
)
;--------------------------------------------------------------------------
;--------------------------------------------------------------------------
(defun prog04 ()
 (graphscr)
 (command ".ERASE" "all" "") 
 ; square top, truncated pyramids
 ; 3DFACEs
 (setq pnt0 (list 0 0 0))
 (setq xside (getdist pnt0 "\nEnter X side panel:"))
 (setq yside (getdist pnt0 "\nEnter Y side panel:"))
 (setq nx(getint "\nEnter number of X panels:"))
 (setq ny(getint "\nEnter number of Y panels:"))
 (setq zhgt  (getdist pnt0 "\nEnter height:"))
 (setq xdim  (getdist pnt0 "\nEnter X dim of panel:"))
 (setq ydim  (getdist pnt0 "\nEnter Y dim of panel:"))
 ; rectangles panels - 3DFACES
 (setq ypos (+ (nth 1 pnt0) (/ yside 2)))
 (repeat ny 
   (setq xpos (+ (nth 0 pnt0) (/ xside 2)))
   (repeat  nx
     ; top center pt
     (setq pntc (list xpos ypos zhgt))
     ; top pts
     (setq pntt1 (list (- (nth 0 pntc) (/ xdim 2)) (- (nth 1 pntc) (/ ydim 2)) (nth 2 pntc)))  
     (setq pntt2 (list (+ (nth 0 pntc) (/ xdim 2)) (- (nth 1 pntc) (/ ydim 2)) (nth 2 pntc)))  
     (setq pntt3 (list (+ (nth 0 pntc) (/ xdim 2)) (+ (nth 1 pntc) (/ ydim 2)) (nth 2 pntc)))  
     (setq pntt4 (list (- (nth 0 pntc) (/ xdim 2)) (+ (nth 1 pntc) (/ ydim 2)) (nth 2 pntc)))  
     ; bottom pts 
     (setq pntb1 (list (- xpos (/ xside 2)) (- ypos (/ yside 2)) 0.0))
     (setq pntb2 (list (+ xpos (/ xside 2)) (- ypos (/ yside 2)) 0.0))
     (setq pntb3 (list (+ xpos (/ xside 2)) (+ ypos (/ yside 2)) 0.0))
     (setq pntb4 (list (- xpos (/ xside 2)) (+ ypos (/ yside 2)) 0.0))
     ; top
     (command ".3DFACE" pntt1 pntt2 pntt3 pntt4 "") 
     (command ".3DFACE" pntt1 pntb1 pntb2 pntt2 "")
     ; sides
     (command ".3DFACE" pntt2 pntb2 pntb3 pntt3 "") 
     (command ".3DFACE" pntt3 pntb3 pntb4 pntt4 "") 
     (command ".3DFACE" pntt4 pntb4 pntb1 pntt1 "") 
     ; base
     (command ".3DFACE" pntb4 pntb3 pntb2 pntb1 "")
     ; inc x
     (setq xpos (+ xpos xside))
   )
   ; inc y
   (setq ypos (+ ypos yside))
 )
 (command ".ZOOM" "e")  
 (princ)
)
;--------------------------------------------------------------------------
;--------------------------------------------------------------------------
(defun prog05 ()
 (graphscr)
 (command ".ERASE" "all" "") 
 ; square top, truncated pyramids
 ; 3DFACEs
 ; random XY offset of top at the corners
 (setq pnt0 (list 0 0 0))
 (setq xside (getdist pnt0 "\nEnter X side panel:"))
 (setq yside (getdist pnt0 "\nEnter Y side panel:"))
 (setq nx(getint "\nEnter number of X panels:"))
 (setq ny(getint "\nEnter number of Y panels:"))
 (setq zhgt  (getdist pnt0 "\nEnter height:"))
 (setq xdim  (getdist pnt0 "\nEnter X dim of panel:"))
 (setq ydim  (getdist pnt0 "\nEnter Y dim of panel:"))
 ; rectangles panels - 3DFACES
 (setq ypos (+ (nth 1 pnt0) (/ yside 2)))
 (repeat ny 
   (setq xpos (+ (nth 0 pnt0) (/ xside 2)))
   (repeat nx
     ; random X and Y offset, select corner
     (setq nc (fix (* (rn) 3.99)))
     ; top center pt based on corner
     (if (= nc 0) (setq pntc (list (+ (- xpos (/ xside 2)) (/ xdim 2)) (+ (- ypos (/ yside 2)) (/ ydim 2)) zhgt)))
     (if (= nc 1) (setq pntc (list (- (+ xpos (/ xside 2)) (/ xdim 2)) (+ (- ypos (/ yside 2)) (/ ydim 2)) zhgt)))
     (if (= nc 2) (setq pntc (list (- (+ xpos (/ xside 2)) (/ xdim 2)) (- (+ ypos (/ yside 2)) (/ ydim 2)) zhgt)))
     (if (= nc 3) (setq pntc (list (+ (- xpos (/ xside 2)) (/ xdim 2)) (- (+ ypos (/ yside 2)) (/ ydim 2)) zhgt)))
     ; top pts
     (setq pntt1 (list (- (nth 0 pntc) (/ xdim 2)) (- (nth 1 pntc) (/ ydim 2)) (nth 2 pntc)))  
     (setq pntt2 (list (+ (nth 0 pntc) (/ xdim 2)) (- (nth 1 pntc) (/ ydim 2)) (nth 2 pntc)))  
     (setq pntt3 (list (+ (nth 0 pntc) (/ xdim 2)) (+ (nth 1 pntc) (/ ydim 2)) (nth 2 pntc)))  
     (setq pntt4 (list (- (nth 0 pntc) (/ xdim 2)) (+ (nth 1 pntc) (/ ydim 2)) (nth 2 pntc)))  
     ; bottom pts 
     (setq pntb1 (list (- xpos (/ xside 2)) (- ypos (/ yside 2)) 0.0))
     (setq pntb2 (list (+ xpos (/ xside 2)) (- ypos (/ yside 2)) 0.0))
     (setq pntb3 (list (+ xpos (/ xside 2)) (+ ypos (/ yside 2)) 0.0))
     (setq pntb4 (list (- xpos (/ xside 2)) (+ ypos (/ yside 2)) 0.0))
     ; top
     (command ".3DFACE" pntt1 pntt2 pntt3 pntt4 "") 
     (command ".3DFACE" pntt1 pntb1 pntb2 pntt2 "")
     ; sides
     (command ".3DFACE" pntt2 pntb2 pntb3 pntt3 "") 
     (command ".3DFACE" pntt3 pntb3 pntb4 pntt4 "") 
     (command ".3DFACE" pntt4 pntb4 pntb1 pntt1 "") 
     ; base
     (command ".3DFACE" pntb4 pntb3 pntb2 pntb1 "")
     ; inc x
     (setq xpos (+ xpos xside))
   )
   ; inc y
   (setq ypos (+ ypos yside))
 )
 (command ".ZOOM" "e")  
 (princ)
)
;--------------------------------------------------------------------------
;--------------------------------------------------------------------------
(defun prog06 ()
 (graphscr)
 (command ".ERASE" "all" "") 
 ; square top, truncated pyramids
 ; 3DFACEs
 ; random top dimensions
 (setq pnt0 (list 0 0 0))
 (setq xside (getdist pnt0 "\nEnter X side panel:"))
 (setq yside (getdist pnt0 "\nEnter Y side panel:"))
 (setq nx(getint "\nEnter number of X panels:"))
 (setq ny(getint "\nEnter number of Y panels:"))
 (setq zhgt  (getdist pnt0 "\nEnter height:"))
 (setq xdim  (getdist pnt0 "\nEnter min X dim of panel:"))
 (setq ydim  (getdist pnt0 "\nEnter min Y dim of panel:"))
 (setq mdim  (getdist pnt0 "\nEnter max panel size:")) 
 ; rectangles panels - 3DFACES
 (setq ypos (+ (nth 1 pnt0) (/ yside 2)))
 (repeat ny 
   (setq xpos (+ (nth 0 pnt0) (/ xside 2)))
   (repeat  nx
     ; random top dimension
     (setq moff (/ (* (rn) mdim) 2.0))
     (setq xfdim (+ xdim moff)) 
     (setq yfdim (+ ydim moff)) 
     ; top center pt
     (setq pntc (list xpos ypos zhgt))
     ; top pts
     (setq pntt1 (list (- (nth 0 pntc) (/ xfdim 2)) (- (nth 1 pntc) (/ yfdim 2)) (nth 2 pntc)))  
     (setq pntt2 (list (+ (nth 0 pntc) (/ xfdim 2)) (- (nth 1 pntc) (/ yfdim 2)) (nth 2 pntc)))  
     (setq pntt3 (list (+ (nth 0 pntc) (/ xfdim 2)) (+ (nth 1 pntc) (/ yfdim 2)) (nth 2 pntc)))  
     (setq pntt4 (list (- (nth 0 pntc) (/ xfdim 2)) (+ (nth 1 pntc) (/ yfdim 2)) (nth 2 pntc)))  
     ; bottom pts 
     (setq pntb1 (list (- xpos (/ xside 2)) (- ypos (/ yside 2)) 0.0))
     (setq pntb2 (list (+ xpos (/ xside 2)) (- ypos (/ yside 2)) 0.0))
     (setq pntb3 (list (+ xpos (/ xside 2)) (+ ypos (/ yside 2)) 0.0))
     (setq pntb4 (list (- xpos (/ xside 2)) (+ ypos (/ yside 2)) 0.0))
     ; top
     (command ".3DFACE" pntt1 pntt2 pntt3 pntt4 "") 
     (command ".3DFACE" pntt1 pntb1 pntb2 pntt2 "")
     ; sides
     (command ".3DFACE" pntt2 pntb2 pntb3 pntt3 "") 
     (command ".3DFACE" pntt3 pntb3 pntb4 pntt4 "") 
     (command ".3DFACE" pntt4 pntb4 pntb1 pntt1 "") 
     ; base
     (command ".3DFACE" pntb4 pntb3 pntb2 pntb1 "")
     ; inc x
     (setq xpos (+ xpos xside))
   )
   ; inc y
   (setq ypos (+ ypos yside))
 )
 (command ".ZOOM" "e")  
 (princ)
)
;--------------------------------------------------------------------------