Topic: -={Challenge}=- Math: Area, Scale, Points

[Grrr1337]

Hey guys,
Haven't been posting for a while, hopefully you're doin alright in 2021. 

Given a point list (closed one) -
 

Code: [Select]

((19.1947 9.72373) (24.7985 9.19778) (28.0063 11.2198) (30.008 9.06602) (30.4813 4.20126)
  (26.3245 6.77841) (23.8251 2.83379) (21.0363 4.8061) (17.2611 5.1875) (14.3538 10.5915)) ; example given list

which could be represend by a closed LWpolyline with straight segments
(although we don't actually have any ACAD geometry to work with, but rather whatever closed shape).

The questions are:

• How we could get the area via math?

Code: [Select]

(getPointListArea <PointList>); returns the area
• On a given base-point / say the shape's centroid or points-bbox centroid or '(0 0 0) / whatever-point
  and on a given area as an input,
  How we could translate these points in order to match the original shape and the desired area? (math)
  /sounds like offset, but its actually scale/

Code: [Select]

(SetPointListArea <PointList> <BasePoint> <DesiredArea>); returns the translated PointList coordinates
Like imagine this LWpolyline with the certain area, where its scaled by reference by its area so it results for instance 10% larger or smaller.
But like I said we don't deal with such, its just math. (although for testing result purposes its allowed to entmake a lwpoly)

BTW I don't expect much answers so I consider it as a challenge.

[gile]

Hi,

I do not have so much time to play, but here's a way to solve the first task.

Code - Auto/Visual Lisp: [Select]

1. ;; triangleArea
2. ;; Returns the algebraic (signed) area of the triangle defined by three 2d points
3. ;; the area is negative if points are clockwise
4. (defun triangleArea (p1 p2 p3)
5.   (/ (- (* (- (car p2) (car p1))
6.            (- (cadr p3) (cadr p1))
7.         )
8.         (* (- (car p3) (car p1))
9.            (- (cadr p2) (cadr p1))
10.         )
11.      )
12.      2.0
13.   )
14. )
15.  
16. ;; polygonArea
17. ;; Returns the algebraic (signed) area of the polygon defined by a list of points
18. ;; the area is negative if points are clockwise
19. (defun polygonArea (pts / loop)
20.   (defun loop (pt area pts)
21.     (if (cdr pts)
22.       (loop pt (+ area (triangleArea pt (car pts) (cadr pts))) (cdr pts))
23.       area
24.     )
25.   )
26.   (loop (car pts) 0 (cdr pts))
27. )

(defun getPointListArea (pointList) (abs polygonArea))

[BIGAL]

There is a mathematical formula for the area of points, using just points.

Maybe https://www.mathopenref.com/coordpolygonarea.html

[VovKa]

Code: [Select]

(defun vk_GetSignedArea (CoordsList)
  (/ (apply '+
    (mapcar (function (lambda (p1 p2) (* (+ (car p1) (car p2)) (- (cadr p1) (cadr p2)))))
    CoordsList
    (cons (last CoordsList) CoordsList)
    )
     )
     2.0
  )
)
(defun vk_GetArea (CoordsList) (abs (vk_GetSignedArea CoordsList)))
(defun vk_ScaleCoordsList (lst p0 s)
  (mapcar (function (lambda (p) (polar p0 (angle p0 p) (* (distance p0 p) s)))) lst)
)
(defun vk_ScaleCoordsListArea (lst p0 a /)
  (vk_ScaleCoordsList lst p0 (sqrt (/ a (vk_GetArea lst))))
)


[Grrr1337]

Hi,

I do not have so much time to play, but here's a way to solve the first task.

Code - Auto/Visual Lisp: [Select]

1. ;; triangleArea
2.  
3. ;; polygonArea
4.  

Hi, Gile
I remember such function existed somewhere on the internet, but forgot who the author was.
As a math dummy I'm impressed of your solution..

Back at the time when I was attending geodesy class in my university, we were taught of finding the area of any shape via floodfill algorithm:
• define MxN square-grid ontop of the shape,
• sum the area of all the squares inside the shape
• the squares which are intersecting the boundary of
  the shape were forming trapezoid or triangle region from the inner side, so their total area is added-up aswell

But I think that your approach is faster and more accurate.

There is a mathematical formula for the area of points, using just points.

Maybe https://www.mathopenref.com/coordpolygonarea.html

Thanks BIGAL,
trouble is that I suck at translating math algorithms as program languages,
and I've used my first question to be the base for my second one - which is the real challenge.

Code: [Select]

(defun vk_GetSignedArea (CoordsList)
  ; ...
)
(defun vk_GetArea (CoordsList)
  ; ...
)
(defun vk_ScaleCoordsList (lst p0 s)
  ; ...
)
(defun vk_ScaleCoordsListArea (lst p0 a /)
  ; ...
)


Holy s... VovKa,
You've won the challenge!

Performed a basic testing by incrementing an area, and checking if the pointlist's centroid is retained -
Everything works correctly. 

Code - Auto/Visual Lisp: [Select]

1. (test) ; test function
2. ;| sample print-return (which is correct):
3. (181.798 95.1695) 15179.3 15179.3)
4. (181.798 95.1695) 15679.3 15679.3)
5. (181.798 95.1695) 16179.3 16179.3)
6. (181.798 95.1695) 16679.3 16679.3)
7. (181.798 95.1695) 17179.3 17179.3)
8. |;
9. (defun test ( / pL pc ar i e npL )
10.   (setq pL (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= 10 (car x))) (entget (car (entsel "\nPick a LWpoly:"))))))
11.   (setq pc (PolyCentroid pL))
12.   (setq ar (vk_GetArea pL))
13.   (setq i 500) ; area increment
14.   (repeat 5
15.     (vlax-curve-getArea
16.       (setq e (LWPoly (setq npL (vk_ScaleCoordsListArea pL pc (setq ar (+ ar i)))) 1))
17.     )
18.     (print (list (PolyCentroid npL) (vk_GetArea npL) (vlax-curve-getArea e))) ; check that the base-point is retained and the area matches
19.   )
20. ); defun
21.  
22.  
23. (defun LWPoly (lst cls)
24.   (entmakex
25.     (append
26.       (list
27.         (cons 0 "LWPOLYLINE")
28.         (cons 100 "AcDbEntity")
29.         (cons 100 "AcDbPolyline")
30.         (cons 90 (length lst))
31.         (cons 70 cls)
32.       )
33.       (mapcar (function (lambda (p) (cons 10 p))) lst)
34.     )
35.   )
36. )
37.  
38.  
39. (defun PolyCentroid ( l ) ; Lee Mac (modified it a bit)
40.  
41.   (
42.     (lambda ( a )
43.       (if (not (equal 0.0 a 1e-8))
44.        
45.         (mapcar '/
46.           (apply 'mapcar
47.             (cons '+
48.               (mapcar
49.                 (function
50.                   (lambda ( a b )
51.                     (
52.                       (lambda ( m )
53.                         (mapcar
54.                           (function
55.                             (lambda ( c d ) (* (+ c d) m))
56.                           )
57.                           a b
58.                         )
59.                       )
60.                       (- (* (car a) (cadr b)) (* (car b) (cadr a)))
61.                     )
62.                   )
63.                 )
64.                 l (cons (last l) l)
65.               )
66.             )
67.           )
68.           (list a a)
69.         )
70.        
71.       )
72.     )
73.     (* 3.0
74.       (apply '+
75.         (mapcar
76.           (function
77.             (lambda ( a b )
78.               (- (* (car a) (cadr b)) (* (car b) (cadr a)))
79.             )
80.           )
81.           l (cons (last l) l)
82.         )
83.       )
84.     )
85.   )
86. )

