- 积分
- 15341
- 明经币
- 个
- 注册时间
- 2002-2-4
- 在线时间
- 小时
- 威望
-
- 金钱
- 个
- 贡献
-
- 激情
-
|
发表于 2002-12-25 12:01:00
|
显示全部楼层
XMASTREE
;;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)
)
)
(C "_.SHADE")
(setvar "cmdecho" 1)
(alert "\nMerry Christmas!")
(princ)
) |
本帖子中包含更多资源
您需要 登录 才可以下载或查看,没有账号?注册
x
|