Rectangles to snaps & resizing

[Steven P]

Good morning,

 

Just wondering, does anyone have a LISP (or similar if there is a handy command) to resize a rectangle to the nearest integer dimension?

 

Converting a PDF of a scanned and marked up drawing - just drawing over the lines that I need today, doing that it never quite scales properly and for example rectangles might be 401.257 x 599.99. the engineers would never notice, I will know though. Would like a handy way to make them all the nearest integer, to the nearest 25, 50, 100 or whatever (I can adjust this later to suit my way of working). Rectangles might be any angle to make it more complicated.

 

So was wondering if anyone has anything handy they can share? If not I will add it to my list of things to look at another day.

 

 

Second thing I might do later is move to snaps, select rectangle corner and move it to a snap (I have this with most other objects apart from polylines, but again, this is something to do for later)

 

Thanks

 

[exceed]

In the past, I've seen how to use the change command and snap to correct a slightly distorted vertical horizontal line. It probably won't work for rectangles. 

 

If there are no arcs and curves in your drawing, It would be good to start by reading all polylines and lines, 

making their coordinates into a list, and circulating the list and bringing them to integer positions. 

But in this case, the rectangle is at 101.11x99.9999 Something like 101x100 will happen. 

it seems to need a fuzzy roundup value as 5 or 10.

[Steven P]

Thanks

 

Was thinking something like that when I get to it, confirm I have got a closed polyline (maybe not necessary), get the coordinates, and from them the angle and side lengths (rectangle here, pairs of sides will be the same), then do some maths (average out opposite side lengths and round) and either entmod the existing or draw a new one and delete the old one.

 

That would be the basis of it, then just add in the rounding - think Lee Mac has one to round to the nearest number you specify to copy (I think I use that one to lime up text, lines and so on to the nearest grid point, 2.5, 5, 10 or whatever), could even do it from a look up list of standard sizes we use (electrical panels, so 100, 200, 250, 300, 400... and so on)

 

 

[mhupp]

Made this awhile back combines bounding box with rectangle command. What ever you select it will give you the rectangle length and width. but you can change the values to what you want. if you do the rectangle will be centered on what you selected.

 

--edit

added bounding box it instead of (BBox)

Only really helpful for horizontal rectangles

 

