Topic: Stretch while maintaining area

[McRojo the Irishman]

Not enough water in Austin?  What's that big river running through the middle?  What about those lakes around the city?  And how much rain do they get in a year?  In San Diego has one little puddle of water called the Pacific Ocean.  Residents have to fight the tourists to enjoy the beaches.  When it rains, we're not supposed to go into the water because of the runoff from the storm drains, not to mention the crap that floats up from Mexico and down from LA (I don't know how that works but those are the places I hear are sending the stuff that floats up on our beaches).  Speaking of stuff floating up on our beaches... I PERSONALLY have found an unexploded device the Navy coudn't keep hold of.  Lifeguards called the cops called the Navy sent their EOD team and closed a bunch of the beach off to get rid of it (sorry 'bout that, y'all).  

Politicians???  Who's the Gubner of California?  Doggam Arnold the Barbarian (lets just gas all the animals in our shelters... that'll save the state a few mil every year)  or our local SD politicians who take kick backs from strip clubs to ease up on the 'no touching' laws.  Yuppies???  We get all the euphemisms from all the 50 states and odd countries throughout the world!  

Oh man... don't get me started...

Just playin' right....

[dubb]

HI MCROJO, FROM SAN DIEGO? DO YOU MIND ME ASKING WHAT COMPANY YOU WORK FOR?

[McRojo the Irishman]

At the moment I'm working for a guy out of his garage.  When I wrote the last post I was working for a small company in San Diego.  Don't even know if they're still in business.

[t-bear]

Small companies and back-street garages .... ain't life an adventure?
Did you ever find a routine that did what you needed?



Oh yah... howdee Irish!  LTNS

[CAB]

Here are the only links  could find
link1
link2
link2

No one accomplished the task.
I think there approach was the problem, that is modifying the rectangle in real time.
I think using examples given by Stig you could create a temporary rectangle using grread.
The starting rectangle would be on top of the picked rectangle, you pick the anchor corner
and as you move the pointer the rectangle resize to maintain the area. Using a left click
to redraw the new rectangle or enter to quit.

I wish I had time to try it but not today.
Here is some code from Stig if anyone whants to have a go at it.

Code: [Select]

;;  Rectangel Get - Stig
;;  Honers the right to left solid line & left to right dashed line
;;  used in the normal selection method.
(defun getrect (pt / col method pi270 pi90 pt1 track)
  (setq pi270 (* 1.5 pi) pi90 (* 0.5 pi))
  (while (= 5 (car (setq track (grread T 5 1))))
    (redraw)
    (setq pt1 (cadr track))
    (cond ((>= pi270 (angle pt pt1) pi90)(setq col -256 method "_C"))
          ((setq col 256 method "_W")))
    (grvecs (list col pt (list (car pt) (cadr pt1))
                  col (list (car pt) (cadr pt1)) pt1
                  col pt1 (list (car pt1)(cadr pt))
                  col (list (car pt1)(cadr pt)) pt))
  )
  (redraw)
  ;; return point AND selection method
  (cond (pt1 (list pt1 method)))
)
(defun c:test1()
  (setq p (getpoint "\nPick piont."))
  (setq p2 (getrect p))
  (princ)
)

[t-bear]

Now that would be an interesting little routine.  Don't know what I'd do with it, but it'd be fun to play with.....
Boys-n-their toys.

[CAB]

Here is version one.
Not any options or a lot of error checking.
Leaves the original rectangle.

Code: [Select]

;;  Rectangle Stretch while maintaining the area
;;  Move mouse left & right to stretch
;;  Lower left corner is fixed at this time.
(defun c:rstretch(/ ent clst ll ur area pt)
  (if (and (setq ent (entsel  "\nPick rectangle."))
           (= (cdr (assoc 0 (setq entlst (entget (setq ent (car ent))))))
              "LWPOLYLINE")
           (= (length (setq clst (get_vertex entlst))) 4)
           (ispolyclosed ent)
      )
    (progn
      ;; get lower left corner
      (setq ll (list (apply 'min (mapcar 'car  clst))
                     (apply 'min (mapcar 'cadr clst))))
      ;;  get upper right corner
      (setq ur (list (apply 'max (mapcar 'car  clst))
                     (apply 'max (mapcar 'cadr clst))))
      (vl-cmdf "area" "o" ent)
      (setq area (getvar "AREA"))
      (setq pt (getrect ll ur area))
      (if (= (cadr pt) 3)
        (progn ; add new rectangle to drawing
         (command "rectangle" ll )
         (command (car pt))
        )
      )
      (princ)

    ); progn
    (prompt "\nError, object is not a closed rectangle.")
  ) ; endif
  (princ)
)

;;  Rectangel Get - Stig ; CAB modified
;;  Honers the right to left solid line & left to right dashed line
;;  used in the normal selection method.
(defun getrect (pt ur area / col method pi270 pi90 pt1 track)
  (setq pi270 (* 1.5 pi) pi90 (* 0.5 pi))
  (setq wd (- (car ur) (car ll))
        ht (- (cadr ur) (cadr ll))
         )
  (setq plast(cadr (setq track (grread T 5 1)))
        x (car plast)
        y (cadr plast)
        urx (car ur)
        ury (cadr ur)
        basex (car ll)
        basey (cadr ll))
  (while (= 5 (car (setq track (grread T 5 1))))
    (redraw)
    (setq pt1 (cadr track))
    (if (not (equal (car pt1) x 0.0005))
      ;;  x changed
      (setq deltax (- (car pt1) x)
            ht (max (+ ht deltax) 0.001)
            wd (/ area ht)
      )
    )
    (setq pt1 (list (+ ht basex) (+ wd basey)) ; new position
          x (car pt1))

   
    (cond ((>= pi270 (angle pt pt1) pi90)(setq col -256 method "_C"))
          ((setq col 256 method "_W")))
    (grvecs (list col pt (list (car pt) (cadr pt1))
                  col (list (car pt) (cadr pt1)) pt1
                  col pt1 (list (car pt1)(cadr pt))
                  col (list (car pt1)(cadr pt)) pt))
  )
  (redraw)
  ;; return point AND exit code
  (cond (pt1 (list pt1 (car track))))
)

;;return: T if closed, nil otherwise
(defun ispolyclosed (elist)
  (= 1 (logand 1 (cdr (assoc 70 (entget elist)))))
)
(defun get_vertex (elist)
  (mapcar 'cdr
          (vl-remove-if-not
            '(lambda (x) (= (car x) 10))
            elist
          )
  )
)

[ronjonp]

CAB...you are a genius

[CAB]

CAB...you are a genius

Thanks to Stig for all those cool routines.