(defun c:2polygonsnest
( / vk_IsPointInside unique minarearectangle graham
-scan sort
-by
-angle
-distance dotpr crosspr det
ss lw1 lw2 pts1 pts2 ch1 ch2 minrec1 minrec2 d11 d12 d21 d22
pts ips rtn rec
)
(defun vk_IsPointInside
( Point PointsList
/ PY P1Y P2Y
) ; works with polygons only, i.e. if (equal (car PointsList) (last PointsList))
)
PY
)
(< PY P2Y)
)
(and (> P1Y PY
) (>= PY P2Y
)) )
(+ (* (/ (- PY P1Y) (- P2Y P1Y))
)
)
)
)
(vk_IsPointInside Point
(cdr PointsList
)) )
)
)
)
)
;;;=======================================================
;;;Function : Find the minimum area of encasing rectangle.
;;;Arguments : A CCW HULL
;;;Return: The Four points of Rectangle and its Area
;;;=======================================================
(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
) (setq minA INF
) ;Initiating the Minimum is infinite (setq pti0
(car ptlist
)) ;the first point of Hull. (setq pts1
(append ptlist
(list pti0
))) ;add the first point at back of Hull
;;Find area of encasing rectangle anchored on each edge.
ix (- i2x i1x)
iy (- i2y i1y)
)
;;Find a vertex on on first perpendicular line of support
(while (> (DOTPR ix iy pts2
) 0.0) )
;;Find a vertex on second perpendicular line of support
)
(while (> (CROSSPR ix iy pts3
) 0.0) )
;;Find a vertex on second perpendicular line of support
)
(while (< (DOTPR ix iy pts4
) 0.0) )
;;Find distances between parallel and perpendicular lines of support
)
)
)
)
(T
)
)
;;Compute area of encasing rectangle anchored on current edge.
;;if the area is smaller than the old Minimum area, then update, and record the width, height and five points.
MinH d1
MinW d2
pti1 pi1
pti2 pi2
)
)
);_end repeat
;;according to the result ,draw the Minimum Area Rectangle
);_end (MinAreaRectangle ptlist)
(defun Graham
-scan
( ptlist
/ hullpt maxXpt sortPt P Q
) ptlist
)
)
)
)
)
(< ang1 ang2)
)
)
)
)
)
;;;= x1*x2 + y1*y2
(defun DOTPR
( ix iy pts
/ pt1 pt2
) (+ (* ix
(- (car pt2
) (car pt1
))) )
)
;;;= x1*y2 - x2*y1
(defun CROSSPR
( ix iy pts
/ pt1 pt2
) (* iy
(- (car pt2
) (car pt1
))) )
)
(defun det
( p1 p2 p3
/ x2 y2
) )
(- (* (- x2
(car p3
)) (- y2
(cadr p1
))) (* (- x2
(car p1
)) (- y2
(cadr p3
))) )
)
(prompt "\nSelect 2 closed polygons - vertices must not touch each other...") (setq ss
(ssget "_:L" '
((0 .
"LWPOLYLINE") (-4 .
"<AND") (-4 .
"&") (70 .
1) (-4 .
">") (90 .
2) (-4 .
"AND>") (-4 .
"<NOT") (-4 .
"<>") (42 .
0.0) (-4 .
"NOT>")))) (setq ch1
(Graham
-scan pts1
)) (setq ch2
(Graham
-scan pts2
)) ;|
( (and (vl-every (function (lambda ( x ) (vl-position x ch1))) pts1) (vl-every (function (lambda ( x ) (vl-position x ch2))) pts2))
(setq minrec1 (minarearectangle ch1))
(setq minrec2 (minarearectangle ch2))
(setq d11 (distance (caar minrec1) (cadar minrec1)) d12 (distance (caar minrec1) (last (car minrec1))))
(setq d21 (distance (caar minrec2) (cadar minrec2)) d22 (distance (caar minrec2) (last (car minrec2))))
(if (> d11 d12)
(if (> d21 d22)
(command "_.ALIGN" lw2 "" "_non" (caar minrec2) "_non" (last (car minrec1)) "_non" (cadar minrec2) "_non" (caddr (car minrec1)) "" "_no")
(command "_.ALIGN" lw2 "" "_non" (last (car minrec2)) "_non" (last (car minrec1)) "_non" (caar minrec2) "_non" (caddr (car minrec1)) "" "_no")
)
(if (> d21 d22)
(command "_.ALIGN" lw2 "" "_non" (caar minrec2) "_non" (caddr (car minrec1)) "_non" (cadar minrec2) "_non" (cadr (car minrec1)) "" "_no")
(command "_.ALIGN" lw2 "" "_non" (last (car minrec2)) "_non" (caddr (car minrec1)) "_non" (caar minrec2) "_non" (cadr (car minrec1)) "" "_no")
)
)
(command "_.ROTATE" ss "" "_non" (caar minrec1) "_reference" "_non" (caar minrec1) "_non" (cadar minrec1) "_non" (mapcar '+ (caar minrec1) '(1.0 0.0)))
(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)))))))))
)
|;
( t
(command "_.ALIGN" lw2
"" "_non" (car edge2
) "_non" (car edge1
) "_non" (cadr edge2
) "_non" (cadr edge1
) "" "_no") )
)
)
(command "_.ALIGN" lw2
"" "_non" (cadr edge2
) "_non" (car edge1
) "_non" (car edge2
) "_non" (cadr edge1
) "" "_no") )
)
)
(command "_.ALIGN" lw2
"" "_non" (car edge2
) "_non" (cadr edge1
) "_non" (cadr edge2
) "_non" (car edge1
) "" "_no") )
)
)
(command "_.ALIGN" lw2
"" "_non" (cadr edge2
) "_non" (cadr edge1
) "_non" (car edge2
) "_non" (car edge1
) "" "_no") )
)
)
)
)
)
)
)
)
)
)
)
'(0 . "LWPOLYLINE")
'(100 . "AcDbEntity")
'(100 . "AcDbPolyline")
'(90 . 4)
'(38 . 0.0)
'(210 0.0 0.0 1.0)
'(62 . 3)
)
)
)
(prompt "\nBad selection... Only 2 closed polygons required for selection... Retry routine again...") )
)