topic Re : Minimum rectangle in Visual LISP, AutoLISP and General Customization Forum

Minimum rectangle

well20152016 — Sat, 07 Jan 2017 01:03:48 GMT

Minimum rectangle
The smallest rectangle of two polygons.

Re: Minimum rectangle

john.uhden — Sat, 07 Jan 2017 01:51:07 GMT

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

Re: Minimum rectangle

well20152016 — Sat, 07 Jan 2017 18:13:26 GMT

Algorithm is a bit difficult, there will be friends

Re: Minimum rectangle

ВeekeeCZ — Sat, 07 Jan 2017 18:25:02 GMT

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

Re: Minimum rectangle

martti.halminen — Mon, 09 Jan 2017 09:48:21 GMT

@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.

Re : Minimum rectangle

CADaSchtroumpf — Mon, 09 Jan 2017 12:56:08 GMT

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)
)

Re: Minimum rectangle

john.uhden — Mon, 09 Jan 2017 17:30:26 GMT

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).

Re : Minimum rectangle

john.uhden — Mon, 09 Jan 2017 18:44:57 GMT

That worked very well!

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

Re : Minimum rectangle

CADaSchtroumpf — Mon, 09 Jan 2017 19:00:12 GMT

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?

Re : Minimum rectangle

john.uhden — Mon, 09 Jan 2017 19:27:50 GMT

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))

Re : Minimum rectangle

well20152016 — Tue, 10 Jan 2017 09:42:27 GMT

Thank you！

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

Re : Minimum rectangle

marko_ribar — Tue, 10 Jan 2017 11:38:56 GMT

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.

Re : Minimum rectangle

CADaSchtroumpf — Tue, 10 Jan 2017 13:52:37 GMT

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 .

Re : Minimum rectangle

well20152016 — Tue, 10 Jan 2017 15:13:46 GMT

A simple first draft, this version has bug!

Re : Minimum rectangle

marko_ribar — Tue, 10 Jan 2017 16:37:26 GMT

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.

Re : Minimum rectangle

well20152016 — Tue, 10 Jan 2017 17:23:49 GMT

Thanks Marko_ribar

I know you can do better!

Re : Minimum rectangle

john.uhden — Tue, 10 Jan 2017 19:11:46 GMT

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

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

Re : Minimum rectangle

john.uhden — Tue, 10 Jan 2017 19:16:27 GMT

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

Re : Minimum rectangle

marko_ribar — Thu, 12 Jan 2017 10:28:16 GMT

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

HTH., Regards, M.R.

Re : Minimum rectangle

well20152016 — Thu, 12 Jan 2017 12:11:03 GMT

Ribar Marko, I admire you!