[VovKa]

You've won the challenge!

being the only participant is cool

[Grrr1337]

You've won the challenge!

being the only participant is cool

I'm not used to post challenges quite often, but isn't the criteria for a winner to be:
• first one who did it
• no flaws in the returns/algorithm
• don't think that your subs can be shortened or simplified more than that

Still this thread is open for alternative solutions or suggestions, like I know that LM is able to scale a point list using matrix transformations -

Code: [Select]

(LM:ScaleByMatrix (Vertices e) (trans p 1 0) s) (cdr (assoc 70 (entget e)))
 

[BIGAL]

Challenge accepted. Compare pline area from properties.

Code: [Select]

; https://www.mathopenref.com/coordpolygonarea.html

; (x1y2-y1x2)+(x2y3-x3y2)+...all / 2

(defun c:parea ( / ent x lst)
(setq ent (entsel "\npick pline "))

(setq lst (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget (car ent)))))
(setq lst (reverse lst))
(setq lst (cons (last lst) lst))

(setq x 0 tot 0.0)

(repeat (- (length lst) 1)
  (setq xy (- (* (car (nth x lst))(cadr (nth (+ x 1) lst))) (* (car (nth (+ x 1) lst))(cadr (nth x lst)))))
  (setq tot (+ tot xy))
  (setq x (+ x 1))
)

(setq tot (abs (/ tot 2.0)))

(alert (strcat "Area is " (rtos tot 2 3)))

(princ)
)