;;AUTOCAD PROGRAMMING CHALLENGE NO. 2
;;C:XMASTREE
;;John F. Uhden, CADvantage Custom Utilities
;;CADvantage@compuserve.com
;;12-11-97
;;Note (12-08-02):
;;  Jim Fisher recalls better than I the rules of this
;;  programming challenge on the old ACAD Forum.
;;  Technically, this exceeded limitations and should
;;  have been disqualified.  Dietmar Rudolph's was
;;  technically correct and pretty darn nifty.  Too
;;  bad I don't have a copy to share.  In fact, we can
;;  thank Jim for retrieving this from his archives.
;;  Anyway, it's still cute.
;;Revised (12-08-02) for R15+
;;  Added vl-cmdf, UCSICON=0, and SHADE command only.
;;  Try setting SHADEMODE to different values before running,
;;  and then use the 3DORBIT command after.
;;  HAPPY HOLIDAYS!
(defun c:XMASTREE (/ rad R N Z dZ a da d H I J K +- s c)
  (setq	c (if (>= (getvar "acadver") "15")
	    vl-cmdf
	    command
	  )
  )
  (setq	d distance
	s setvar
  )
  (s "CMDECHO" 0)
  (s "UCSICON" 0)
  (s "TILEMODE" 1)
  (s "UCSFOLLOW" 0)
  (s "HIGHLIGHT" 0)
  (s "REGENMODE" 1)
  (c "_.LINE" "0,0" "1,1" "")
  (c "_.ZOOM" "_E")
  (C "_.LAYER" "_U" "*" "")
  (C "_.ERASE" (ssget "X") "")
  (c "_.UCS" "_W")
  (C "_.VPOINT" "-3,-3,1.2")
  (C "_.ZOOM" "_C" "0,0,7" 15)
  (defun rad (Z) (* 0.75 (sqrt (- 12.0 Z))))
  (setq	N   25
	Z   1.0
	dZ  0.5
	a   0.0
	da  (/ pi N)
	hpi (* pi 0.5)
  )
  (while (< Z 12.0)
    (setq R (rad Z))
    (repeat N
      (setq +- (if (= +- -)
		 +
		 -
	       )
	    H  (list 0.0 0.0 (+- Z (* dz 0.25)))
	    I  (polar H a R)
	    a  (+ a da)
	    I  (mapcar '+ I (list 0.0 0.0 (* dZ 0.5)))
	    J  (polar H a (+ R R))
	    a  (+ a da)
	    J  (mapcar '+ J (list 0.0 0.0 dZ))
	    K  (polar H a R)
	    K  (mapcar '+ K (list 0.0 0.0 (* dZ 0.1)))
      )
      (entmake (list '(0 . "3DFACE")
		     '(62 . 3)
		     '(70 . 0)
		     (cons 10 H)
		     (cons 11 I)
		     (cons 12 J)
		     (cons 13 K)
	       )
      )
      (if (and (zerop (rem (1- Z) 1)) (zerop (rem N 5)))
	(progn
	  (entmake (list '(0 . "CIRCLE")
			 (cons 10 J)
			 '(40 . 0.07)
			 '(39 . 0.35)
			 '(62 . 255)
		   )
	  )
	  (prompt " HO")
	  (setq J (mapcar '+ J (list 0.0 0.0 0.4)))
	  (entmake
	    (list '(0 . "3DFACE")
		  '(62 . 2)
		  '(70 . 0)
		  (cons 10 (polar J (+ a hpi) (* (d I K) 0.2)))
		  (cons 11 (polar J (- a hpi) (* (d I K) 0.2)))
		  (cons 12 (mapcar '+ J (list 0.0 0.0 (* dZ 0.5))))
		  (cons 13 (mapcar '+ J (list 0.0 0.0 (* dZ 0.5))))
	    )
	  )
	)
      )
    )
    (terpri)
    (setq Z (+ Z dZ)
	  a (+ a (/ da 2))
    )
  )
  (entmake '((0 . "3DFACE")
	     (62 . 7)
	     (10 -0.536 0.57073 13.225)
	     (11 0.5123 -0.545566 13.225)
	     (12 -0.011815 0.012582 12.6687)
	     (13 -0.0118153 0.012582 12.6687)
	     (70 . 0)
	    )
  )
  (entmake '((0 . "3DFACE")
	     (62 . 7)
	     (10 -0.3357 0.3575 12.325)
	     (11 -0.0118 0.01258 13.7813)
	     (12 0.18839 -0.200611 12.8812)
	     (13 0.188387 -0.200611 12.8812)
	     (70 . 0)
	    )
  )
  (entmake '((0 . "3DFACE")
	     (62 . 7)
	     (10 -0.536 0.57073 13.225)
	     (11 0.31212 -0.33237 12.3249)
	     (12 0.111916 -0.11918 13.225)
	     (13 0.111916 -0.119179 13.225)
	     (70 . 0)
	    )
  )
  (command "_zoom" "_e")
  (command "_zoom" ".9x")
  (command "_shademode" "_g")
  (setvar "cmdecho" 1)
  (alert "\nMerry Christmas!")
  (princ)
)