GRREAD getpoint窗口
这可能不正确。。我正在努力(setq p1 (getpoint))
(setq p2 (getpoint ;;window from p1;)
有道理？
(setq p1 (getpoint "Pick first point: "))
(setq p2 (getcorner p1 "Pick corner: "))
我完全忘记了getcorner
谢谢 只是为了好玩。。。
(defun _grCorner (pt / foo gr)
;; Alan J. Thomspon, 09.20.10
(defun foo (p1 p2)
(redraw)
(if (apply 'and (mapcar 'vl-consp (list p1 p2)))
((lambda (l d)
(mapcar '(lambda (a b) (and a b (grdraw a b 7 d))) l (append (cdr l) (list (last l))))
)
(list p1 (list (car p2) (cadr p1)) p2 (list (car p1) (cadr p2)) p1)
(cond ((> (car p1) (car p2)) 1)
(0)
)
)
)
)
(if (vl-consp pt)
(progn (while (eq 5 (car (setq gr (grread T 15 1)))) (foo pt (cadr gr)))
(redraw)
(cond ((eq 3 (car gr)) (cadr gr)))
)
)
) 一些时髦的角落踢
(defun LM:FunkyGrCorner ( p1 / g )
(while (= 5 (car (setq g (grread 't 13 0)))) (redraw)
(
(lambda ( p1 p2 p3 p4 h xa x )
(mapcar '(lambda ( from to ) (grdraw from to -1 h)) (list p1 p2 p3 p4) (list p2 p3 p4 p1))
(mapcar '(lambda ( from ax ) (LM:grCornerpiece from (+ ax xa (/ (* x 5 pi) 4.)) 8 3))
(list p1 p2 p3 p4)
(list (angle p1 p2) (angle p2 p3) (angle p3 p4) (angle p4 p1))
)
)
p1 (list (caadr g) (cadr p1)) (cadr g) (list (car p1) (cadadr g))
(if (< (car p1) (caadr g)) 0 1)
(angle '(0. 0. 0.) (trans (getvar 'ucsxdir) 0 (trans '(0. 0. 1.) 1 0 t) t))
(if (or (and (< (caadr g) (car p1)) (< (cadr p1) (cadadr g)))
(and (< (car p1) (caadr g)) (< (cadadr g) (cadr p1)))) -1 1)
)
)
(redraw) (if (listp (cadr g)) (cadr g))
)
(defun LM:grCornerpiece ( p a s c / -s lst r )
;; © Lee Mac 2010
(setq -s (- s) lst
(list
(list -s -s) (list0.0.)
(list (1+ -s) -s) (list0. -1.)
(list -s (1+ -s)) (list -1.0.)
(list -s s) (list0.0.)
(list (1+ -s) s)(list0.1.)
(list -s (1- s))(list -1.0.)
(list -s -s) (list -s s )
(list (1+ -s) -s) (list (1+ -s) s)
(list -s (1+ -s)) (list -s (1- s))
)
)
(setq r (/ (getvar 'VIEWSIZE) (cadr (getvar 'SCREENSIZE))) p (trans p 1 3))
(grvecs (cons c (LM:RotatePointsbyMatrix lst '(0. 0. 0.) a))
(list
(list r0. 0. (carp))
(list 0. r0. (cadr p))
(list 0. 0. r0.)
(list 0. 0. 0. 1.)
)
)
)
;;--------------=={ Rotate Points by Matrix }==---------------;;
;; ;;
;;Performs a Rotation transformation on a list of points ;;
;;------------------------------------------------------------;;
;;Author: Lee McDonnell, 2010 ;;
;; ;;
;;Copyright © 2010 by Lee McDonnell, All Rights Reserved. ;;
;;Contact: Lee Mac @ TheSwamp.org, CADTutor.net ;;
;;------------------------------------------------------------;;
;;Arguments: ;;
;;PointList - list of points to be rotated ;;
;;BasePoint - base point for rotation (in CS of PointList);;
;;rAngle - angle of rotation ;;
;;------------------------------------------------------------;;
(defun LM:RotatePointsByMatrix ( PointList BasePoint rAngle )
;; © Lee Mac 2010
(
(lambda ( Matrix / BaseVector )
(setq BaseVector (mapcar '- BasePoint (mxv Matrix BasePoint)))
(mapcar '(lambda ( point ) (mapcar '+ (mxv Matrix point) BaseVector)) PointList)
)
(list
(list (cos rAngle) (sin (- rAngle)) 0.0)
(list (sin rAngle) (cos rAngle) 0.0)
(list 0.0 0.0 1.0)
)
)
)
(defun mxv ( m v )
(mapcar '(lambda ( r ) (apply '+ (mapcar '* r v))) m)
) 尊敬的李：，
你是怎么想的？。。。你的代码让我很兴奋。。。
坚持下去。。
当做
穆图 谢谢Muthu
页:
[1]