趣味LISP

yxp

;这是一个趣味LISP,希望能给大家一些灵感.
(defun drawbox()
(grdraw ll ul -1 ) (grdraw ul ur -1 1)
(grdraw ur lr -1 1) (grdraw lr ll -1 1)
(if (= mode 0) (cenx) (arrow))
)
(defun cenx()
(grdraw x1 x2 -1) (grdraw x3 x4 -1)
)
(defun arrow()
(grdraw a1 a4 -1) (grdraw a2 a4 -1) (grdraw a3 a4 -1)
)
(defun newbox() ;求各线段的端点，包括矩形、箭头和交叉X线
(setq deltay (* deltax aspect))
(setq xcen (car center) ycen (cadr center))
(setq lx (- xcen deltax) ux (+ xcen deltax))
(setq ly (- ycen deltay) uy (+ ycen deltay))
(setq ll (list lx ly) ul (list lx uy))
(setq ur (list ux uy) lr (list ux ly))
(setq yp (+ ycen arm) ym (- ycen arm))
(setq a1 (list (- ux arm) yp) a2 (list (- ux arm) ym))
(setq a3 (list (- ux arm arm) ycen))
(setq a4 (list ux ycen))
(setq x1 (list (- xcen arm) ym) x2 (list (+ xcen arm) yp))
(setq x3 (list (- xcen arm) yp) x4 (list (+ xcen arm) ym))
(drawbox)
)
(defun C:ZW(/ arm aspect deltax inp loop mode prev pt source)
(setq center (getvar "viewctr")) ;屏幕中心
(setvar "lastpoint" (setq prev center))
(setq aspect (/ (cadr (setq aspect (getvar "screensize"))) (car aspect)))
(setq deltax (* 0.25 (getvar "viewsize"))) ;当前窗口大小(绘图单位)
(setq arm (* 0.1 deltax) mode 0 loop t)
(newbox)
(while loop
(setq inp (grread t)) ;返回当前光标坐标
(setq source (car inp) pt (cadr inp))
(cond ((= source 3) ;source=3表示单击左键
(cenx) (arrow)
(setq mode (- 1 mode))
(setvar "lastpoint" center))
((= source 5)
(if (or (/= (car prev) (car pt))
(/= (cadr prev) (cadr pt)))
(progn
(if (= mode 0)
(setq center pt)
(setq deltax (+ deltax (- (car pt) (car prev)))))
(setq prev pt)
(drawbox)
(newbox)
)))
((or (and (= source 6) (= pt 0))
(and (= source 2)
(or (= pt 13) (= pt 32))))
(drawbox)
(command "zoom" "w" ll ur)
(setq loop nil))
(t
(drawbox)
(setq loop nil a "^cancel"))
)
)
)

wdb

说说干啥用的？

xufen

请问有何作用？

xazhji

应该是像 鹰眼 里的缩放图工具，不过，好像程序有点儿问题，未能达到预期效果。

yxp

程序没有问题,只是一段趣味代码.你可以自己完善,作为它用.

twinpen

有特色!

无痕

和 zoom －d 效果差不多阿

xazhji

但是，zoom好像没有发挥作用？

无痕

我试也不行，只显示虚框，没有缩放视图。cad2004

jxlcrystal

有没有办法实现亮显的曲线呢？