;;----------------------------------------------------------------------------;;
;; DRAW RECTANGLE FROM USER SELECTION
(defun C:REC (/ SS ent ptslst LL UR L&W l w MPT)
  (if (setq SS (ssget))
    (progn
      (foreach ent (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
        (vla-getboundingbox (vlax-ename->vla-object ent) 'minpt 'maxpt)
        (setq ptslst (cons (vlax-safearray->list minpt) ptslst)
              ptslst (cons (vlax-safearray->list maxpt) ptslst)
        )
      )
      (setq LL (apply 'mapcar (cons 'min ptslst))
            UR (apply 'mapcar (cons 'max ptslst))
            MPT (mapcar '/ (mapcar '+ LL UR) '(2 2 2))
            L&W (mapcar '- UR LL)
      )
      (if (setq l (getdist (strcat "\nRectangle Length [" (rtos (car L&W) 2 3) "]: ")))
        (progn)
        (setq l (car L&W))
      )
      (if (setq w (getdist (strcat "\nRectangle Width [" (rtos (cadr L&W) 2 3) "]: ")))
        (progn)
        (setq w (cadr L&W))
      )
      (setq MPT (list (- (car MPT) (/ l 2)) (- (cadr MPT) (/ w 2))))
      (setvar 'cmdecho 0)
      (vl-cmdf "_.Rectangle" "_non" MPT "_non" (strcat "@" (rtos l 2 4) "," (rtos w 2 4)))
      (setvar 'cmdecho 1)
    )
    (vl-cmdf "_.Rectangle")
  )
  (princ)
)

 

Edited June 29, 2022 by mhupp

[Steven P]

That might work for todays problems. Thanks, 

 

 

(just checking, yes that will line up everything with a bit of user input and could be a god start to what I am after later)

Edited June 29, 2022 by Steven P

[Steven P]

Just made a couple of quick changes, selecting the rectangles one at a time - didn't quite work for me doing them as a group but will fix that later.

 

Added zooming to and highlighting the rectangle in question, selecting a point for its lower left corner (rather then using its centre point for position) then resize. Good enough to save me an hour today, and one to come back to later

 

 

(vl-load-com)
;; DRAW RECTANGLE FROM USER SELECTION
(defun c:REC (/ SS ent ptslst LL UR L&W l w MPT)
  (if (setq SS (ssget))
    (progn
      (foreach ent (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
        (vla-getboundingbox (vlax-ename->vla-object ent) 'minpt 'maxpt)
        (setq ptslst (cons (vlax-safearray->list minpt) ptslst)
              ptslst (cons (vlax-safearray->list maxpt) ptslst)
        )
;      ) ;end for each

(command "_zoom" "_object" (ssadd ent) "")
(command "_zoom" "0.5x")
(redraw ent 3)
(setq MPT (getpoint "Select Lower Left Corner Position"))
(command "zoom" "p");;Zoom previous
(command "zoom" "p");;Zoom previous

      (setq LL (apply 'mapcar (cons 'min ptslst))
            UR (apply 'mapcar (cons 'max ptslst))
;;            MPT (mapcar '/ (mapcar '+ LL UR) '(2 2 2))
            L&W (mapcar '- UR LL)
      )

      (if (setq l (getdist (strcat "\nRectangle Length [" (rtos (car L&W) 2 3) "]: ")))
        (progn)
        (setq l (car L&W))
      )
      (if (setq w (getdist (strcat "\nRectangle Width [" (rtos (cadr L&W) 2 3) "]: ")))
        (progn)
        (setq w (cadr L&W))
      )
;;      (setq MPT (list (- (car MPT) (/ l 2)) (- (cadr MPT) (/ w 2))))
      (setvar 'cmdecho 0)
      (vl-cmdf "_.Rectangle" "_non" MPT "_non" (strcat "@" (rtos l 2 4) "," (rtos w 2 4)))

      (setvar 'cmdecho 1)
(entdel ent)
) ;end for each
    ) ;end progn
    (vl-cmdf "_.Rectangle")
  ) ;end if
  (princ)

)

 

 

[mhupp]

Nice. You can get rid of some lines of code if your doing one item at a time. usually when I'm use this its with multi polyline, text, & other stuff.

 

;; DRAW RECTANGLE FROM USER SELECTION
(defun c:REC (/ SS ent ptslst LL UR L&W l w MPT)
  (vl-load-com)
  (if (setq SS (ssget))
    (progn
      (command "_.view" "_save" "back") ;save zoom location
      (foreach ent (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
        (vla-getboundingbox (vlax-ename->vla-object ent) 'minpt 'maxpt)
        (setq LL (vlax-safearray->list minpt) ;could use this as point for rectangle no need to zoom?
              UR (vlax-safearray->list maxpt)
              L&W (mapcar '- UR LL)
        )        
        (command "_zoom" "_object" (ssadd ent) "")
        (command "_zoom" "0.5x")
        (redraw ent 3) ;always nice to see whats currently being calculated
        (setq LL (getpoint "Select Lower Left Corner Position"))
        (command "_.view" "_restore" "back") ;zoom back to save spot
        (if (setq l (getdist (strcat "\nRectangle Length [" (rtos (car L&W) 2 3) "]: ")))
          (progn)
          (setq l (car L&W))
        )
        (if (setq w (getdist (strcat "\nRectangle Width [" (rtos (cadr L&W) 2 3) "]: ")))
          (progn)
          (setq w (cadr L&W))
        )
        (setvar 'cmdecho 0)
        (vl-cmdf "_.Rectangle" "_non" LL "_non" (strcat "@" (rtos l 2 4) "," (rtos w 2 4)))
        (setvar 'cmdecho 1)
        (entdel ent)
      )  ;end for each
    )    ;end progn
    ;(vl-cmdf "_.Rectangle") ;prob don't want this if nothing is selected
  )      ;end if
  (princ) 
)

 

Edited June 29, 2022 by mhupp

[BIGAL]

My $ 0.05 "lower left corner (rather then using its centre point for position)" thought the same idea but maybe select a pline segment as the fixed angle, then mid left or right, then the 2 perp sides adjusted to suit say round average of the 2 sides. The top line then would be parallel. If pick 4 points.

[exceed]

; cleanREC - 2022.06.30 exceed
; https://www.cadtutor.net/forum/topic/75518-rectangles-to-snaps-resizing/
; Round the length of the rectangle line according to the fuzz factor. Enter 5 in units of 5, enter 10 in units of 10,
; Optionally, the center coordinates can also be rounded.

(vl-load-com)
(defun c:cleanrec ( / fuzzfactor coordalso ss ssl index obj type coord coordlen coordpairs closedyn pt1x pt2x pt1y pt2y centerx centery xlen ylen xlenfuzz ylenfuzz newcoord )
  (setq fuzzfactor (getreal "\n input roundup fuzzy factor : "))
  (setq coordalso (getstring "\n you need roundup center coordinates also? (Y - Yes / SpaceBar - No) : \n"))
  (setq ss (ssget ":L" '((0 . "*LINE"))))
  (setq ssl (sslength ss))
  (setq index 0)

  (repeat ssl
    (setq obj (vlax-ename->vla-object (ssname ss index)))
    (setq type (vlax-get-property obj 'entityname))
    (cond
      ((= type "AcDbLine")
        (princ "\n skip line at this step")
      )
      ((= type "AcDbPolyline")
        (setq coord (vlax-safearray->list (vlax-variant-value (vlax-get-property obj 'coordinates))))
        (setq coordlen (length coord))
        (setq coordpairs (/ coordlen 2))
        ;(princ coordpairs)
        (setq closedyn (vlax-get-property obj 'closed))
        ;(princ closedyn)
        (cond 
          ((and (= coordpairs 4) (= closedyn :vlax-true))
            (setq pt1x (car coord))
            (setq pt1y (cadr coord))
            (setq pt2x (nth 4 coord))
            (setq pt2y (nth 5 coord))
            (setq centerx (/ (+ pt1x pt2x) 2))
            (setq centery (/ (+ pt1y pt2y) 2))
            (if (= (strcase coordalso) "Y")
              (progn 
                (setq centerx (LM:roundup centerx fuzzfactor))
                (setq centery (LM:roundup centery fuzzfactor))
              )
            )
            (setq xlen (abs (- pt2x pt1x)))
            (setq ylen (abs (- pt2y pt1y)))
            (setq xlenfuzz (LM:roundup xlen fuzzfactor))
            (setq ylenfuzz (LM:roundup ylen fuzzfactor))
            (setq newcoord (list (- centerx (/ xlenfuzz 2)) (- centery (/ ylenfuzz 2)) (+ centerx (/ xlenfuzz 2)) (- centery (/ ylenfuzz 2)) (+ centerx (/ xlenfuzz 2)) (+ centery (/ ylenfuzz 2)) (- centerx (/ xlenfuzz 2)) (+ centery (/ ylenfuzz 2)) ))
            (princ "\n new coord - ")
            (princ newcoord)
            (vlax-put-property obj 'coordinates (vlax-make-variant newcoord))
          )
          ((and (= coordpairs 5) (= (car coord) (nth (- coordlen 2) coord)) (= (cadr coord) (last coord)))
            (setq pt1x (car coord))
            (setq pt1y (cadr coord))
            (setq pt2x (nth 4 coord))
            (setq pt2y (nth 5 coord))
            (setq centerx (/ (+ pt1x pt2x) 2))
            (setq centery (/ (+ pt1y pt2y) 2))
            (if (= (strcase coordalso) "Y")
              (progn 
                (setq centerx (LM:roundup centerx fuzzfactor))
                (setq centery (LM:roundup centery fuzzfactor))
              )
            )
            (setq xlen (abs (- pt2x pt1x)))
            (setq ylen (abs (- pt2y pt1y)))
            (setq xlenfuzz (LM:roundup xlen fuzzfactor))
            (setq ylenfuzz (LM:roundup ylen fuzzfactor))
            (setq newcoord (list (- centerx (/ xlenfuzz 2)) (- centery (/ ylenfuzz 2)) (+ centerx (/ xlenfuzz 2)) (- centery (/ ylenfuzz 2)) (+ centerx (/ xlenfuzz 2)) (+ centery (/ ylenfuzz 2)) (- centerx (/ xlenfuzz 2)) (+ centery (/ ylenfuzz 2)) (- centerx (/ xlenfuzz 2)) (- centery (/ ylenfuzz 2))))
            (princ "\n new coord - ")
            (princ newcoord)
            (vlax-put-property obj 'coordinates (vlax-make-variant newcoord))
          )
          (t 
            (princ "\n this is not rectangle")
          )
        )
      )
    )

    (setq index (+ index 1))
  )

  (princ)

)


;; Round Up  -  Lee Mac
;; Rounds 'n' up to the nearest 'm'

(defun LM:roundup ( n m )
    ((lambda ( r ) (cond ((equal 0.0 r 1e-8) n) ((< n 0) (- n r)) ((+ n (- m r))))) (rem n m))
)

 

It seems I'm late for the party, but please try my dessert

 

In the gif, an exaggerated rectangle is used to emphasize the effect. 

 

This gets the coordinates of the polyline rectangle, 

If there are 4 dots, check if they are closed 

In the case of 5, check whether the beginning and the end points are the same. 

for determines the rectangle. 

 

Then, calculate the x-length and y-length with the LL (No. 1) and UR (No. 3) points of the rectangle. 

The center point is also calculated from the LL and UR points. 

 

After that, round the x-length and y-length with Lee Mac's roundup function, 

Optionally, the center coordinates can also be rounded.

divide by half and add or subtract from the center point to create a new coordinates list 

and then input it to the polyline. 

 

What this routine lacks is that it has the same number of points as a square, but a different shape, such as a diamond, a trapezoid. 

did not assume It can be made by entering the Angle part into cond

 

 

 

+

this is version 2

; cleanREC2 - 2022.06.30 exceed
; https://www.cadtutor.net/forum/topic/75518-rectangles-to-snaps-resizing/
; Round the length of the rectangle line according to the fuzz factor. Enter 5 in units of 5, enter 10 in units of 10,
; Optionally, the center coordinates can also be rounded.

(vl-load-com)
(defun c:cleanREC2 ( / fuzzfactor coordalso ss ssl index obj type coord coordlen coordpairs closedyn pt1x pt1y pt2x pt2y pt3x pt3y pt4x pt4y centerx centery xlen ylen xlenfuzz ylenfuzz newcoord )
  (setq fuzzfactor (getreal "\n input roundup fuzzy factor : "))
  (setq coordalso (getstring "\n you need roundup center coordinates also? (Y - Yes / SpaceBar - No) : \n"))
  (setq ss (ssget ":L" '((0 . "*LINE"))))
  (setq ssl (sslength ss))
  (setq index 0)

  (repeat ssl
    (setq obj (vlax-ename->vla-object (ssname ss index)))
    (setq type (vlax-get-property obj 'entityname))
    (cond
      ((= type "AcDbLine")
        (princ "\n skip line at this step")
      )
      ((= type "AcDbPolyline")
        (setq coord (vlax-safearray->list (vlax-variant-value (vlax-get-property obj 'coordinates))))
        (setq coordlen (length coord))
        (setq coordpairs (/ coordlen 2))
        ;(princ coordpairs)
        (setq closedyn (vlax-get-property obj 'closed))
        ;(princ closedyn)
        (cond 
          ((and (= coordpairs 4) (= closedyn :vlax-true))
            (setq pt1x (car coord))
            (setq pt1y (cadr coord))
            (setq pt2x (nth 2 coord))
            (setq pt2y (nth 3 coord))
            (setq pt3x (nth 4 coord))
            (setq pt3y (nth 5 coord))
            (setq pt4x (nth 6 coord))
            (setq pt4y (nth 7 coord))
            (setq centerx (/ (+ (/ (+ pt1x pt3x) 2) (/ (+ pt2x pt4x) 2)) 2))
            (setq centery (/ (+ (/ (+ pt1y pt3y) 2) (/ (+ pt2y pt4y) 2)) 2))
            (if (= (strcase coordalso) "Y")
              (progn 
                (setq centerx (LM:roundup centerx fuzzfactor))
                (setq centery (LM:roundup centery fuzzfactor))
              )
            )
            (setq xlen (/ (+ (distance (list pt1x pt1y) (list pt2x pt2y)) (distance (list pt4x pt4y) (list pt3x pt3y))) 2))
            (setq ylen (/ (+ (distance (list pt1x pt1y) (list pt4x pt4y)) (distance (list pt2x pt2y) (list pt3x pt3y))) 2))
            (setq xlenfuzz (LM:roundup xlen fuzzfactor))
            (setq ylenfuzz (LM:roundup ylen fuzzfactor))
            (setq newcoord (list (- centerx (/ xlenfuzz 2)) (- centery (/ ylenfuzz 2)) (+ centerx (/ xlenfuzz 2)) (- centery (/ ylenfuzz 2)) (+ centerx (/ xlenfuzz 2)) (+ centery (/ ylenfuzz 2)) (- centerx (/ xlenfuzz 2)) (+ centery (/ ylenfuzz 2)) ))
            (princ "\n new coord - ")
            (princ newcoord)
            (vlax-put-property obj 'coordinates (vlax-make-variant newcoord))
          )
          ((and (= coordpairs 5) (= (car coord) (nth (- coordlen 2) coord)) (= (cadr coord) (last coord)))
            (setq pt1x (car coord))
            (setq pt1y (cadr coord))
            (setq pt2x (nth 2 coord))
            (setq pt2y (nth 3 coord))
            (setq pt3x (nth 4 coord))
            (setq pt3y (nth 5 coord))
            (setq pt4x (nth 6 coord))
            (setq pt4y (nth 7 coord))
            (setq centerx (/ (+ (/ (+ pt1x pt3x) 2) (/ (+ pt2x pt4x) 2)) 2))
            (setq centery (/ (+ (/ (+ pt1y pt3y) 2) (/ (+ pt2y pt4y) 2)) 2))
            (if (= (strcase coordalso) "Y")
              (progn 
                (setq centerx (LM:roundup centerx fuzzfactor))
                (setq centery (LM:roundup centery fuzzfactor))
              )
            )
            (setq xlen (/ (+ (distance (list pt1x pt1y) (list pt2x pt2y)) (distance (list pt4x pt4y) (list pt3x pt3y))) 2))
            (setq ylen (/ (+ (distance (list pt1x pt1y) (list pt4x pt4y)) (distance (list pt2x pt2y) (list pt3x pt3y))) 2))
            (setq xlenfuzz (LM:roundup xlen fuzzfactor))
            (setq ylenfuzz (LM:roundup ylen fuzzfactor))
            (setq newcoord (list (- centerx (/ xlenfuzz 2)) (- centery (/ ylenfuzz 2)) (+ centerx (/ xlenfuzz 2)) (- centery (/ ylenfuzz 2)) (+ centerx (/ xlenfuzz 2)) (+ centery (/ ylenfuzz 2)) (- centerx (/ xlenfuzz 2)) (+ centery (/ ylenfuzz 2)) (- centerx (/ xlenfuzz 2)) (- centery (/ ylenfuzz 2))))
            (princ "\n new coord - ")
            (princ newcoord)
            (vlax-put-property obj 'coordinates (vlax-make-variant newcoord))
          )
          (t 
            (princ "\n this is not rectangle")
          )
        )
      )
    )

    (setq index (+ index 1))
  )

  (princ)

)


;; Round Up  -  Lee Mac
;; Rounds 'n' up to the nearest 'm'

(defun LM:roundup ( n m )
    ((lambda ( r ) (cond ((equal 0.0 r 1e-8) n) ((< n 0) (- n r)) ((+ n (- m r))))) (rem n m))
)

 

 

calculate the length of one side of a rectangle has been written in more detail. 

this Works better for rotated rectangles.

Edited June 30, 2022 by exceed

[Steven P]

7 hours ago, BIGAL said:

My $ 0.05 "lower left corner (rather then using its centre point for position)" thought the same idea but maybe select a pline segment as the fixed angle, then mid left or right, then the 2 perp sides adjusted to suit say round average of the 2 sides. The top line then would be parallel. If pick 4 points.

 

Picking a point is my preference, often for me the rectangles are electrical panels and are lined up against walls, specifying an insertion point for each would be useful in that case

 

 

Exceed - that looks good, I'll have to sit down and work out what you are doing - busy week this week, so might be next week I get chance, thanks. Questions about it later no doubt

[BIGAL]

Steven P agree if want corner can still use a select pline segment but pick near end that is used in this code.

 

; Pline segment with angle and length

(defun c:plseg()
(setq plent (entsel "\nSelect Pline  "))
(setvar "osmode" 0)
(setq
      pick (cadr plent)
      plObj (vlax-ename->vla-object (car plent))
      pick2 (vlax-curve-getclosestpointto plobj pick)
      param (vlax-curve-getparamatpoint plObj pick2)
      segment (fix param)
	  co-ord (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget (car plent)))))
(setq pt1 (nth segment co-ord))
(setq pt2 (nth (+ segment 1) co-ord))
(if (= pt2 nil)(setq pt2 (nth 0 co-ord)))
(setq len (distance pt1 pt2))
(setq ang (angle pt1 pt2))
(alert (strcat "angle is "  (rtos (/ (* ang 180.0) pi) 2 2) " Length is " (rtos len 2 3)))
)