[编程交流] GRREAD getpoint窗口

 
(setq p1 (getpoint))
(setq p2 (getpoint ;;window from p1;)

(setq p1 (getpoint "Pick first point: "))
(setq p2 (getcorner p1 "Pick corner: "))

(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)      (list  0.  0.)
     (list (1+ -s) -s) (list  0. -1.)
     (list -s (1+ -s)) (list -1.  0.)
     (list -s s)       (list  0.  0.)
     (list (1+ -s) s)  (list  0.  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 r  0. 0. (car  p))
     (list 0. r  0. (cadr p))
     (list 0. 0. r  0.)
     (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)
)