Reltro,
I've implemented Lee's SNAPS to your function... Hope you don't mind...
(defun C:Rect,Ratio ( / _acapp _getosmode _grX _OLE->ACI _OLE->RGB _RGB->ACI _snap _polarangs _polar _ortho P1 P PS oo pp ss vector,Len vector,Len,get vector,Len,set vector,cross opt arsin arcos opt2 Rect0 Rect1 Rect2 Rect3 tmpRatio typed UserPrompt )
(vl-load-com)
(defun _acapp nil
(eval (list 'defun '_acapp 'nil (vlax-get-acad-object)))
(_acapp)
)
(defun _getosmode ( os / lst )
(foreach mode
'(
(0001 . "_end")
(0002 . "_mid")
(0004 . "_cen")
(0008 . "_nod")
(0016 . "_qua")
(0032 . "_int")
(0064 . "_ins")
(0128 . "_per")
(0256 . "_tan")
(0512 . "_nea")
(1024 . "_qui")
(2048 . "_app")
(4096 . "_ext")
(8192 . "_par")
)
(if (not (zerop (logand (car mode) os)))
(setq lst (cons "," (cons (cdr mode) lst)))
)
)
(apply 'strcat (cdr lst))
)
(defun _grX ( p s c / -s r j )
(setq -s (- s)
r (/ (getvar 'viewsize) (cadr (getvar 'screensize)))
j p
)
(grdraw (mapcar '+ j (list (* r -s) (* r -s))) (mapcar '+ j (list (* r s) (* r s))) c)
(grdraw (mapcar '+ j (list (* r -s) (* r (1+ -s)))) (mapcar '+ j (list (* r (1- s)) (* r s))) c)
(grdraw (mapcar '+ j (list (* r (1+ -s)) (* r -s))) (mapcar '+ j (list (* r s) (* r (1- s)))) c)
(grdraw (mapcar '+ j (list (* r -s) (* r s))) (mapcar '+ j (list (* r s) (* r -s))) c)
(grdraw (mapcar '+ j (list (* r -s) (* r (1- s)))) (mapcar '+ j (list (* r (1- s)) (* r -s))) c)
(grdraw (mapcar '+ j (list (* r (1+ -s)) (* r s))) (mapcar '+ j (list (* r s) (* r (1+ -s)))) c)
p
)
(defun _OLE->ACI ( c )
(apply '_RGB->ACI (_OLE->RGB c))
)
(defun _OLE->RGB ( c )
(mapcar '(lambda ( x ) (lsh (lsh (fix c) x) -24)) '(24 16 8))
)
(defun _RGB->ACI ( r g b / c o )
(if (setq o (vla-getinterfaceobject (_acapp) (strcat "autocad.accmcolor." (substr (getvar 'acadver) 1 2))))
(progn
(setq c (vl-catch-all-apply '(lambda ( ) (vla-setrgb o r g b) (vla-get-colorindex o))))
(vlax-release-object o)
(if (vl-catch-all-error-p c)
(prompt (strcat "\nError: " (vl-catch-all-error-message c)))
c
)
)
)
)
(defun _snap ( p osm )
(if (osnap p (_getosmode osm))
(osnap p (_getosmode osm))
p
)
)
(defun _polarangs ( ang / n k a l )
(if (/= ang 0.0)
(progn
(setq n (/ 360.1 (cvunit ang "radians" "degrees")))
(setq k -1.0)
(repeat (1+ (fix n))
(setq a (* (setq k (1+ k)) ang))
(setq l (cons a l))
)
l
)
(list 0.0)
)
)
(defun _polar ( p0 p flag ang / a b an )
(if flag
(progn
(setq a (car (vl-sort (_polarangs ang) '(lambda ( a b ) (< a (angle p0 p) b)))))
(setq b (last (vl-sort (_polarangs ang) '(lambda ( a b ) (< a (angle p0 p) b)))))
(if (< (abs (- (angle p0 p) a)) (abs (- (angle p0 p) b))) (setq an a) (setq an b))
(inters p0 (polar p0 an 1.0) p (polar p (+ an (* 0.5 pi)) 1.0) nil)
)
p
)
)
(defun _ortho ( p0 p flag )
(if flag
(_polar p0 p t (* 0.5 pi))
p
)
)
(setq P1 (getpoint "\nPick StartPoint : ")
vector,Len,get (lambda (v / ) (sqrt (apply '+ (mapcar '(lambda (a / ) (expt a 2)) v))))
vector,Len,set (lambda (v l / f) (setq f (/ (float l) (vector,Len,get v))) (mapcar '(lambda (a /) (* a f)) v))
vector,cross (lambda (a b)
(mapcar
'(lambda (n / )
(-
(* (nth (car n) a)(nth (cadr n) b))
(* (nth (cadr n) a) (nth (car n) b))
)
)
'((1 2) (2 0) (0 1))
)
)
arsin (lambda (x)
(cond
((= x 1.0) (/ pi 2.0))
((= x -1.0) (/ pi -2.0))
((< (abs x) 1.0) (atan (/ x (sqrt (- 1.0 (* x x))))))
('default (*error* (strcat "\n error: bad argument: " (rtos (abs x) 2) ">1.0\n ")))
)
)
opt 0
opt2 0
ratio 2
)
(setq UserPrompt (lambda (/) (princ "\nPick Second Point or toogle between modes with RIGHTMOUSE and TAB or enter a new ratio (1:x) = 1:")))
(setvar 'orthomode 1)
(setq ape (getvar 'aperture))
(setvar 'aperture 40)
(setq as (getvar 'autosnap))
(setvar 'autosnap 31)
(setq osm (getvar 'osmode))
(setvar 'osmode 15359)
(if (eq (getvar 'orthomode) 1) (setq oo t) (setq oo nil))
(if (eq (logand (getvar 'autosnap) 8) 8) (setq pp t) (setq pp nil))
(if (eq (logand (getvar 'autosnap) 16) 16) (setq ss t) (setq ss nil))
(eval
(list 'defun '*error* '(msg / )
(list
(lambda (err / )
(setq *error* err)
(if ape (setvar 'aperture ape))
(if as (setvar 'autosnap as))
(if osm (setvar 'osmode osm))
(redraw)
(if msg
(progn
(if (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*EXIT*"))
(princ msg)
)
(*error* msg)
)
)
(princ)
)
*error*
)
)
)
(UserPrompt)
(while (not (= (car (setq P (grread 'T))) 3))
(cond
((= (car P) 5)
( (lambda (P / v l v,perp H ang)
(cond
( (and oo pp ss)
(setq PS (_snap (_ortho P1 P t) (getvar 'osmode)))
)
( (and oo (not pp) ss)
(setq PS (_snap (_ortho P1 P t) (getvar 'osmode)))
)
( (and (not oo) pp ss)
(setq PS (_snap (_polar P1 P t (getvar 'polarang)) (getvar 'osmode)))
)
( (and (not oo) (not pp) ss)
(setq PS (_snap P (getvar 'osmode)))
)
( (and oo pp (not ss))
(setq PS (_ortho P1 P t))
)
( (and oo (not pp) (not ss))
(setq PS (_ortho P1 P t))
)
( (and (not oo) pp (not ss))
(setq PS (_polar P1 P t (getvar 'polarang)))
)
( (and (not oo) (not pp) (not ss))
(setq PS P)
)
)
(setq v (mapcar '- PS P1)
l (vector,Len,get v)
)
(if (> l 0)
(cond
((= opt 0)
(setq v,perp
(vector,Len,set
(vector,cross v '(0 0 1))
(if (= opt2 0)
(/ l (float ratio))
(* l ratio)
)
)
)
(setq Rect0 P1
Rect1 (mapcar '+ P1 v,perp)
Rect2 (mapcar '+ Rect1 v)
Rect3 PS
)
(redraw)
(grvecs (list -7 Rect0 Rect1 Rect1 Rect2 Rect2 Rect3 Rect3 Rect0))
)
((= opt 1)
(setq v,perp
(vector,Len,set
(vector,cross v '(0 0 -1))
(if (= opt2 0)
(/ l (float ratio))
(* l ratio)
)
)
)
(setq Rect0 P1
Rect1 (mapcar '+ P1 v,perp)
Rect2 (mapcar '+ Rect1 v)
Rect3 PS
)
(redraw)
(grvecs (list -7 Rect0 Rect1 Rect1 Rect2 Rect2 Rect3 Rect3 Rect0))
)
((= opt 2)
(setq H (sqrt (+ 1 (expt ratio 2))))
(setq ang (arsin (/ ratio H)))
(setq l (* (cos ang) l))
(setq ang
(if (= opt2 0)
(- (angle P1 PS) ang)
(+ (angle P1 PS) ang)
)
)
(setq Rect0 P1
Rect1 (polar P1 ang l)
Rect2 PS
Rect3 (polar Rect2 ang (* -1 l))
)
(redraw)
(grvecs (list -7 Rect0 Rect1 Rect1 Rect2 Rect2 Rect3 Rect3 Rect0))
)
)
)
)
(cadr P)
)
)
((= (car P) 25)
(if (= opt 2)
(setq opt 0)
(setq opt (1+ opt))
)
)
((and (= (car P) 2) (or (and (> (cadr P) 47) (< (cadr P) 58)) (= (cadr P) 46)))
(setq typed (chr (cadr P)))
(princ typed)
(setq tmpRatio (cons typed tmpRatio))
)
((and (= (car P) 2) (= (cadr P) 8))
(princ (chr (cadr P)))
(setq tmpRatio (cdr tmpRatio))
)
((and (= (car P) 2) (or (= (cadr P) 13) (= (cadr P) 32)))
(if tmpRatio
(setq ratio (read (apply 'strcat (reverse tmpRatio)))
tmpRatio nil
)
)
(UserPrompt)
)
((and (= (car P) 2) (= (cadr P) 9))
(if (= opt2 1)
(setq opt2 0)
(setq opt2 1)
)
)
((and (= (car P) 2) (= (cadr P) 15))
(if (eq oo t) (setq oo nil) (setq oo t))
)
((and (= (car P) 2) (= (cadr P) 21))
(if (eq pp t) (setq pp nil) (setq pp t))
)
((and (= (car P) 2) (= (cadr P) 6))
(if (eq ss t) (setq ss nil) (setq ss t))
)
)
(if (not (equal PS (cadr P) 1e-6))
(_grX PS (atoi (getenv "AutoSnapSize")) (_OLE->ACI (if (= 1 (getvar 'cvport)) (atoi (getenv "Layout AutoSnap Color")) (atoi (getenv "Model AutoSnap Color")))))
)
)
(if (apply 'and '(Rect0 Rect1 Rect2 Rect3))
(command "_pline" "_non" Rect0 "_non" Rect1 "_non" Rect2 "_non" Rect3 "_close")
)
(*error* nil)
)
EDIT : Forgot to add (vl-load-com)