(defun c:drawmark ()
(setq ptx (getpoint "\n指定一个角点")
pty (getcorner ptx "\n指定另一个角点")
)
(setq dist (distance (list (car pty)(cadr ptx))pty))
(setq pta (list (min (car ptx) (car pty))
(min (cadr ptx) (cadr pty))
)
ptd (list (max (car ptx) (car pty))
(min (cadr ptx) (cadr pty))
)
pt1 (polar pta (angle pta ptd) (/ (distance pta ptd) 2))
)
(while (= (car (setq pt (grread T 4 0))) 5)
(setq pt3 (cadr pt))
(redraw)
(cond
((< (cadr pt3) (cadr pt1))
(setq ptb (polar pta (* 0.5 pi) dist)
ptc (polar ptd (* 0.5 pi) dist)
)
(setq pt2 (polar pt1 0 (/ (distance pta ptd) 8.0))
pt4 (polar pt1 pi (/ (distance pta ptd) 8.0))
)
(grdraw pt4 pta 7 0)
(grdraw pta ptb 7 0)
(grdraw ptb ptc 7 0)
(grdraw ptc ptd 7 0)
(grdraw ptd pt2 7 0)
(grdraw pt1 pt3 7 0)
(grdraw pt2 pt3 7 0)
(grdraw pt4 pt3 7 0)
)
((> (cadr pt3) (cadr pt1))
(setq ptb (polar pta (* 1.5 pi) dist)
ptc (polar ptd (* 1.5 pi) dist)
)
(setq pt1 (polar pta (angle pta ptd) (/ (distance pta ptd) 2)))
(setq pt2 (polar pt1 0 (/ (distance pta ptd) 5.0))
pt4 (polar pt1 pi (/ (distance pta ptd) 5.0))
)
(grdraw pt4 pta 7 0)
(grdraw pta ptb 7 0)
(grdraw ptb ptc 7 0)
(grdraw ptc ptd 7 0)
(grdraw ptd pt2 7 0)
(grdraw pt1 pt3 7 0)
(grdraw pt2 pt3 7 0)
(grdraw pt4 pt3 7 0)
)
)
)
(redraw)
(command "pline" pt3 pt4 pta ptb ptc ptd pt2 "C")
)
zhynt 太好了..
这种都帮忙做,虽然我都不知道这个东西有什么用..但只要有人需要就看到你的出手!
应该给你颁发一个热心奖啊 就当是个练习。 回复 zhynt 的帖子
Dear Sir,
Nice Lisp 本帖最后由 xyp1964 于 2011-8-4 00:21 编辑
这样可能更好
感谢zhynt分享程序 <谢谢!> zhynt真是活雷锋 哈哈哈，应该给zhynt也授予版主一职 zhynt热心、技术高、编程速度快
页:
[1]
2