Minimum rectangle

Minimum rectangle

well20152016
Contributor Contributor
3,091 Views
21 Replies
Message 1 of 22

Minimum rectangle

well20152016
Contributor
Contributor

Minimum rectangle
The smallest rectangle of two polygons.

0 Likes
3,092 Views
21 Replies
Replies (21)
Message 2 of 22

john.uhden
Mentor
Mentor

AARGH!  That requires nesting the polygons.  How about if they're already nested?

John F. Uhden

0 Likes
Message 3 of 22

well20152016
Contributor
Contributor

Algorithm is a bit difficult, there will be friends

0 Likes
Message 4 of 22

ВeekeeCZ
Consultant
Consultant

Try THE SWAMP Those guys are up to challenge stuff if finds it interesting.

0 Likes
Message 5 of 22

martti.halminen
Collaborator
Collaborator

@well20152016 wrote:

Minimum rectangle
The smallest rectangle of two polygons.


For simple shapes where aligning the edges works this could be done:

 

Start at one edge of polygon A.

     Align one edge of polygon B with the edge of A. Slide B along the edge, searching for the minimum

    area of the bounding box among the non-intersecting locations.

    Repeat for all edges of B.

Repeat for all edges of A.

 

Things get more interesting when we allow more complicated geometry, where aligned edges are not necessarily the minimum area: think about trying to nest a W and an E shape. Another complication would be allowed mirroring or forced directions.

- which probably explains why most nesting programs are commercial products.

 

-- 

 

0 Likes
Message 6 of 22

CADaSchtroumpf
Advisor
Advisor

I attempted to resolve this with two polyline closed (without arc vertex)

 

Try it!

 

