- 积分
- 4690
- 明经币
- 个
- 注册时间
- 2007-7-15
- 在线时间
- 小时
- 威望
-
- 金钱
- 个
- 贡献
-
- 激情
-
|
发表于 2011-2-20 17:24:07
|
显示全部楼层
不错不错,,我把你接受捕捉部分改进了一下,,这样好多了,,
还有一些没有加上,,要的就自己加上了,,\
就是不能捕捉到垂直,,谁能再改一下啊..
(defun c:tt ()
(setq z T)
(while z
(initget 128)
(setq grr (grread t)) ;请求输入
(setq gr (car grr)
po (cadr grr)
)
(cond ((equal grr '(2 15)) ;F8切换正交开关
(if (= f8 0)
(progn (setq f8 1) (prompt "\n<正交 开>"))
(progn (setq f8 0) (prompt "\n<正交 关>"))
)
(setvar 'orthomode f8)
)
((= gr 5) ;移动时
(setq po (grreadosnap po)) ;更新
)
((= gr 3) ;左击
(setq z nil)
)
((or (equal grr '(2 32)) ;空格
(equal grr '(2 13)) ;回车
(equal grr '(11 0)) ;右击
)
(setq z nil)
)
)
)
)
(defun grbox (pt str1 / h p1 p2 p3 p4)
(setq h (* (/ (getvar "viewsize") (cadr (getvar "screensize"))) (getvar "pickbox"))
p1 (mapcar '- pt (list h h 0.))
p2 (mapcar '+ pt (list h (- h) 0.))
p3 (mapcar '+ pt (list h h 0.))
p4 (mapcar '+ pt (list (- h) h 0.))
p5 (mapcar '- pt (list h 0 0.))
p6 (mapcar '- pt (list 0 h 0.))
p7 (mapcar '+ pt (list 0 h 0.))
p8 (mapcar '+ pt (list h 0. 0.))
p8a (mapcar '+ pt (list (1- h) 0. 0.))
$angis 0.20944
i 0
)
(cond ((= str1 1) (grvecs (list 1 p1 p2 1 p2 p3 1 p3 p4 1 p4 p1)))
((= str1 2) (grvecs (list 1 p7 p1 1 p7 p2 1 p1 p2)))
((= str1 4)
(repeat 30
(setq p9 (polar pt $angis h))
(grvecs (list 1 p8 p9))
(setq p8 p9
$angis (+ $angis 0.20944)
)
)
)
((= str1 8) (grvecs (list 1 p1 p2 1 p2 p3 1 p3 p4 1 p4 p1)))
((= str1 16) (grvecs (list 1 p5 p6 1 p6 p8 1 p8 p7 1 p7 p5)))
((= str1 32) (grvecs (list 1 p1 p3 1 p2 p4)))
((= str1 64) (grvecs (list 1 p1 p2 1 p2 p3 1 p3 p4 1 p4 p1)))
((= str1 128) (grvecs (list 1 p1 p2 1 p1 p4 1 pt p5 1 pt p6)))
((= str1 256)
(repeat 30
(setq p9 (polar pt $angis (1- h)))
(grdraw p8a p9 1)
(setq p8a p9
$angis (+ $angis 0.20944)
)
)
(grdraw p3 p4 1)
)
((= str1 512) (grvecs (list 1 p1 p2 1 p2 p4 1 p3 p4 1 p3 p1)))
((= str1 2048) (grvecs (list 1 p1 p2 1 p2 p3 1 p3 p4 1 p4 p1)))
((= str1 4096) (grvecs (list 1 p1 p2 1 p2 p3 1 p3 p4 1 p4 p1)))
((= str1 8192) (grvecs (list 1 p1 p2 1 p2 p3 1 p3 p4 1 p4 p1)))
)
)
(defun grreadosnap (p / osp osmode str)
;;grreadosnap ---fsxm 2006.10.06
(setq osmode (getvar "osmode"))
(cond ((= osmode 0))
((< osmode 16384)
(setq str "")
(foreach x '((1 "_end,")
(2 "_mid,")
(4 "_cen,")
(8 "_nod,")
(16 "_qua,")
(32 "_int,")
(64 "_ins,")
(128 "_per,")
(256 "_tan,")
(512 "_nea,")
(2048 "_app,")
(4096 "_ext,")
(8192 "_par,")
)
(if (/= 0 (logand osmode (car x)))
(setq str (strcat str (cadr x)))
)
)
(setq osp (osnap p str))
(setq str1 nil)
(cond ((and (/= 0 (logand osmode 1)) (equal osp (osnap p "_end,"))) (setq str1 1))
((and (/= 0 (logand osmode 2)) (equal osp (osnap p "_mid,"))) (setq str1 2))
((and (/= 0 (logand osmode 4)) (equal osp (osnap p "_cen,"))) (setq str1 4))
((and (/= 0 (logand osmode 8)) (equal osp (osnap p "_nod,"))) (setq str1 8))
((and (/= 0 (logand osmode 16)) (equal osp (osnap p "_qua,"))) (setq str1 16))
((and (/= 0 (logand osmode 32)) (equal osp (osnap p "_int,"))) (setq str1 32))
((and (/= 0 (logand osmode 64)) (equal osp (osnap p "_ins,"))) (setq str1 64))
((and (/= 0 (logand osmode 128)) (equal osp (osnap p "_per,"))) (setq str1 128))
((and (/= 0 (logand osmode 256)) (equal osp (osnap p "_tan,"))) (setq str1 256))
((and (/= 0 (logand osmode 512)) (equal osp (osnap p "_nea,"))) (setq str1 512))
((and (/= 0 (logand osmode 2048)) (equal osp (osnap p "_app,"))) (setq str1 2048))
((and (/= 0 (logand osmode 4096)) (equal osp (osnap p "_app,"))) (setq str1 4096))
((and (/= 0 (logand osmode 8192)) (equal osp (osnap p "_par,"))) (setq str1 8192))
)
(redraw)
(cond (osp str1(setq p osp) (grbox osp str1)))
)
)
p
) |
|
[复制链接]
显身卡