Author Topic: Minimum rectangle  (Read 5692 times)

0 Members and 1 Guest are viewing this topic.

well20152016

  • Newt
  • Posts: 130
Minimum rectangle
« on: December 30, 2016, 01:42:31 AM »
Minimum rectangle
The smallest rectangle of two polygons.
« Last Edit: December 30, 2016, 02:01:10 AM by well20152016 »

kdub_nz

  • Mesozoic keyThumper
  • SuperMod
  • Water Moccasin
  • Posts: 2124
  • class keyThumper<T>:ILazy<T>
Re: Minimum rectangle
« Reply #1 on: December 30, 2016, 01:59:31 AM »

Excellent ... do you want to share the source code ?
Called Kerry in my other life
Retired; but they dragged me back in !

I live at UTC + 13.00

---
some people complain about loading the dishwasher.
Sometimes the question is more important than the answer.

well20152016

  • Newt
  • Posts: 130
Re: Minimum rectangle
« Reply #2 on: December 30, 2016, 02:13:22 AM »
Sorry, I have no source, I am also learning.
« Last Edit: December 30, 2016, 03:55:22 AM by well20152016 »

roy_043

  • Water Moccasin
  • Posts: 1895
  • BricsCAD 18
Re: Minimum rectangle
« Reply #3 on: December 30, 2016, 05:35:17 AM »
@well20152016:
The shapes in the top row of drawing2.dwg will also fit in a rectangle of 78147 sq units (your rectangle is 83575 sq units).
For the bottom row the rectangle can be 42526 sq units instead of 43840.
--=={Challenge}==-- :-D
« Last Edit: December 30, 2016, 05:43:06 AM by roy_043 »

trogg

  • Bull Frog
  • Posts: 255
Re: Minimum rectangle
« Reply #4 on: December 30, 2016, 11:31:30 AM »

ribarm

  • Gator
  • Posts: 3225
  • Marko Ribar, architect
Re: Minimum rectangle
« Reply #5 on: December 30, 2016, 01:31:34 PM »
Have you checked this out?
http://www.lee-mac.com/minboundingbox.html

I'd suggest instead this :
https://www.theswamp.org/index.php?topic=50205.0

But OP is searching for solution including transformations of source entities (polylines) - this is making things far more complicated... All the best in your quest OP and of course Happy New Year...
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

well20152016

  • Newt
  • Posts: 130
Re: Minimum rectangle
« Reply #6 on: December 31, 2016, 10:36:49 AM »
Is how to collide, get the smallest rectangle.
Happy new year!

ribarm

  • Gator
  • Posts: 3225
  • Marko Ribar, architect
Re: Minimum rectangle
« Reply #7 on: January 12, 2017, 05:21:44 AM »
Hi well20152016,
using your sub functions, this may be good... At least is for me for now...

