7月7了，龙龙仔和meflying给大家编个cad万花筒。我先献丑

kaixinmao · 发表于 2005-7-6 22:29:00

(defun round()
(command "erase" "all" "")
(setq i 0 n 255)
(repeat n
(setq i (1+ i))
(repeat 10000
(setq x 0)
(setq y x))
(command "color" (itoa i))
(command "Zoom" "E")
(command "POLYGON" (+ i 3) '(0 0) "I" (+ 1 (* i 5)))
)) (defun c:round()
(round))

紫云飞 · 发表于 2005-7-7 10:54:00

很有创意！！

maomao2004 · 发表于 2005-7-7 11:42:00

是呀，呵呵，很不错的

xyp1964 · 发表于 2005-7-7 13:38:00

;;;改进版： (defun c:round()
;(CMDLA0)
(while t
(setq i 0 n 255)
(command "erase" "all" "")
(repeat n
(setq i (1+ i))
(command "color" (itoa i))
(command "POLYGON" (+ i 3) '(0 0) "I" (+ 1 (* i 5)))
(command "Zoom" "E")
)
)
;(CMDLA0)
)

ljcgq · 发表于 2005-7-7 13:57:00

也转贴一个 (defun c:f ()
(command "zoom" "-1000,-1000" "1000,1000")
(setvar "osmode" 0)
(setq r1 1000 r2 850 start 0.00 end 1.05 incre 0.05)
(if (= (tblsearch "layer" "flower") nil) (command "layer" "n" "flower" ""))
(setvar "clayer" "flower")
(setq dd 10)
(setq d (* dd (/ pi 180)))
(setq a (* (/ (* 1 r2) (gcd r1 r2)) (* pi 2)))
(setq n 1)
(setq i start)
(while (<= i end)
(setq co (fix (* (abs (- i 0)) 200)))
(command "color" (+ co 1))
(setq la (strcat "flower" (itoa n)))
(if (= (tblsearch "layer" la) nil) (command "layer" "n" la ""))
(setvar "clayer" la)
(command "spline")
(setq t 0.0)
(setq r3 (* i r2))
(while (< t a)
(setq tt (/ (* (- r2 r1) t) r2))
(setq x (+ (* (- r1 r2) (cos t)) (* r3 (cos tt))))
(setq y (+ (* (- r1 r2) (sin t)) (* r3 (sin tt))))
(setq z (- (sqrt (abs (- (* 2 r1 r1) (* x x) (* y y))))))
(command (list x y z))
(setq t (+ d t))
)
(command "c" "" )
(setq n (+ 1 n))
(setq i (+ incre i))
) )

meflying · 发表于 2005-7-7 15:02:00

7月7是什么日子呢?

楼上的,不要用 t 做变量

BDYCAD · 发表于 2005-7-7 15:44:00

就是, 把和彎量改成bt 后在我這里運行會卡死, 我還沒有詳細的看

紫云飞 · 发表于 2005-7-8 15:14:00

五楼的程序，把t改成t1后，可以运行的，能绘制出一朵很漂亮的花。 (defun c:f ()
(command "zoom" "-1000,-1000" "1000,1000")
(setvar "osmode" 0)
(setq r1 1000 r2 850 start 0.00 end 1.05 incre 0.05)
(if (= (tblsearch "layer" "flower") nil) (command "layer" "n" "flower" ""))
(setvar "clayer" "flower")
(setq dd 10)
(setq d (* dd (/ pi 180)))
(setq a (* (/ (* 1 r2) (gcd r1 r2)) (* pi 2)))
(setq n 1)
(setq i start)
(while (<= i end)
(setq co (fix (* (abs (- i 0)) 200)))
(command "color" (+ co 1))
(setq la (strcat "flower" (itoa n)))
(if (= (tblsearch "layer" la) nil) (command "layer" "n" la ""))
(setvar "clayer" la)
(command "spline")
(setq t1 0.0)
(setq r3 (* i r2))
(while (< t1 a)
(setq tt (/ (* (- r2 r1) t1) r2))
(setq x (+ (* (- r1 r2) (cos t1)) (* r3 (cos tt))))
(setq y (+ (* (- r1 r2) (sin t1)) (* r3 (sin tt))))
(setq z (- (sqrt (abs (- (* 2 r1 r1) (* x x) (* y y))))))
(command (list x y z))
(setq t1 (+ d t1))
)
(command "c" "" )
(setq n (+ 1 n))
(setq i (+ incre i))
)
)

ljcgq · 发表于 2005-7-8 18:29:00

看来大家还很关心 "t"

xyp1964 · 发表于 2005-7-9 09:32:00

贴个万花筒的图：

账号		自动登录	找回密码
密码			注册

7月7了，龙龙仔和meflying给大家编个cad万花筒。我先献丑

本帖子中包含更多资源

本帖子中包含更多资源