(tt)动态宽高比=2矩形

(defun c:tt(/ cd code dx dy mode p0 p1 p2 p3 pt) ;tt(动态宽高比=2矩形)
  (while (setq p0 (getpoint "\n基点<退出>: "))
    (setq mode t)
    (while mode
      (setq code (grread nil 15 0) cd (car code))
      (cond ((member cd '(2 3 25)) (setq mode nil))
                ((= cd 5)
                    (redraw)
                    (setq pt (cadr code)
                        dx (- (car pt) (car p0))
                        dy (* dx 0.5)
                        p2 (list (car pt) (+ (cadr p0) dy))
                        p1 (list (car p2) (cadr p0))
                        p3 (list (car p0) (cadr p2))
                    )
                    (grvecs (list 1 p0 p1 1 p1 p2 1 p2 p3 1 p3 p0))
                )
      )
    )
    (redraw)
    (command "Rectang" "non" p0 "non" p2)
  )
  (princ)
)