A long time ago, AutoCAD used to make Rectangles and polygons as their own entities. When you made a rectangle and then did a LIST <enter> on it, it would show as a rectangle. Nowadays, these objects are those objects in their geometry but are made of polyline entities. So modifying these objects is sometimes hard. that’s where this routine steps in to help.

This routine lets you create a rectangle and even after you continue working elsewhere in your drawing, you can come back to that rectangle and modify that object and it acts like how rectangles used to act in AutoCAD.

Here’s how:

• TREC <enter> to start “True RECtangle”
• Create a rectangle how you normally create one
• When needed, this routine will let you drag a single corner and the rest of the rectangle’s geometry will adjust accordingly to keep its geometry as a rectangle.

~enjoy

(vl-load-com)
;; Version 1.08
(setq *gc:rectangleCommandReactor*
nil
*gc:rectangleLispReactor*
nil
*gc:rectangleCopied*
nil
*gc:rectangleModified*
nil
)
;;===================== COMMANDS =====================;;
;; TREC (c) Gilles Chanteau
;; Creates a 'true rectangle' polyline
(defun c:TREC (/ pt rec)
(and
(setvar 'cmdecho 0)
(vl-cmdf "_.rectangle" "_fillet" 0.0)
(vl-cmdf)
(setvar 'cmdecho 1)
(setq pt (getpoint "\nSpecify the first corner: "))
(vl-cmdf "_.rectangle" pt)
(while (/= 0 (getvar 'cmdactive))
(vl-cmdf pause)
)
(gc:IsRectangle (setq rec (vlax-ename->vla-object (entlast))))
(gc:addRectangleReactor rec)
)
(princ)
)
;; PL2REC (c) Gilles Chanteau
;; Converts a rectangular polyline into a 'true rectangle'
(defun c:PL2REC (/ rec)
(if (and
(setq rec (car (entsel "\nSelect a rectangle: ")))
(gc:IsRectangle (setq rec (vlax-ename->vla-object rec)))
(null
(vl-member-if
(function
(lambda (rea)
(and (equal rec (car (vlr-owners rea)))
(member '(:VLR-modified . GC:RECTANGLEMODIFIED)
(vlr-reactions rea)
)
)
)
)
(cdr (assoc :VLR-Object-Reactor (vlr-reactors)))
)
)
)
(gc:addRectangleReactor rec)
(princ "\nInvalid entity.")
)
(princ)
)
;; REC2PL (c) Gilles Chanteau
;; Converts back a 'true rectangle' into a polyline
(defun c:REC2PL (/ rec)
(sssetfirst)
(if (and
(setq rec (car (entsel "\nSelect a rectangle: ")))
(setq rec (vlax-ename->vla-object rec))
)
(foreach rea (cdr (assoc :VLR-Object-Reactor (vlr-reactors)))
(if (and (equal rec (car (vlr-owners rea)))
(member '(:VLR-modified . GC:RECTANGLEMODIFIED)
(vlr-reactions rea)
)
)
(vlr-remove rea)
)
)
)
(princ)
)
;;===================== SUB ROUTINES =====================;;
;; gc:2dVariantToPointsList (gile)
;; Returns a 2d points list
;;
;; Argument : a variant as returned by vla-get-Coordinates
(defun gc:2dVariantToPointsList (var / foo)
(defun foo (lst)
(if lst
(cons (list (car lst) (cadr lst)) (foo (cddr lst)))
)
)
(foo (vlax-safearray->list (vlax-variant-value var)))
)
;; gc:2dPointsListToVariant (gile)
;; Returns a 2d coordinates variant
;;
;; Argument : a 2d points list
(defun gc:2dPointsListToVariant (lst)
(vlax-make-variant
(vlax-safearray-fill
(vlax-make-safearray
vlax-VbDouble
(cons 0 (1- (* 2 (length lst))))
)
(apply 'append lst)
)
)
)
;;; gc:GetItem (gile)
;;; Returns a vla-object if item exists in the collection
;;;
;;; Arguments
;;; col : the collection (vla-object)
;;; name : the item name (string) or its index (integer)
;;;
;;; Return : the vla-object or nil
(defun gc:GetItem (col name / obj)
(vl-catch-all-apply
(function (lambda () (setq obj (vla-item col name))))
)
obj
)
;;; gc:HandleToObject (gile)
;;; Returns the VLA-OBJECT corresponding to the handle if not erased
;;; Argument
;;; handle : the object handle
;;;
;;; Return : the vla-object or nil
(defun gc:HandleToObject (handle / obj)
(vl-catch-all-apply
(function
(lambda ()
(setq obj (vla-HandleToObject
(vla-get-ActiveDocument (vlax-get-acad-object))
handle
)
)
)
)
)
obj
)
;; gc:IsRectangle (gile)
;; Evaluates if a polyline is rectangular
;;
;; Argument : an entity (ename ou vla-object)
(defun gc:IsRectangle (ent / elst pts p1 p2 p3 p4)
(or (= (type ent) 'VLA-OBJECT)
(setq ent (vlax-ename->vla-object ent))
)
(and
(= (vla-get-ObjectName ent) "AcDbPolyline")
(setq pts (gc:2dVariantToPointsList (vla-get-Coordinates ent)))
(= 4 (length pts))
(= (vla-get-Closed ent) :vlax-true)
(vl-every '(lambda (x) (zerop x))
(mapcar '(lambda (p) (vla-GetBulge ent p)) '(0 1 2 3))
)
(mapcar '(lambda (v p) (set v p)) '(p1 p2 p3 p4) pts)
(equal 1 (/ (distance p1 p2) (distance p3 p4)) 1e-9)
(equal 1 (/ (distance p1 p4) (distance p2 p3)) 1e-9)
(equal 1 (/ (distance p1 p3) (distance p2 p4)) 1e-9)
)
)
;; gc:rectangleUpdate (gile)
;; Returns the vertices list of a re-built rectangle after stretching
;;
;; Arguments
;; rec : the rectangle (VLA-OBJECT)
;; old : the vertices list before stretching
(defun gc:rectangleUpdate (rec old / new stat ndep pos p1 p2 p3 p4 disp)
(setq new (gc:2dVariantToPointsList (vla-get-Coordinates rec))
stat (mapcar '(lambda (x1 x2) (equal x1 x2)) old new)
ndep (length (vl-remove T stat))
)
(cond
((= 1 ndep)
(setq pos (vl-position nil stat)
p1 (nth pos new)
p2 (nth (rem (+ 1 pos) 4) old)
p3 (nth (rem (+ 2 pos) 4) old)
p4 (nth (rem (+ 3 pos) 4) old)
new (subst
(inters p2 p3 p1 (polar p1 (angle p3 p4) 1.0) nil)
p2
(subst
(inters p3 p4 p1 (polar p1 (angle p2 p3) 1.0) nil)
p4
new
)
)
)
)
((and (= 2 ndep)
(or (and
(setq pos (vl-position nil stat))
(not (nth (1+ pos) stat))
(setq p1 (nth pos new))
)
(and (not (last stat))
(not (car stat))
(setq pos 3
p1 (last new)
)
)
)
)
(setq p2 (nth (rem (+ 1 pos) 4) new)
p3 (nth (rem (+ 2 pos) 4) old)
p4 (nth (rem (+ 3 pos) 4) old)
ang (+ (/ pi 2) (angle p1 p2))
new (subst
(inters p3 p4 p2 (polar p2 ang 1.0) nil)
p3
(subst
(inters p3 p4 p1 (polar p1 ang 1.0) nil)
p4
new
)
)
)
)
(T
(if (setq pos (vl-position nil stat))
(setq disp (mapcar '- (nth pos new) (nth pos old))
new (mapcar '(lambda (p)
(mapcar '+ p disp)
)
old
)
)
)
)
)
(vla-put-Coordinates rec (gc:2dPointsListToVariant new))
new
)
;; gc:addRectangleReactor
;; Adds an object reactor to a polyline
(defun gc:addRectangleReactor (rec)
(vlr-object-reactor
(list rec)
(gc:2dVariantToPointsList (vla-get-Coordinates rec))
'((:VLR-modified . GC:RECTANGLEMODIFIED)
(:VLR-copied . GC:RECTANGLECOPIED)
(:VLR-erased . GC:RECTANGLEERASED)
(:VLR-unerased . GC:RECTANGLEUNERASED)
)
)
)
;;===================== CALLBACKS =====================;;
;; Erased rectangle
(defun GC:RECTANGLEERASED (own rea lst)
(vlr-remove rea)
)
;; Unerased rectangle
(defun GC:RECTANGLEUNERASED (own rea lst)
(vlr-add rea)
)
;; Modified rectangle
(defun GC:RECTANGLEMODIFIED (own rea lst)
(setq *gc:rectangleModified* (cons rea *gc:rectangleModified*))
(if (zerop (getvar 'cmdactive))
(or *gc:rectangleLispReactor*
(setq *gc:rectangleLispReactor*
(vlr-lisp-reactor
nil
'((:VLR-lispEnded . GC:RECTANGLELISPENDED))
)
)
)
(or *gc:rectangleCommandReactor*
(setq *gc:rectangleCommandReactor*
(vlr-command-reactor
nil
'((:VLR-commandEnded . GC:RECTANGLECOMMANDENDED))
)
)
)
)
)
;; Copied rectangle
(defun GC:RECTANGLECOPIED (own rea lst / ent)
(if (and (= (type (setq ent (car lst))) 'ENAME)
(null (member ent *gc:rectangleCopied*))
)
(progn
(setq *gc:rectangleCopied* (cons ent *gc:rectangleCopied*))
(if (zerop (getvar 'cmdactive))
(or *gc:rectangleLispReactor*
(setq *gc:rectangleLispReactor*
(vlr-lisp-reactor
nil
'((:VLR-lispEnded . GC:RECTANGLELISPENDED))
)
)
)
(or *gc:rectangleCommandReactor*
(setq *gc:rectangleCommandReactor*
(vlr-command-reactor
nil
'((:VLR-commandEnded . GC:RECTANGLECOMMANDENDED))
)
)
)
)
)
)
)
;; Command ended
(defun GC:RECTANGLECOMMANDENDED (rea cmd)
(cond
((member (car cmd) '("STRETCH" "GRIP_STRETCH"))
(foreach r *gc:rectangleModified*
(vlr-remove r)
(vlr-data-set
r
(gc:rectangleUpdate (car (vlr-owners r)) (vlr-data r))
)
(vlr-add r)
)
)
((member (car cmd)
'("MOVE" "GRIP_MOVE" "ROTATE"
"GRIP_ROTATE" "SCALE" "GRIP_SCALE"
"MIRROR" "GRIP_MIRROR" "DROPGEOM"
)
)
(foreach r *gc:rectangleModified*
(vlr-data-set
r
(gc:2dVariantToPointsList
(vla-get-Coordinates (car (vlr-owners r)))
)
)
)
)
((member (car cmd) '("U" "UNDO"))
(foreach r *gc:rectangleModified*
(or (vlax-erased-p (car (vlr-owners r)))
(vlr-data-set
r
(gc:2dVariantToPointsList
(vla-get-Coordinates (car (vlr-owners r)))
)
)
)
)
)
((= (car cmd) "PEDIT")
(foreach r *gc:rectangleModified*
(if (gc:IsRectangle (car (vlr-owners r)))
(vlr-data-set
r
(gc:2dVariantToPointsList
(vla-get-Coordinates (car (vlr-owners r)))
)
)
(vlr-remove r)
)
)
)
)
(foreach rec *gc:rectangleCopied*
(and
(entget rec)
(setq rec (vlax-ename->vla-object rec))
(gc:IsRectangle rec)
(gc:addRectangleReactor rec)
)
)
(vlr-remove rea)
(setq *gc:rectangleModified*
nil
*gc:rectangleCopied*
nil
*gc:rectangleCommandReactor*
nil
)
)
;; LISP ended
(defun GC:RECTANGLELISPENDED (rea lst)
(foreach r *gc:rectangleModified*
(if (gc:IsRectangle (car (vlr-owners r)))
(vlr-data-set
r
(gc:2dVariantToPointsList
(vla-get-Coordinates (car (vlr-owners r)))
)
)
(vlr-remove r)
)
)
(foreach rec *gc:rectangleCopied*
(setq rec (vlax-ename->vla-object rec))
(if (gc:IsRectangle rec)
(gc:addRectangleReactor rec)
)
)
(vlr-remove rea)
(setq *gc:rectangleLispReactor*
nil
*gc:rectangleCopied*
nil
*gc:rectangleModified*
nil
)
)
;;===================== SAVING =====================;;
;; Saves all 'rectangle' handles in a dictionary
(or (vl-some
'(lambda (x)
(equal (car (vlr-reactions x))
'(:VLR-beginSave . GC:RECTANGLESAVE)
)
)
(cdr (assoc :VLR-DWG-Reactor (vlr-reactors)))
)
(vlr-dwg-reactor
nil
'((:VLR-beginSave . GC:RECTANGLESAVE))
)
)
(defun GC:RECTANGLESAVE (rea datas / lst NOB dict xrec)
(foreach r (cdr (assoc :VLR-Object-Reactor (vlr-reactors)))
(if (member '(:VLR-modified . GC:RECTANGLEMODIFIED)
(vlr-reactions r)
)
(setq
lst (cons (cons 1 (vla-get-Handle (car (vlr-owners r)))) lst)
)
)
)
(if lst
(progn
(setq NOB (vla-get-Dictionaries
(vla-get-ActiveDocument (vlax-get-acad-object))
)
)
(or (setq dict (gc:GetItem NOB "GILE_RECTANGLE"))
(setq dict (vla-add NOB "GILE_RECTANGLE"))
)
(or (setq xrec (gc:GetItem dict "handles"))
(setq xrec (vla-addXrecord dict "handles"))
)
(vla-SetXrecordData
xrec
(vlax-safearray-fill
(vlax-make-safearray
vlax-vbInteger
(cons 0 (1- (length lst)))
)
(mapcar 'car lst)
)
(vlax-safearray-fill
(vlax-make-safearray
vlax-vbVariant
(cons 0 (1- (length lst)))
)
(mapcar
(function (lambda (x)
(vlax-make-variant (cdr x) vlax-vbString)
)
)
lst
)
)
)
)
)
)
;;===================== LOADING =====================;;
;; Re-builds the saved 'rectangles' reactors
((lambda (/ lst rec dict xrec xtyp xval)
(foreach r (cdr (assoc :VLR-Object-Reactor (vlr-reactors)))
(if (member '(:VLR-modified . GC:RECTANGLEMODIFIED)
(vlr-reactions r)
)
(vlr-remove r)
)
)
(if (and
(setq
dict (gc:GetItem
(vla-get-Dictionaries
(vla-get-ActiveDocument (vlax-get-acad-object))
)
"GILE_RECTANGLE"
)
)
(setq xrec (gc:GetItem dict "handles"))
(not (vla-GetXrecordData xrec 'xtyp 'xval))
xval
)
(foreach h (mapcar
(function (lambda (x) (vlax-variant-value x)))
(vlax-safearray->list xval)
)
(if (and
(null (member h lst))
(setq rec (gc:HandleToObject h))
(gc:IsRectangle rec)
)
(gc:addRectangleReactor rec)
)
)
)
)
)
(princ)