Code - Auto/Visual Lisp: [Select]
  1. (defun c:2polygonsnest ( / vk_IsPointInside unique minarearectangle graham-scan sort-by-angle-distance dotpr crosspr det
  2.                         ss lw1 lw2 pts1 pts2 ch1 ch2 minrec1 minrec2 d11 d12 d21 d22
  3.                         pts ips rtn rec
  4.                      )
  5.  
  6.   (defun vk_IsPointInside ( Point PointsList / PY P1Y P2Y )
  7.   ; works with polygons only, i.e. if (equal (car PointsList) (last PointsList))
  8.     (or
  9.       (if (cdr PointsList)
  10.         (/= (and (or (and (<= (setq PY  (cadr Point)
  11.                                  P2Y (cadadr PointsList)
  12.                                  P1Y (cadar PointsList)
  13.                             )
  14.                             PY
  15.                         )
  16.                         (< PY P2Y)
  17.                     )
  18.                     (and (> P1Y PY) (>= PY P2Y))
  19.                 )
  20.                 (> (car Point)
  21.                    (+ (* (/ (- PY P1Y) (- P2Y P1Y))
  22.                          (- (caadr PointsList) (caar PointsList))
  23.                       )
  24.                       (caar PointsList)
  25.                    )
  26.                 )
  27.             )
  28.             (vk_IsPointInside Point (cdr PointsList))
  29.         )
  30.       )
  31.       (vl-some (function (lambda ( a b ) (equal (distance a b) (+ (distance a Point) (distance Point b)) 1e-6))) PointsList (cdr PointsList))
  32.     )
  33.   )
  34.  
  35.   (defun unique ( l )
  36.     (if l (cons (car l) (unique (vl-remove-if (function (lambda ( x ) (equal x (car l) 1e-6))) l))))
  37.   )
  38.  
  39.   ;;;=======================================================
  40.   ;;;Function : Find the minimum area of encasing rectangle.
  41.   ;;;Arguments : A CCW HULL                                
  42.   ;;;Return: The Four points of Rectangle and its Area      
  43.   ;;;=======================================================
  44.   (defun MinAreaRectangle ( ptlist / AA AI BB D1 D2 EDGE I I1X I1Y I2X I2Y IL INF IX IY J1 J2 MINA MINH MINW NORH NORM PI1 PI2 PTI0 PTI1 PTI2 PTJ1 PTK1 PTM1 PTS1 PTS2 PTS3 PTS4 REC1 REC2 REC3 REC4 RECT VECH VECL VJ12 VM12 )
  45.     (setq INF 1e309)      
  46.     (setq minA INF)       ;Initiating the Minimum is infinite
  47.     (setq pti0 (car ptlist))      ;the first point of Hull.
  48.     (setq pts1 (append ptlist (list pti0)))    ;add the first point at back of Hull
  49.     (setq pts2 (cdr (append ptlist ptlist (list pti0))))   ;Construct a loop for the hull
  50.     (setq i 0)        
  51.  
  52.     ;;Find area of encasing rectangle anchored on each edge.
  53.     (repeat (length ptlist)
  54.       (setq pi1 (car pts1)      
  55.            pi2 (cadr pts1)
  56.            i1x (car pi1)
  57.            i1y (cadr pi1)
  58.            i2x (car pi2)
  59.            i2y (cadr pi2)
  60.            ix (- i2x i1x)
  61.            iy (- i2y i1y)
  62.            il (distance (list ix iy) '(0.0 0.0))
  63.       )
  64.  
  65.       ;;Find a vertex on on first perpendicular line of support
  66.       (while (> (DOTPR ix iy pts2) 0.0)
  67.         (setq pts2 (cdr pts2))
  68.       )
  69.  
  70.       ;;Find a vertex on second perpendicular line of support
  71.       (if (= i 0)
  72.         (setq pts3 pts2)
  73.       )
  74.       (while (> (CROSSPR ix iy pts3) 0.0)
  75.         (setq pts3 (cdr pts3))
  76.       )
  77.  
  78.       ;;Find a vertex on second perpendicular line of support
  79.       (if (= i 0)
  80.         (setq pts4 pts3)
  81.       )
  82.       (while (< (DOTPR ix iy pts4) 0.0)
  83.         (setq pts4 (cdr pts4))
  84.       )
  85.  
  86.       ;;Find distances between parallel and perpendicular lines of support
  87.       (cond
  88.         ( (equal i1x i2x 1e-4)
  89.           (setq d1 (- (caar pts3) i1x)
  90.                d2 (- (cadar pts4) (cadar pts2))
  91.           )
  92.         )
  93.         ( (equal i1y i2y 1e-4)
  94.           (setq d1 (- (cadar pts3) i1y)
  95.                d2 (- (caar pts4) (caar pts2))
  96.           )
  97.         )
  98.         (T
  99.           (setq aa (det pi1 pi2 (car pts3)))
  100.           (setq d1 (/ aa il))
  101.           (setq j1 (car pts2))
  102.           (setq j2 (list (- (car j1) iy) (+ (cadr j1) ix)))
  103.           (setq bb (det j1 j2 (car pts4)))
  104.           (setq d2 (/ bb il))
  105.         )
  106.       )
  107.  
  108.       ;;Compute area of encasing rectangle anchored on current edge.
  109.       ;;if the area is smaller than the old Minimum area, then update, and record the width, height and five points.
  110.       (setq Ai (abs (* d1 d2)))
  111.       (if (< Ai MinA)
  112.         (setq MinA Ai
  113.              MinH d1
  114.              MinW d2
  115.              pti1 pi1
  116.              pti2 pi2
  117.              ptj1 (car pts2)
  118.              ptk1 (car pts3)
  119.              ptm1 (car pts4)
  120.         )
  121.       )
  122.       (setq pts1 (cdr pts1))
  123.       (setq i (1+ i))
  124.     );_end repeat
  125.  
  126.     ;;according to the result ,draw the Minimum Area Rectangle
  127.     (setq edge (mapcar '- pti2 pti1))
  128.     (setq VecL (distance edge '(0.0 0.0)))
  129.     (setq NorH (abs (/ MinH VecL)))
  130.  
  131.     (setq Norm (list (- (cadr edge)) (car edge)))
  132.     (setq vj12 (mapcar '+ ptj1 Norm))
  133.     (setq vm12 (mapcar '+ ptm1 Norm))
  134.     (setq vecH (mapcar '* (list NorH NorH) Norm))
  135.  
  136.     (setq rec1 (inters pti1 pti2 ptj1 vj12 nil))
  137.     (setq rec4 (inters pti1 pti2 ptm1 vm12 nil))
  138.     (setq rec2 (mapcar '+ rec1 vecH))
  139.     (setq rec3 (mapcar '+ rec4 vecH))
  140.     (setq rect (list rec1 rec2 rec3 rec4))
  141.     (cons rect MinA)
  142.   );_end (MinAreaRectangle ptlist)
  143.  
  144.   (defun Graham-scan ( ptlist / hullpt maxXpt sortPt P Q )
  145.     (if (< (length ptlist) 3)
  146.       ptlist
  147.       (progn
  148.         (setq maxXpt (assoc (apply 'max (mapcar 'car ptlist)) ptlist))
  149.         (setq sortPt (sort-by-angle-distance ptlist maxXpt))
  150.         (setq hullPt (list (cadr sortPt) maxXpt))      
  151.         (foreach n (cddr sortPt)
  152.           (setq hullPt (cons n HullPt))
  153.           (setq P (cadr hullPt))
  154.           (setq Q (caddr hullPt))
  155.           (while (and q (> (det n P Q) -1e-6))
  156.             (setq hullPt (cons n (cddr hullPt)))
  157.             (setq P (cadr hullPt))
  158.             (setq Q (caddr hullPt))
  159.           )
  160.         )
  161.         (reverse hullpt)
  162.       )
  163.     )
  164.   )
  165.  
  166.   (defun sort-by-angle-distance ( ptlist pt )
  167.     (vl-sort ptlist
  168.       (function
  169.         (lambda ( e1 e2 / ang1 ang2 )
  170.           (setq ang1 (angle pt e1))
  171.           (setq ang2 (angle pt e2))
  172.           (if (= ang1 ang2)
  173.             (< (distance pt e1) (distance pt e2))
  174.             (< ang1 ang2)
  175.           )
  176.         )
  177.       )
  178.     )
  179.   )
  180.  
  181.   ;;;= x1*x2 + y1*y2
  182.   (defun DOTPR ( ix iy pts / pt1 pt2 )
  183.     (setq pt1 (car pts))
  184.     (setq pt2 (cadr pts))
  185.     (+ (* ix (- (car pt2) (car pt1)))
  186.        (* iy (- (cadr pt2) (cadr pt1)))
  187.     )
  188.   )
  189.  
  190.   ;;;= x1*y2 - x2*y1
  191.   (defun CROSSPR ( ix iy pts / pt1 pt2 )
  192.     (setq pt1 (car pts))
  193.     (setq pt2 (cadr pts))
  194.     (- (* ix (- (cadr pt2) (cadr pt1)))
  195.        (* iy (- (car pt2) (car pt1)))
  196.     )
  197.   )
  198.  
  199.   (defun det ( p1 p2 p3 / x2 y2 )
  200.     (setq x2 (car p2)
  201.           y2 (cadr p2)
  202.     )
  203.     (- (* (- x2 (car p3)) (- y2 (cadr p1)))
  204.        (* (- x2 (car p1)) (- y2 (cadr p3)))
  205.     )
  206.   )
  207.  
  208.  
  209.   (prompt "\nSelect 2 closed polygons - vertices must not touch each other...")
  210.   (setq ss (ssget "_:L" '((0 . "LWPOLYLINE") (-4 . "<AND") (-4 . "&") (70 . 1) (-4 . ">") (90 . 2) (-4 . "AND>") (-4 . "<NOT") (-4 . "<>") (42 . 0.0) (-4 . "NOT>"))))
  211.   (if (and ss (= (sslength ss) 2))
  212.     (progn
  213.       (setq lw1 (ssname ss 0))
  214.       (setq lw2 (ssname ss 1))
  215.       (setq pts1 (mapcar (function (lambda ( x ) (trans x lw1 1))) (mapcar 'cdr (vl-remove-if (function (lambda ( x ) (/= (car x) 10))) (entget lw1)))))
  216.       (setq pts2 (mapcar (function (lambda ( x ) (trans x lw2 1))) (mapcar 'cdr (vl-remove-if (function (lambda ( x ) (/= (car x) 10))) (entget lw2)))))
  217.       (setq ch1 (Graham-scan pts1))
  218.       (setq ch2 (Graham-scan pts2))
  219.       (cond
  220. ;|
  221.         ( (and (vl-every (function (lambda ( x ) (vl-position x ch1))) pts1) (vl-every (function (lambda ( x ) (vl-position x ch2))) pts2))
  222.           (setq minrec1 (minarearectangle ch1))
  223.           (setq minrec2 (minarearectangle ch2))
  224.           (setq d11 (distance (caar minrec1) (cadar minrec1)) d12 (distance (caar minrec1) (last (car minrec1))))
  225.           (setq d21 (distance (caar minrec2) (cadar minrec2)) d22 (distance (caar minrec2) (last (car minrec2))))
  226.           (if (> d11 d12)
  227.             (if (> d21 d22)
  228.               (command "_.ALIGN" lw2 "" "_non" (caar minrec2) "_non" (last (car minrec1)) "_non" (cadar minrec2) "_non" (caddr (car minrec1)) "" "_no")
  229.               (command "_.ALIGN" lw2 "" "_non" (last (car minrec2)) "_non" (last (car minrec1)) "_non" (caar minrec2) "_non" (caddr (car minrec1)) "" "_no")
  230.             )
  231.             (if (> d21 d22)
  232.               (command "_.ALIGN" lw2 "" "_non" (caar minrec2) "_non" (caddr (car minrec1)) "_non" (cadar minrec2) "_non" (cadr (car minrec1)) "" "_no")
  233.               (command "_.ALIGN" lw2 "" "_non" (last (car minrec2)) "_non" (caddr (car minrec1)) "_non" (caar minrec2) "_non" (cadr (car minrec1)) "" "_no")
  234.             )
  235.           )
  236.           (command "_.ROTATE" ss "" "_non" (caar minrec1) "_reference" "_non" (caar minrec1) "_non" (cadar minrec1) "_non" (mapcar '+ (caar minrec1) '(1.0 0.0)))
  237.           (setq rec (minarearectangle (Graham-scan (unique (append (mapcar (function (lambda ( x ) (trans x lw1 1))) (mapcar 'cdr (vl-remove-if (function (lambda ( x ) (/= (car x) 10))) (entget lw1)))) (mapcar (function (lambda ( x ) (trans x lw2 1))) (mapcar 'cdr (vl-remove-if (function (lambda ( x ) (/= (car x) 10))) (entget lw2)))))))))
  238.         )
  239. |;
  240.         ( t
  241.           (foreach edge1 (mapcar (function (lambda ( a b ) (list a b))) pts1 (cdr (reverse (cons (car pts1) (reverse pts1)))))
  242.             (foreach edge2 (mapcar (function (lambda ( a b ) (list a b))) pts2 (cdr (reverse (cons (car pts2) (reverse pts2)))))
  243.               (command "_.ALIGN" lw2 "" "_non" (car edge2) "_non" (car edge1) "_non" (cadr edge2) "_non" (cadr edge1) "" "_no")
  244.               (setq pts (vlax-invoke (vlax-ename->vla-object lw1) 'intersectwith (vlax-ename->vla-object lw2) acextendnone))
  245.               (repeat (/ (length pts) 3)
  246.                 (setq ips (cons (list (car pts) (cadr pts)) ips))
  247.                 (setq pts (cdddr pts))
  248.               )
  249.               (setq ips (mapcar (function (lambda ( x ) (trans x 0 1))) ips))
  250.               (setq ips (vl-remove-if (function (lambda ( x ) (equal x (car edge1) 1e-6))) ips) ips (vl-remove-if (function (lambda ( x ) (equal x (cadr edge1) 1e-6))) ips))
  251.               (setq ips (vl-remove-if (function (lambda ( x ) (equal (distance (car edge1) (cadr edge1)) (+ (distance (car edge1) x) (distance x (cadr edge1))) 1e-6))) ips))
  252.               (if (not ips)
  253.                 (if (not (vl-every (function (lambda ( x ) (vk_IsPointInside x (reverse (cons (car pts1) (reverse pts1)))))) (mapcar (function (lambda ( x ) (trans x lw2 1))) (mapcar 'cdr (vl-remove-if (function (lambda ( x ) (/= (car x) 10))) (entget lw2))))))
  254.                   (setq rtn (cons (list 1 edge1 edge2 (cdr (minarearectangle (Graham-scan (unique (append (mapcar (function (lambda ( x ) (trans x lw1 1))) (mapcar 'cdr (vl-remove-if (function (lambda ( x ) (/= (car x) 10))) (entget lw1)))) (mapcar (function (lambda ( x ) (trans x lw2 1))) (mapcar 'cdr (vl-remove-if (function (lambda ( x ) (/= (car x) 10))) (entget lw2)))))))))) rtn))
  255.                 )
  256.               )
  257.               (command "_.UNDO" "1")
  258.               (setq ips nil)
  259.               (command "_.ALIGN" lw2 "" "_non" (cadr edge2) "_non" (car edge1) "_non" (car edge2) "_non" (cadr edge1) "" "_no")
  260.               (setq pts (vlax-invoke (vlax-ename->vla-object lw1) 'intersectwith (vlax-ename->vla-object lw2) acextendnone))
  261.               (repeat (/ (length pts) 3)
  262.                 (setq ips (cons (list (car pts) (cadr pts)) ips))
  263.                 (setq pts (cdddr pts))
  264.               )
  265.               (setq ips (mapcar (function (lambda ( x ) (trans x 0 1))) ips))
  266.               (setq ips (vl-remove-if (function (lambda ( x ) (equal x (car edge1) 1e-6))) ips) ips (vl-remove-if (function (lambda ( x ) (equal x (cadr edge1) 1e-6))) ips))
  267.               (setq ips (vl-remove-if (function (lambda ( x ) (equal (distance (car edge1) (cadr edge1)) (+ (distance (car edge1) x) (distance x (cadr edge1))) 1e-6))) ips))
  268.               (if (not ips)
  269.                 (if (not (vl-every (function (lambda ( x ) (vk_IsPointInside x (reverse (cons (car pts1) (reverse pts1)))))) (mapcar (function (lambda ( x ) (trans x lw2 1))) (mapcar 'cdr (vl-remove-if (function (lambda ( x ) (/= (car x) 10))) (entget lw2))))))
  270.                   (setq rtn (cons (list 2 edge1 edge2 (cdr (minarearectangle (Graham-scan (unique (append (mapcar (function (lambda ( x ) (trans x lw1 1))) (mapcar 'cdr (vl-remove-if (function (lambda ( x ) (/= (car x) 10))) (entget lw1)))) (mapcar (function (lambda ( x ) (trans x lw2 1))) (mapcar 'cdr (vl-remove-if (function (lambda ( x ) (/= (car x) 10))) (entget lw2)))))))))) rtn))
  271.                 )
  272.               )
  273.               (command "_.UNDO" "1")
  274.               (setq ips nil)
  275.               (command "_.ALIGN" lw2 "" "_non" (car edge2) "_non" (cadr edge1) "_non" (cadr edge2) "_non" (car edge1) "" "_no")
  276.               (setq pts (vlax-invoke (vlax-ename->vla-object lw1) 'intersectwith (vlax-ename->vla-object lw2) acextendnone))
  277.               (repeat (/ (length pts) 3)
  278.                 (setq ips (cons (list (car pts) (cadr pts)) ips))
  279.                 (setq pts (cdddr pts))
  280.               )
  281.               (setq ips (mapcar (function (lambda ( x ) (trans x 0 1))) ips))
  282.               (setq ips (vl-remove-if (function (lambda ( x ) (equal x (car edge1) 1e-6))) ips) ips (vl-remove-if (function (lambda ( x ) (equal x (cadr edge1) 1e-6))) ips))
  283.               (setq ips (vl-remove-if (function (lambda ( x ) (equal (distance (car edge1) (cadr edge1)) (+ (distance (car edge1) x) (distance x (cadr edge1))) 1e-6))) ips))
  284.               (if (not ips)
  285.                 (if (not (vl-every (function (lambda ( x ) (vk_IsPointInside x (reverse (cons (car pts1) (reverse pts1)))))) (mapcar (function (lambda ( x ) (trans x lw2 1))) (mapcar 'cdr (vl-remove-if (function (lambda ( x ) (/= (car x) 10))) (entget lw2))))))
  286.                   (setq rtn (cons (list 3 edge1 edge2 (cdr (minarearectangle (Graham-scan (unique (append (mapcar (function (lambda ( x ) (trans x lw1 1))) (mapcar 'cdr (vl-remove-if (function (lambda ( x ) (/= (car x) 10))) (entget lw1)))) (mapcar (function (lambda ( x ) (trans x lw2 1))) (mapcar 'cdr (vl-remove-if (function (lambda ( x ) (/= (car x) 10))) (entget lw2)))))))))) rtn))
  287.                 )
  288.               )
  289.               (command "_.UNDO" "1")
  290.               (setq ips nil)
  291.               (command "_.ALIGN" lw2 "" "_non" (cadr edge2) "_non" (cadr edge1) "_non" (car edge2) "_non" (car edge1) "" "_no")
  292.               (setq pts (vlax-invoke (vlax-ename->vla-object lw1) 'intersectwith (vlax-ename->vla-object lw2) acextendnone))
  293.               (repeat (/ (length pts) 3)
  294.                 (setq ips (cons (list (car pts) (cadr pts)) ips))
  295.                 (setq pts (cdddr pts))
  296.               )
  297.               (setq ips (mapcar (function (lambda ( x ) (trans x 0 1))) ips))
  298.               (setq ips (vl-remove-if (function (lambda ( x ) (equal x (car edge1) 1e-6))) ips) ips (vl-remove-if (function (lambda ( x ) (equal x (cadr edge1) 1e-6))) ips))
  299.               (setq ips (vl-remove-if (function (lambda ( x ) (equal (distance (car edge1) (cadr edge1)) (+ (distance (car edge1) x) (distance x (cadr edge1))) 1e-6))) ips))
  300.               (if (not ips)
  301.                 (if (not (vl-every (function (lambda ( x ) (vk_IsPointInside x (reverse (cons (car pts1) (reverse pts1)))))) (mapcar (function (lambda ( x ) (trans x lw2 1))) (mapcar 'cdr (vl-remove-if (function (lambda ( x ) (/= (car x) 10))) (entget lw2))))))
  302.                   (setq rtn (cons (list 4 edge1 edge2 (cdr (minarearectangle (Graham-scan (unique (append (mapcar (function (lambda ( x ) (trans x lw1 1))) (mapcar 'cdr (vl-remove-if (function (lambda ( x ) (/= (car x) 10))) (entget lw1)))) (mapcar (function (lambda ( x ) (trans x lw2 1))) (mapcar 'cdr (vl-remove-if (function (lambda ( x ) (/= (car x) 10))) (entget lw2)))))))))) rtn))
  303.                 )
  304.               )
  305.               (command "_.UNDO" "1")
  306.               (setq ips nil)
  307.             )
  308.           )
  309.           (setq rtn (car (vl-sort rtn (function (lambda ( a b ) (< (cadddr a) (cadddr b)))))))
  310.           (cond
  311.             ( (= (car rtn) 1)
  312.               (command "_.ALIGN" lw2 "" "_non" (car (caddr rtn)) "_non" (car (cadr rtn)) "_non" (cadr (caddr rtn)) "_non" (cadr (cadr rtn)) "" "_no")
  313.             )
  314.             ( (= (car rtn) 2)
  315.               (command "_.ALIGN" lw2 "" "_non" (cadr (caddr rtn)) "_non" (car (cadr rtn)) "_non" (car (caddr rtn)) "_non" (cadr (cadr rtn)) "" "_no")
  316.             )
  317.             ( (= (car rtn) 3)
  318.               (command "_.ALIGN" lw2 "" "_non" (car (caddr rtn)) "_non" (cadr (cadr rtn)) "_non" (cadr (caddr rtn)) "_non" (car (cadr rtn)) "" "_no")
  319.             )
  320.             ( (= (car rtn) 4)
  321.               (command "_.ALIGN" lw2 "" "_non" (cadr (caddr rtn)) "_non" (cadr (cadr rtn)) "_non" (car (caddr rtn)) "_non" (car (cadr rtn)) "" "_no")
  322.             )
  323.           )
  324.           (setq rec (minarearectangle (Graham-scan (unique (append (mapcar (function (lambda ( x ) (trans x lw1 1))) (mapcar 'cdr (vl-remove-if (function (lambda ( x ) (/= (car x) 10))) (entget lw1)))) (mapcar (function (lambda ( x ) (trans x lw2 1))) (mapcar 'cdr (vl-remove-if (function (lambda ( x ) (/= (car x) 10))) (entget lw2)))))))))
  325.           (command "_.ROTATE" ss "" "_non" (caar rec) "_reference" "_non" (caar rec) "_non" (cadar rec) "_non" (mapcar '+ (caar rec) '(1.0 0.0)))
  326.           (setq rec (minarearectangle (Graham-scan (unique (append (mapcar (function (lambda ( x ) (trans x lw1 1))) (mapcar 'cdr (vl-remove-if (function (lambda ( x ) (/= (car x) 10))) (entget lw1)))) (mapcar (function (lambda ( x ) (trans x lw2 1))) (mapcar 'cdr (vl-remove-if (function (lambda ( x ) (/= (car x) 10))) (entget lw2)))))))))
  327.         )
  328.       )
  329.       (entmake
  330.         (list
  331.           '(0 . "LWPOLYLINE")
  332.           '(100 . "AcDbEntity")
  333.           '(100 . "AcDbPolyline")
  334.           '(90 . 4)
  335.           (cons 70 (if (= (getvar 'plinegen) 1) 129 1))
  336.           '(38 . 0.0)
  337.           (cons 10 (trans (caar rec) 1 0))
  338.           (cons 10 (trans (cadar rec) 1 0))
  339.           (cons 10 (trans (caddar rec) 1 0))
  340.           (cons 10 (trans (last (car rec)) 1 0))
  341.           '(210 0.0 0.0 1.0)
  342.           '(62 . 3)
  343.         )
  344.       )
  345.     )
  346.     (prompt "\nBad selection... Only 2 closed polygons required for selection... Retry routine again...")
  347.   )
  348.   (princ)
  349. )
  350.  

Regards, M.R.
« Last Edit: January 13, 2017, 04:29:32 PM by ribarm »
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

well20152016

  • Newt
  • Posts: 130
Re: Minimum rectangle
« Reply #8 on: January 12, 2017, 07:17:42 AM »
Ribar Marko, I admire you so much!
I learn from you, please enlighten me!

ribarm

  • Gator
  • Posts: 3225
  • Marko Ribar, architect
Re: Minimum rectangle
« Reply #9 on: January 12, 2017, 12:10:20 PM »
I've changed my previous post... Had some lacks and further more, if MIRROR is allowed then results can be even better... Check here attached LISP with attached DWG... Area of rectangle should be ab 400 DWG units... If used without MIRROR it gives back with previously posted code ab 408 units...

HTH., M.R.
« Last Edit: January 13, 2017, 04:30:20 PM by ribarm »
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

ribarm

  • Gator
  • Posts: 3225
  • Marko Ribar, architect
Re: Minimum rectangle
« Reply #10 on: January 13, 2017, 11:48:08 AM »
Here are my updates... Result is expected almost instantly - so I've speed up my both routines... Process is not visible, but the result should be the same as with slower versions... Bonus - Visual Lisp extensions aren't necessity... Kind regards, I hope you'll find it useful, M.R.
« Last Edit: January 13, 2017, 03:30:58 PM by ribarm »
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

well20152016

  • Newt
  • Posts: 130
Re: Minimum rectangle
« Reply #11 on: January 13, 2017, 11:32:10 PM »
Speed is really fast! Thank you

ribarm

  • Gator
  • Posts: 3225
  • Marko Ribar, architect
Re: Minimum rectangle
« Reply #12 on: January 14, 2017, 03:04:24 AM »
Hi well20152016... Now I did it and for multiple polygon nesting... Just had to use REGION command and few more, but original LWPOLYLINES should be unchanged - I think their properties - ENAMES - HANDLES... Also Visual Lisp extensions not necessity...

HTH., M.R.


« Last Edit: January 14, 2017, 01:03:09 PM by ribarm »
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

well20152016

  • Newt
  • Posts: 130
Re: Minimum rectangle
« Reply #13 on: January 14, 2017, 10:13:46 PM »
You're awesome。

well20152016

  • Newt
  • Posts: 130
Re: Minimum rectangle
« Reply #14 on: January 16, 2017, 09:53:32 PM »
Code - Auto/Visual Lisp: [Select]
  1.     (while (entnext el)
  2.       (setq el (entnext el))
  3.     )
  4.     (command "_.REGION" lw1 lw2 "")
  5.     (setq s (ssadd))
  6.     (while (setq el (entnext el))
  7.       (ssadd el s)
  8.     )
  9.     (command "_.UNION" s "")
  10.     (setq r (entlast))
  11.     (command "_.EXPLODE" r)
  12.     (command "_.PEDIT" "_M" (ssget "_P") "" "_J" "_J" "_E" 0.0 "")
  13.     (setq r (entlast))
  14.     (setq pts1 (mapcar (function (lambda ( x ) (trans x r 1))) (mapcar 'cdr (vl-remove-if (function (lambda ( x ) (/= (car x) 10))) (entget r)))))
  15.  


Sometimes this problem?

Is it possible to use PTS1 and PTS2 to calculate the combined boundary! This speed is a little faster!
« Last Edit: January 16, 2017, 09:59:28 PM by well20152016 »