I'm trying to work on a program for this version:
https://d3plus.org/blog/behind-the-scenes/2014/07/08/largest-rect/
Pros:
- works on concave & convex shapes
Cons:
- relatively slower than convex methods
- approximate, can not guarantee 100% largest shape (but will be close)
- would not work with curves/arcs (I cannot personally code such a masterpiece, but let's start small then improve)
I am limited on time right now, but if anybody gets bored we can create some sub-functions together..
I'm in the meat & potatoes of it right now, So take a look, and given my Input parameters of the "RIPL_CreateCorners" function, I will need help creating something similar to this workflow:
(foreach angle angles
(foreach iPoint iPoints
{determine perpendicular lines @ iPoint, length, points of intersection on polyline}
{create 2 mid points, 1 for each perpendicular line}
(foreach aspectRatio aspectRatios
{test if fits, ignore areas smaller than max area so far}
{compare to max area so far, save if largest and fits}
);foreach
);foreach
);foreach
Here's my current progress. (note that If you were to load this and select a polyline, I have the program create a polyline showing all of my currently calculated inner Points (iPoints).
My goal is to have the "RIPL_CreateCorners" function return the 4 corners of the largest area rectangle (in clockwise order), that seems more useful to me than returning an entity, since not everybody would want to draw an entity, but rather analyze the height/width/area/etc.
I know it may be a lot to absorb, but if you get bored, check out the link and create a quick sub function.
(defun RIPL_LWPoly (lst cls)
(entmakex (append (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline")
(cons 90 (length lst)) (cons 70 cls))
(mapcar (function (lambda (p) (cons 10 p))) lst)))
);defun
(defun LM:Collinear-p (p1 p2 p3)
;by Lee Mac: http://lee-mac.com/mathematicalfunctions.html#geometric
(
(lambda ( a b c )
(or
(equal (+ a b) c 1e-8)
(equal (+ b c) a 1e-8)
(equal (+ c a) b 1e-8)
)
)
(distance p1 p2) (distance p2 p3) (distance p1 p3)
)
);defun
(defun RIPL_PointIsInside (Point PointsList / PY P1Y P2Y)
;from user VovKa @ https://www.cadtutor.net/forum/topic/13233-identify-a-polyline-by-a-point-inside-this-polyline/?do=findComment&comment=110307
;works with polygons only, i.e. if (equal (car PointsList) (last PointsList))
(if (cdr PointsList)
(/= (and (or (and (<= (setq PY (cadr Point)
P2Y (cadadr PointsList)
P1Y (cadar PointsList)
);setq
PY
);<=
(< PY P2Y)
);and
(and (> P1Y PY) (>= PY P2Y))
);or
(> (car Point)
(+ (* (/ (- PY P1Y) (- P2Y P1Y))
(- (caadr PointsList) (caar PointsList))
);*
(caar PointsList)
);+
);>
);and
(RIPL_PointIsInside Point (cdr PointsList))
);/=
);if
);defun
(defun RIPL_CreateInternalPoints (verts / pts p1 p2 iPoints)
(setq pts (cdr verts))
(repeat (length pts)
(setq p1 (car pts) pts (cdr pts))
(foreach pt pts
(setq p2 (polar p1 (angle p1 pt) (* 0.5 (distance p1 pt))))
(if (and (RIPL_PointIsInside p2 verts)
(not (LM:Collinear-p p1 p2 (car pts))))
(setq iPoints (cons p2 iPoints))
);if
);foreach
);repeat
iPoints
);defun
(defun RIPL_CreateCorners (verts iPoints angIncr aspMax aspIncr / corners tmp aspRat areaMax areaCur)
;create aspect ratios
(setq aspRat '(1) tmp 1.0)
(while (<= (setq tmp (+ tmp aspIncr)) aspMax) (setq aR (cons tmp aR)))
(setq aR (reverse aR))
(setq ang 0.0 areaMax 0.0)
;DO WORK HERE
corners
);defun
(defun RIPL (e / corners g2g tmp eg verts iPoints angIncr aspMax aspIncr)
;Rectangle In Polygon (Largest, by area) (approximate)
;e - ename, of 2D polyline.
;returns - list or nil, list of 4 rectangle corners (in clockwise order) if found.
;initial checks
(setq g2g t)
(cond
((not (eq 'ENAME (setq tmp (type e))))
(setq g2g nil) (prompt "\nRIPL Error: Bad argument type: ENAME ") (princ tmp))
((not (eq "LWPOLYLINE" (setq tmp (cdr (assoc 0 (setq eg (entget e)))))))
(setq g2g nil) (prompt (strcat "\nRIPL Error: Bad entity type: LWPOLYLINE " tmp)))
((zerop (logand 1 (cdr (assoc 70 eg))))
(setq g2g nil) (prompt "\nRIPL Error: Polyline not closed."))
);cond
;begin work
(if g2g
(progn
;get vertices
(foreach x eg (if (= 10 (car x)) (setq verts (cons (cdr x) verts))))
(setq verts (reverse (cons (last verts) verts)))
;calculate internal points
(setq iPoints (RIPL_CreateInternalPoints verts))
;create polyline showing internal points
(RIPL_LWPoly iPoints 1)
;set variables for accuracy / efficiency
(setq angIncr 1.0
aspMax 15
aspIncr 0.5
);setq
;create rectangles, return corners
(setq corners (RIPL_CreateCorners verts iPoints angIncr aspMax aspIncr))
);progn
);if
;return
corners
);defun
(defun c:RIPL ( / e corners)
(if (and (setq e (car (entsel "\nSelect 2D Polyline: ")))
(setq corners (RIPL e)))
(prompt "\nDraw Something");(RIPL_LWPoly corners 1)
);if
(princ)
);defun
Best,
~DD