(defun c:imbric ( / js n ent dxf_ent lst_pt lst_d where alpha imbric pt_why pt_where minpt1 maxpt1 minpt2 maxpt2 minpt maxpt)
  (setq js (ssget '((0 . "LWPOLYLINE") (-4 . "<AND") (-4 . "&") (70 . 1) (-4 . "AND>"))))
  (cond
    ((and js (eq (setq n (sslength js)) 2))
      (repeat n
        (setq
          ent (ssname js (setq n (1- n)))
          dxf_ent (entget ent)
          lst_pt (mapcar '(lambda (x) (trans x ent 0)) (mapcar 'cdr (vl-remove-if '(lambda (x) (/= (car x) 10)) dxf_ent)))
          lst_d (mapcar 'distance lst_pt (cons (last lst_pt) lst_pt))
          where (- (length lst_pt) (length (member (apply 'max lst_d) lst_d)))
          alpha (angle (if (zerop where) (last lst_pt) (nth (1- where) lst_pt)) (nth where lst_pt))
          imbric (cons (list ent alpha (if (zerop where) (last lst_pt) (nth (1- where) lst_pt)) (nth where lst_pt)) imbric)
        )
      )
      (cond
        (imbric
          (setq
            lst_d (mapcar 'distance (cddar imbric) (cddadr imbric))
            where (- (length imbric) (length (member (apply 'max lst_d) lst_d)))
            pt_why (nth where imbric)
            where (- (length imbric) (length (member (apply 'min lst_d) lst_d)))
            pt_where (nth where imbric)
            alpha (mapcar '(lambda (x) (if (> x pi) 1 0)) (mapcar 'cadr imbric))
          )
          (if (zerop (eval (cons boole (cons 6 alpha))))
            (command
              "_.align" (caddr pt_why) ""
              "_none" (caddr pt_why) "_none" (cadddr pt_where)
              "_none" (cadddr pt_why) "_none" (caddr pt_where)
              "" "_no"
            )
            (command
              "_.align" (caddr pt_why) ""
                "_none" (caddr pt_why) "_none" (caddr pt_where)
                "_none" (cadddr pt_why) "_none" (cadddr pt_where)
              "" "_no"
            )
          )
          (command
            "_.rotate" (car pt_why) (car pt_where) ""
            "_none" (caddr pt_where)
            "_reference" "_none" (caddr pt_where) "_none" (cadddr pt_where)
            "_none" (list (car (cadddr pt_where)) (cadr (caddr pt_where)))
          )
          (vla-GetBoundingBox (vlax-ename->vla-object (car pt_why)) 'mnpt 'mxpt)
          (setq
            minpt1 (trans (safearray-value mnpt) 0 1)
            maxpt1 (trans (safearray-value mxpt) 0 1)
          )
          (vla-GetBoundingBox (vlax-ename->vla-object (car pt_where)) 'mnpt 'mxpt)
          (setq
            minpt2 (trans (safearray-value mnpt) 0 1)
            maxpt2 (trans (safearray-value mxpt) 0 1)
          )
          (setq
            minpt
            (list
              (eval (cons min (mapcar 'car (list minpt1 minpt2))))
              (eval (cons min (mapcar 'cadr (list minpt1 minpt2))))
            )
            maxpt
            (list
              (eval (cons max (mapcar 'car (list maxpt1 maxpt2))))
              (eval (cons max (mapcar 'cadr (list maxpt1 maxpt2))))
            )
          )
          (command "_.pline"
            "_none" minpt
            "_none" (list (car maxpt) (cadr minpt))
            "_none" maxpt
            "_none" (list (car minpt) (cadr maxpt))
            "_close"
          )
        )
      )
    )
    (T (princ "\nSelect only two LWPOLYLINE and will must be closed!"))
  )
  (prin1)
)

 

0 Likes
Message 7 of 22

john.uhden
Mentor
Mentor
Well said!

I created a nesting program in AutoLisp for vinyl pool liner panels. The
obvious objective is to minimize the amount of material to be cut from a
continuous roll. It was a lot of work. It did not provide automatic
rotation adjustments, but neither did the cutter manufacturer's $8000 per
seat nesting program. At least it did provide for the user to rotate
panels manually. Plus it created the CMD files for the cutter program to
read and send instructions to the cutter. Networking all the computers
together saved a lot of labor (and stupid diskettes).

John F. Uhden

0 Likes
Message 8 of 22

john.uhden
Mentor
Mentor

That worked very well!

 

All you have to do now is to automatically nest the polylines.  😕

John F. Uhden

0 Likes
Message 9 of 22

CADaSchtroumpf
Advisor
Advisor

john.uhden a écrit :

That worked very well!

 

All you have to do now is to automatically nest the polylines.  😕


No really work very well,

I have a problem with clockwise, that i have attempt to corrected.

The code remains simple and does not pretend to give an optimized solution. But it can be a starting indeed. . .
Can use bpoly to unify the result and resume the loop?

Message 10 of 22

john.uhden
Mentor
Mentor

There's no reason to turn them into regions and union them.  Your use of mins and maxs of bounding boxes works just fine, though it might be a millisecond faster via:

 

(apply 'min (mapcar 'car points))

  and

(apply 'max (mapcar 'cadr points))

  <I think but did not test>

John F. Uhden

0 Likes
Message 11 of 22

well20152016
Contributor
Contributor

Thank you!

 

I think there's a better way! Ask everybody to help!

0 Likes
Message 12 of 22

marko_ribar
Advisor
Advisor

Well done Stroumph... It works fine for me, but I'd prompt for selection of CONVEX polygons, so I made my (Lee Mac's) version with ConvexHull sub functions... Here it goes, but all kudos to you, I only added filter modification to exclude LWPOLYLINES with ARCS (Bulges)...

 

(defun c:imbric ( / LM:ConvexHull LM:Clockwise-p js n ent dxf_ent lst_pt lst_d where alpha imbric pt_why pt_where minpt1 maxpt1 minpt2 maxpt2 minpt maxpt )

  (vl-load-com)

  ;; Convex Hull  -  Lee Mac
  ;; Implements the Graham Scan Algorithm to return the Convex Hull of a list of points.
   
  (defun LM:ConvexHull ( lst / ch p0 )
      (cond
          (   (< (length lst) 4) lst)
          (   (setq p0 (car lst))
              (foreach p1 (cdr lst)
                  (if (or (< (cadr p1) (cadr p0))
                          (and (equal (cadr p1) (cadr p0) 1e-8) (< (car p1) (car p0)))
                      )
                      (setq p0 p1)
                  )
              )
              (setq lst (vl-remove p0 lst))
              (setq lst (append (list p0) lst))
              (setq lst
                  (vl-sort lst
                      (function
                          (lambda ( a b / c d )
                              (if (equal (setq c (angle p0 a)) (setq d (angle p0 b)) 1e-8)
                                  (< (distance p0 a) (distance p0 b))
                                  (< (if (equal c (* 2.0 pi) 1e-8) 0.0 c) (if (equal d (* 2.0 pi) 1e-8) 0.0 d))
                              )
                          )
                      )
                  )
              )
              (setq ch (list (caddr lst) (cadr lst) (car lst)))
              (foreach pt (cdddr lst)
                  (setq ch (cons pt ch))
                  (while (and (caddr ch) (LM:Clockwise-p (caddr ch) (cadr ch) pt))
                      (setq ch (cons pt (cddr ch)))
                  )
              )
              (reverse ch)
          )
      )
  )
   
  ;; Clockwise-p  -  Lee Mac
  ;; Returns T if p1,p2,p3 are clockwise oriented or collinear
                   
  (defun LM:Clockwise-p ( p1 p2 p3 )
      (<  (-  (* (- (car  p2) (car  p1)) (- (cadr p3) (cadr p1)))
              (* (- (cadr p2) (cadr p1)) (- (car  p3) (car  p1)))
          )
          1e-8
      )
  )

  (prompt "\nSelect 2 polygons...")
  (setq js (ssget '((0 . "LWPOLYLINE") (-4 . "<AND") (-4 . "&") (70 . 1) (-4 . "AND>") (-4 . "<NOT") (-4 . "<>") (42 . 0.0) (-4 . "NOT>"))) imbric nil)
  (cond
    ((and js (eq (setq n (sslength js)) 2))
      (repeat n
        (setq
          ent (ssname js (setq n (1- n)))
          dxf_ent (entget ent)
          lst_pt (mapcar '(lambda ( x ) (trans x ent 0)) (mapcar 'cdr (vl-remove-if '(lambda ( x ) (/= (car x) 10)) dxf_ent)))
          lst_pt (LM:ConvexHull lst_pt)
        )
        (if (not (LM:Clockwise-p (car lst_pt) (cadr lst_pt) (caddr lst_pt)))
          (setq lst_pt (reverse lst_pt))
        )
        (setq
          lst_d (mapcar 'distance lst_pt (cons (last lst_pt) lst_pt))
          where (- (length lst_pt) (length (member (apply 'max lst_d) lst_d)))
          alpha (angle (if (zerop where) (last lst_pt) (nth (1- where) lst_pt)) (nth where lst_pt))
          imbric (cons (list ent alpha (if (zerop where) (last lst_pt) (nth (1- where) lst_pt)) (nth where lst_pt)) imbric)
        )
      )
      (cond
        (imbric
          (setq
            lst_d (mapcar 'distance (cddar imbric) (cddadr imbric))
            where (- (length imbric) (length (member (apply 'max lst_d) lst_d)))
            pt_why (nth where imbric)
            where (- (length imbric) (length (member (apply 'min lst_d) lst_d)))
            pt_where (nth where imbric)
            alpha (mapcar '(lambda ( x ) (if (> x pi) 1 0)) (mapcar 'cadr imbric))
          )
          (if (zerop (eval (cons boole (cons 6 alpha))))
            (command
              "_.align" (caddr pt_why) ""
              "_none" (caddr pt_why) "_none" (cadddr pt_where)
              "_none" (cadddr pt_why) "_none" (caddr pt_where)
              "" "_no"
            )
            (if (zerop (car alpha))
              (command
                "_.align" (caddr pt_why) ""
                  "_none" (caddr pt_why) "_none" (cadddr pt_where)
                  "_none" (cadddr pt_why) "_none" (caddr pt_where)
                "" "_no"
              )
              (command
                "_.align" (caddr pt_why) ""
                  "_none" (cadddr pt_why) "_none" (caddr pt_where)
                  "_none" (caddr pt_why) "_none" (cadddr pt_where)
                "" "_no"
              )
            )
          )
          (command
            "_.rotate" (car pt_why) (car pt_where) ""
            "_none" (caddr pt_where)
            "_reference" "_none" (caddr pt_where) "_none" (cadddr pt_where)
            "_none" (list (car (cadddr pt_where)) (cadr (caddr pt_where)))
;            "_none" (polar (caddr pt_where) (* 0.25 pi) (nth where lst_d))
          )
          (vla-GetBoundingBox (vlax-ename->vla-object (car pt_why)) 'mnpt 'mxpt)
          (setq
            minpt1 (trans (safearray-value mnpt) 0 1)
            maxpt1 (trans (safearray-value mxpt) 0 1)
          )
          (vla-GetBoundingBox (vlax-ename->vla-object (car pt_where)) 'mnpt 'mxpt)
          (setq
            minpt2 (trans (safearray-value mnpt) 0 1)
            maxpt2 (trans (safearray-value mxpt) 0 1)
          )
          (setq
            minpt
            (list
              (eval (cons min (mapcar 'car (list minpt1 minpt2))))
              (eval (cons min (mapcar 'cadr (list minpt1 minpt2))))
            )
            maxpt
            (list
              (eval (cons max (mapcar 'car (list maxpt1 maxpt2))))
              (eval (cons max (mapcar 'cadr (list maxpt1 maxpt2))))
            )
          )
          (command "_.pline"
            "_none" minpt
            "_none" (list (car maxpt) (cadr minpt))
            "_none" maxpt
            "_none" (list (car minpt) (cadr maxpt))
            "_close"
          )
        )
      )
    )
    (T (princ "\nSelect only two LWPOLYLINE and will must be closed!"))
  )
  (prin1)
)

Regards, M.R.

Marko Ribar, d.i.a. (graduated engineer of architecture)
Message 13 of 22

CADaSchtroumpf
Advisor
Advisor

Good point marko for your integration of convex hull.

 

It'snt very optimised for occupation of area but it's true for concave shape superposition .

0 Likes
Message 14 of 22

well20152016
Contributor
Contributor

A simple first draft, this version has bug!

Message 15 of 22

marko_ribar
Advisor
Advisor

Seeing your version, I think that you are very close to a solution... Maybe if it could detect resulting polygons and if you could apply automatic collision avoid detection with applied correct angle, it could be even better... Revise topic from here... You deserve at least a kudo for your routine you attached... All the best, M.R.

Marko Ribar, d.i.a. (graduated engineer of architecture)
0 Likes
Message 16 of 22

well20152016
Contributor
Contributor

Thanks Marko_ribar

I know you can do better!

0 Likes
Message 17 of 22

john.uhden
Mentor
Mentor

I don't think BPOLY, aka BOUNDARY, can join two closed polylines.

I think that's where regions and UNION come into play.

John F. Uhden

0 Likes
Message 18 of 22

john.uhden
Mentor
Mentor

Simple baloney!  I didn't look at the code, but the video results are remarkable.  NICE!!

John F. Uhden

0 Likes
Message 19 of 22

marko_ribar
Advisor
Advisor

You may find my latest input from here also useful...

HTH., Regards, M.R.

Marko Ribar, d.i.a. (graduated engineer of architecture)
Message 20 of 22

well20152016
Contributor
Contributor

Ribar Marko, I admire you!

0 Likes