# TheSwamp

## Code Red => AutoLISP (Vanilla / Visual) => Topic started by: chlh_jd on March 12, 2011, 12:07:59 PM

Title: [Challenge] Point set inscribed the max area triangle
Post by: chlh_jd on March 12, 2011, 12:07:59 PM
There's no require unless the title .
And here's your pretty codes ...
Title: Re: [Challenge] Point set inscribed the max area triangle
Post by: chlh_jd on March 14, 2011, 01:13:37 AM
here's picture to express
Title: Re: [Challenge] Point set inscribed the max area triangle
Post by: pkohut on March 14, 2011, 01:54:31 AM
Problem needs a clear definition. The example picture doesn't help convey that.
Title: Re: [Challenge] Point set inscribed the max area triangle
Post by: Kerry on March 14, 2011, 04:00:38 AM
agreed Paul.
Looks to me like a MINIMUM triangle inside a collection of entities ??
... or perhaps not  :|
Title: Re: [Challenge] Point set inscribed the max area triangle
Post by: SOFITO_SOFT on March 14, 2011, 07:04:51 AM
Hello swamp people:
The problem is so?:
Find the 3 points of a given set that form the largest triangle not containing any point?
Is the good question ?
This may be related to the algorithms of Delaunay?
Regards... :-)
Title: Re: [Challenge] Point set inscribed the max area triangle
Post by: SOFITO_SOFT on March 14, 2011, 08:22:24 AM
Hello :
(http://img853.imageshack.us/img853/7158/triangulomayor.gif) (http://img853.imageshack.us/i/triangulomayor.gif/)
Could this be the solution to this problem?
I have a very ugly code  (brute force) , but if you want I'll post it.
Regards.  :-)
Title: Re: [Challenge] Point set inscribed the max area triangle
Post by: CAB on March 14, 2011, 09:28:58 AM
Yes, that would be my guess too.
Quote
Find the 3 points of a given set that form the largest triangle not containing any point?

Pseudo Code
Iterate all points, comparing by 3 to get triangle
Test for size & if it is free of points inside
Title: Re: [Challenge] Point set inscribed the max area triangle
Post by: alanjt on March 14, 2011, 10:38:59 AM
Like this?
(http://www.theswamp.org/screens/alanjt/largesttriangle.gif)

Clunky and probably really slow...

Code: [Select]
`(defun c:Test (/ AT:TriangleArea _toList _lwpline _uTrans pointlist trianglelist triangle)  (defun AT:TriangleArea (a b c)    ;; Returns area of three provided points    ;; If returned value is negative, last point (c) exists on right side of a-b vector    ;; Alan J. Thompson, 06.09.10    (/ (- (* (- (car b) (car a)) (- (cadr c) (cadr a)))          (* (- (cadr b) (cadr a)) (- (car c) (car a)))       )       2.    )  )  (defun _toList (ss / i l)    (if (and (eq (type ss) 'PICKSET) (> (sslength ss) 2))      (repeat (setq i (sslength ss))        (setq l (cons (cdr (assoc 10 (entget (ssname ss (setq i (1- i)))))) l))      )    )  )  (defun _lwpline (lst)    (if (> (length lst) 1)      (entmakex (append                  (list '(0 . "LWPOLYLINE")                        '(100 . "AcDbEntity")                        '(100 . "AcDbPolyline")                        (cons 90 (length lst))                        '(70 . 1)                  )                  (mapcar (function (lambda (p) (list 10 (car p) (cadr p)))) lst)                )      )    )  )  (defun _uTrans (p) (trans p 0 1))  (foreach a (setq pointlist (_toList (ssget '((0 . "POINT")))))    (mapcar (function              (lambda (b c)                (if (not (ssget "_WP" (mapcar (function _uTrans) (list a b c))))                  (setq trianglelist (cons (list (abs (AT:TriangleArea a b c)) a b c) trianglelist))                )              )            )            (cdr pointlist)            (cddr pointlist)    )  )  (_lwpline (cdr (car (vl-sort trianglelist (function (lambda (a b) (> (car a) (car b))))))))  (princ))`
Title: Re: [Challenge] Point set inscribed the max area triangle
Post by: chlh_jd on March 14, 2011, 12:11:46 PM
Sorry to ALL , my English would be too less yet , I think I must go abored to the English countary to inprove my simple Einglish .
Thanks SOFITO_SOFT a lot !
and thank Alan , I'll try your codes .
Title: Re: [Challenge] Point set inscribed the max area triangle
Post by: chlh_jd on March 14, 2011, 12:25:38 PM
Hi Alan , I mean that the points can be on the triangle , but not be in it .
Perhaps the 'ssget fun error , it take a not correct result ;
Title: Re: [Challenge] Point set inscribed the max area triangle
Post by: SOFITO_SOFT on March 15, 2011, 12:20:44 AM
My solution for the new exemple:
3 Points in corners but none inside or in border:
(http://img861.imageshack.us/img861/8687/triangulomayor2.gif) (http://img861.imageshack.us/i/triangulomayor2.gif/)
Regards.  :-)
Title: Re: [Challenge] Point set inscribed the max area triangle
Post by: ElpanovEvgeniy on March 15, 2011, 09:33:58 AM
my version:
Code: [Select]
`(defun c:test (/ A1 A2 L LST S) (defun ins (l p)  ;; check is a point inside the triangle.  ;; by ElpanovEvgeniy  (not (if (< (sin (- (angle (last l) p) (angle (last l) (car l)))) -1e-14)        (vl-every (function (lambda (a b) (< (sin (- (angle a p) (angle a b))) -1e-14)))                  l                  (cdr l)        )        (vl-every (function (lambda (a b) (> (sin (- (angle a p) (angle a b))) 1e-14)))                  l                  (cdr l)        )       )  ) ) (defun area_geron (p1 p2 p3 / l p)  ;; area triangle  ;; Uses the formula of Heron  (setq l (cons 0 (mapcar (function distance) (list p1 p2 p3) (list p2 p3 p1)))        p (/ (apply (function +) l) 2.)  )  (sqrt (abs (apply (function *) (mapcar (function -) l (list p p p p))))) ) (if (setq a1 0           s  (ssget "_x" '((0 . "point")))     )  (foreach a (setq lst (mapcar (function (lambda (a) (cdr (assoc 10 (entget (cadr a))))))                               (ssnamex s)                       )             )   (foreach b lst    (foreach c lst     (if (and (> (setq a2 (area_geron a b c)) a1)              (vl-every (function (lambda (p) (ins (list a b c) p))) lst)         )      (setq a1 a2            l  (list a b c)      )     )    )   )  ) ) (entmakex  (append   '((0 . "LWPOLYLINE") (100 . "AcDbEntity") (100 . "AcDbPolyline") (90 . 3) (70 . 1))   (mapcar (function (lambda (a) (cons 10 a))) l)  ) ) (princ))`
Title: Re: [Challenge] Point set inscribed the max area triangle
Post by: chlh_jd on March 16, 2011, 01:02:08 AM
hi , SOFITO_SOFT , I didn't see your picture ...
hi, Evgeniy , yours run fast , but not often a corret result ,see the picture : red is corret , yellow is yours result
tested in the new dwg
Title: Re: [Challenge] Point set inscribed the max area triangle
Post by: ElpanovEvgeniy on March 16, 2011, 01:19:19 AM
hi, Evgeniy , yours run fast , but not often a corret result ,see the picture : red is corret , yellow is yours result
tested in the new dwg

This is easily solved in the code in my checks, are not allowed a point lying on the sides of the triangle.
Title: Re: [Challenge] Point set inscribed the max area triangle
Post by: ElpanovEvgeniy on March 16, 2011, 01:27:02 AM
new version:
Code: [Select]
`(defun c:t1 (/ A1 A2 L LST S) (defun ins (l p)  ;; check is a point inside the triangle.  ;; by ElpanovEvgeniy  (not (if (< (sin (- (angle (last l) p) (angle (last l) (car l)))) -1e-6)        (vl-every (function (lambda (a b) (< (sin (- (angle a p) (angle a b))) -1e-6)))                  l                  (cdr l)        )        (vl-every (function (lambda (a b) (> (sin (- (angle a p) (angle a b))) 1e-6)))                  l                  (cdr l)        )       )  ) ) (defun area_geron (p1 p2 p3 / l p)  ;; area triangle  ;; Uses the formula of Heron  (setq l (cons 0 (mapcar (function distance) (list p1 p2 p3) (list p2 p3 p1)))        p (/ (apply (function +) l) 2.)  )  (sqrt (abs (apply (function *) (mapcar (function -) l (list p p p p))))) ) (if (setq a1 0           s  (ssget "_x" '((0 . "point")))     )  (foreach a (setq lst (mapcar (function (lambda (a) (cdr (assoc 10 (entget (cadr a))))))                               (ssnamex s)                       )             )   (foreach b lst    (foreach c lst     (if (and (> (setq a2 (area_geron a b c)) a1)              (vl-every (function (lambda (p) (ins (list a b c) p))) lst)         )      (setq a1 a2            l  (list a b c)      )     )    )   )  ) ) (entmakex  (append   '((0 . "LWPOLYLINE") (100 . "AcDbEntity") (100 . "AcDbPolyline") (90 . 3) (70 . 1))   (mapcar (function (lambda (a) (cons 10 a))) l)  ) ) (princ))`
Title: Re: [Challenge] Point set inscribed the max area triangle
Post by: chlh_jd on March 16, 2011, 07:19:59 AM
hi , all
hi , Evgeniy
about pt in or at the triangle , I tested result is

use cal number of intersections method is the fastest , is it a wrong test ?
Code: [Select]
`(defun EE:pitp (p l)  ;; check is a point inside the triangle.  ;; by ElpanovEvgeniy  (if (< (sin (- (angle (last l) p) (angle (last l) (car l)))) -1e-6      )    (vl-every      (function (lambda (a b) (< (sin (- (angle a p) (angle a b))) -1e-6))      )      l      (cdr l)    )    (vl-every      (function (lambda (a b) (> (sin (- (angle a p) (angle a b))) 1e-6))      )      l      (cdr l)    )  ));;;number of intersection;;;fastest(defun ss-pitp (p l)  ;;check point inside triangle .  ;;by GSLS(SS)  ((lambda (a b c)     (eq (+ (length (inters p a b c nil))    (length (inters p b a c nil))    (length (inters p c a b nil)) ) 9     )   )    (car l)    (cadr l)    (caddr l)  ));;;with the same direction method(defun ss-pitp0 (p l / foo)  ;;check point inside triangle .  ;;by GSLS(SS)  (defun foo (a b c p / ac ab ap)    (setq ac (mapcar '- c a)   ab (mapcar '- b a)   ap (mapcar '- p a)    )    (>= (vxv (v^v ab ac) (v^v ab ap)) 0.0)  )  ((lambda (a b c)     (and (foo a b c p) (foo b c a p) (foo c a b p))   )    (car l)    (cadr l)    (caddr l)  )  );;;with the same direction method;;;by trans(defun ss-pitp1 (p l)  ;;check point inside triangle .  ;;by GSLS(SS)  ((lambda (a b c)     (and (<= (* (car (trans (mapcar '- p a) 0 (mapcar '- b a)))        (car (trans (mapcar '- p a) 0 (mapcar '- c a)))     )     0 ) (<= (* (car (trans (mapcar '- p b) 0 (mapcar '- a b)))        (car (trans (mapcar '- p b) 0 (mapcar '- c b)))     )     0 )     )   )    (car l)    (cadr l)    (caddr l)  ))`
Title: Re: [Challenge] Point set inscribed the max area triangle
Post by: chlh_jd on March 16, 2011, 07:22:21 AM
forget func .
Code: [Select]
`;;; gile;;; vxv returns the dot product of 2 vectors;;; dot product(defun vxv (v1 v2)  (apply    '+    (mapcar      '*      v1      v2    )  ));;; gile ;;; cross product (defun v^v (v1 v2)  (list (- (* (cadr v1) (caddr v2)) (* (caddr v1) (cadr v2))) (- (* (caddr v1) (car v2)) (* (car v1) (caddr v2))) (- (* (car v1) (cadr v2)) (* (cadr v1) (car v2)))  )  )`
Title: Re: [Challenge] Point set inscribed the max area triangle
Post by: chlh_jd on March 16, 2011, 08:38:48 AM
to cal area of triangle ,
Uses conventional formula, but slower than Heron Formula.
is it no compile reason or the codes written to bad ?
Code: [Select]
`(defun ss-aat (p1 p2 p3)  ;;area triangle  ;;Uses conventional formula, but slower than Heron Formula.  (* 0.5     (sqrt       (apply (function +)      (mapcar (function (lambda (a b c)  (expt (- (+     (* (car a) (cadr b))     (* (car b) (cadr c))     (* (car c) (cadr a))   )   (+     (* (car a) (cadr c))     (* (car b) (cadr a))     (* (car c) (cadr b))   ) ) 2.  ) )      )      (list p1 (cdr p1) (list (caddr p1) (car p1)))      (list p2 (cdr p2) (list (caddr p2) (car p2)))      (list p3 (cdr p3) (list (caddr p3) (car p3)))      )       )     )  ))`
Title: Re: [Challenge] Point set inscribed the max area triangle
Post by: Stefan on March 16, 2011, 08:47:19 AM
Area of triangle

Code: [Select]
`(defun ph:area (p1 p2 p3)  (* 0.5     (abs (+     (* (cadr p1) (- (car p2) (car p3)))     (* (cadr p2) (- (car p3) (car p1)))     (* (cadr p3) (- (car p1) (car p2)))     )   )     )  )`
Title: Re: [Challenge] Point set inscribed the max area triangle
Post by: alanjt on March 16, 2011, 08:53:02 AM
Area of triangle

Code: [Select]
`(defun ph:area (p1 p2 p3)  (* 0.5     (abs (+    (* (cadr p1) (- (car p2) (car p3)))    (* (cadr p2) (- (car p3) (car p1)))    (* (cadr p3) (- (car p1) (car p2)))    )  )     )  )`
http://www.theswamp.org/index.php?topic=37455.msg424735#msg424735
Title: Re: [Challenge] Point set inscribed the max area triangle
Post by: Lee Mac on March 16, 2011, 09:17:14 AM
Another...

Code: [Select]
`(defun LM:TriangleArea ( p1 p2 p3 )  (* 0.5 (distance p1 p2) (distance p2 p3) (abs (sin (- (angle p2 p1) (angle p2 p3))))))`
Title: Re: [Challenge] Point set inscribed the max area triangle
Post by: chlh_jd on March 16, 2011, 09:21:57 AM
hi All, to cal area of 3d points triangle, please test with it
Code: [Select]
`(ss-aat '(1 2 0) '(4 4 3) '(5 6 0))(ss-aat '(1 2 0) '(2 4 3) '(3 6 0))`
Title: Re: [Challenge] Point set inscribed the max area triangle
Post by: Lee Mac on March 16, 2011, 09:23:18 AM
hi All, to cal area of 3d points triangle, please test with it
Code: [Select]
`(ss-aat '(1 2 0) '(4 4 3) '(5 6 0))`

Oh yes - I would note that mine was for 2D purposes....

For 3D:

Code: [Select]
`(defun LM:TriangleArea ( p1 p2 p3 )  ( (lambda ( n ) (* 0.5 (sqrt (apply '+ (mapcar '* n n)))))    (v^v (mapcar '- p2 p1) (mapcar '- p3 p1))  ))(defun v^v ( u v )  (list    (- (* (cadr u) (caddr v)) (* (cadr v) (caddr u)))    (- (* (car  v) (caddr u)) (* (car  u) (caddr v)))    (- (* (car  u) (cadr  v)) (* (car  v) (cadr  u)))  ))`
Title: Re: [Challenge] Point set inscribed the max area triangle
Post by: alanjt on March 16, 2011, 09:25:29 AM
hi All, to cal area of 3d points triangle, please test with it
Code: [Select]
`(ss-aat '(1 2 0) '(4 4 3) '(5 6 0))`

Oh yes - I would note that mine was for 2D purposes....
Ditto.
Title: Re: [Challenge] Point set inscribed the max area triangle
Post by: chlh_jd on March 16, 2011, 09:45:25 AM
Point to judge whether in atriangle and the area of ​​the triangle  has a reasonable calculation function ,
And, ElpanovEvgeniy often the corret routine , however the overall complexity of the algorithm is O(n^3),
is it possible to let down ?
Title: Re: [Challenge] Point set inscribed the max area triangle
Post by: chlh_jd on March 16, 2011, 10:06:04 AM
hi , Lee ,
that's my test result

_\$

"00:00:00:297"
_\$
Title: Re: [Challenge] Point set inscribed the max area triangle
Post by: Lee Mac on March 16, 2011, 10:13:41 AM
A quick test:

Code: [Select]
`_\$ (setq p1 '(1. 2. 0.) p2 '(4. 4. 3.) p3 '(5. 6. 0.))(5.0 6.0 0.0)_\$ (ss-aat p1 p2 p3)8.7178_\$ (LM:TriangleArea p1 p2 p3)8.7178_\$ (area_geron p1 p2 p3)8.7178`
Code: [Select]
`_\$ (Benchmark '((ss-aat p1 p2 p3) (LM:TriangleArea p1 p2 p3) (area_geron p1 p2 p3)))Benchmarking ..................Elapsed milliseconds / relative speed for 32768 iteration(s):    (AREA_GERON P1 P2 P3)..........1701 / 1.25 <fastest>    (LM:TRIANGLEAREA P1 P2 P3).....1857 / 1.14    (SS-AAT P1 P2 P3)..............2122 / 1.00 <slowest>`
Title: Re: [Challenge] Point set inscribed the max area triangle
Post by: chlh_jd on March 16, 2011, 10:21:54 AM
here's a new test dwg for total routine
Title: Re: [Challenge] Point set inscribed the max area triangle
Post by: ElpanovEvgeniy on March 17, 2011, 06:05:52 AM
new version
Code: [Select]
`(defun c:t1 (/ A1 A2 L LST S) (defun ins (p a b c)  (or (inters p a b c) (inters p b a c) (inters p c a b))) (defun area_geron (a b c / l p)  (setq l (cons 0 (mapcar (function distance) (list a b c) (list b c a)))        p (/ (apply (function +) l) 2.)  ) ;_  setq  (sqrt (abs (apply (function *) (mapcar (function -) l (list p p p p))))) ) ;_  defun (if (setq a1 0           s  (ssget "_x" '((0 . "point")))     ) ;_  setq  (foreach a (setq lst (mapcar (function (lambda (a) (cdr (assoc 10 (entget (cadr a))))))                               (ssnamex s)                       ) ;_  mapcar             ) ;_  setq   (foreach b lst    (foreach c lst     (if (and (> (setq a2 (area_geron a b c)) a1)              (vl-every (function (lambda (p) (ins p a b c))) lst)         ) ;_  and      (setq a1 a2            l  (list a b c)      ) ;_  setq     ) ;_  if    ) ;_  foreach   ) ;_  foreach  ) ;_  foreach ) ;_  if (entmakex  (append   '((0 . "LWPOLYLINE") (100 . "AcDbEntity") (100 . "AcDbPolyline") (90 . 3) (70 . 1))   (mapcar (function (lambda (a) (cons 10 a))) l)  ) ;_  append ) ;_  entmakex (princ))`
Title: Re: [Challenge] Point set inscribed the max area triangle
Post by: ElpanovEvgeniy on March 17, 2011, 06:53:03 AM
hi , all
hi , Evgeniy
about pt in or at the triangle , I tested result is

use cal number of intersections method is the fastest , is it a wrong test ?
Code: [Select]
`;;;number of intersection;;;fastest(defun ss-pitp (p l)  ;;check point inside triangle .  ;;by GSLS(SS)  ((lambda (a b c)     (eq (+ (length (inters p a b c nil))    (length (inters p b a c nil))    (length (inters p c a b nil)) ) 9     )   )    (car l)    (cadr l)    (caddr l)  ))`

Title: Re: [Challenge] Point set inscribed the max area triangle
Post by: gile on March 17, 2011, 02:45:44 PM
Hi,

While using a function which returns the triangle algebraic area (signed area) as Alanjt's AT:TriangleArea (http://www.theswamp.org/index.php?topic=37455.msg424735#msg424735) or algeb-area (http://www.theswamp.org/index.php?topic=18725.msg229319#msg229319) for the triangle area, the same routine can be used to evaluate if a point is inside the triangle:

Code: [Select]
`(defun algeb-area (p1 p2 p3)  (/ (- (* (- (car p2) (car p1)) (- (cadr p3) (cadr p1))) (* (- (car p3) (car p1)) (- (cadr p2) (cadr p1)))     )     2.0  ))(defun isInside (pt p1 p2 p3)  ((lambda (a1 a2 a3)     (or       (and (<= 0.0 a1) (<= 0.0 a2) (<= 0.0 a3))       (and (<= a1 0.0) (<= a2 0.0) (<= a3 0.0))     )   )    (algeb-area pt p1 p2)    (algeb-area pt p2 p3)    (algeb-area pt p3 p1)  ))`
This will return T if the point is strictly inside or lies on the triangle.
Replacing '<=' with '<' will evaluate only strictly inside point.
Title: Re: [Challenge] Point set inscribed the max area triangle
Post by: Lee Mac on March 17, 2011, 04:04:41 PM
Or perhaps another method:

Code: [Select]
`(defun isInside ( pt p1 p2 p3 )  (    (lambda ( a1 a2 a3 )      (or        (and (<= 0.0 a1) (<= 0.0 a2) (<= 0.0 a3))        (and (<= a1 0.0) (<= a2 0.0) (<= a3 0.0))      )    )    (sin (- (angle p1 pt) (angle p1 p2)))    (sin (- (angle p2 pt) (angle p2 p3)))    (sin (- (angle p3 pt) (angle p3 p1)))  ))`
[ Used some of your code Gile ]
Title: Re: [Challenge] Point set inscribed the max area triangle
Post by: chlh_jd on March 18, 2011, 04:23:50 AM
hi Gile , Lee ,
to judge a point in or at triangle ofcause can use area method , but it take a lot cal , I think the intersetion method is fastest .
hi Evgeniy , in the routine it can be
Code: [Select]
`(defun ss-pitp (p l)    ;;check point inside triangle .    ;;by GSLS(SS)    (< ((lambda (a b c)   (+ (length (inters p a b c nil))      (length (inters p b a c nil))      (length (inters p c a b nil))   ) ) (car l) (cadr l) (caddr l)       )       9    )  )`however yours 'ins' is Excellent ! but the wholl routine is too slow if the points nums is more , e.g. 528 points in my often dwg .
Title: Re: [Challenge] Point set inscribed the max area triangle
Post by: chlh_jd on March 18, 2011, 04:34:22 AM
by the way , in this routine , the area cal is for Comparison , so it can be simplified like this
Code: [Select]
`(defun ss-aat (p1 p2 p3)  ;;area triangle  ;;Uses conventional formula.  (apply (function +)       (mapcar (function (lambda (a b c)   (expt (- (+      (* (car a) (cadr b))      (* (car b) (cadr c))      (* (car c) (cadr a))    )    (+      (* (car a) (cadr c))      (* (car b) (cadr a))      (* (car c) (cadr b))    ) ) 2.   ) )       )       (list p1 (cdr p1) (list (caddr p1) (car p1)))       (list p2 (cdr p2) (list (caddr p2) (car p2)))       (list p3 (cdr p3) (list (caddr p3) (car p3)))       )       ))`
Title: Re: [Challenge] Point set inscribed the max area triangle
Post by: chlh_jd on March 18, 2011, 05:45:59 AM
is it possible to use Mesh method ?
Title: Re: [Challenge] Point set inscribed the max area triangle
Post by: chlh_jd on March 18, 2011, 05:51:14 AM
Perhaps , We can solve it from 2D first
Title: Re: [Challenge] Point set inscribed the max area triangle
Post by: gile on March 18, 2011, 06:21:18 AM
hi Gile , Lee ,
to judge a point in or at triangle ofcause can use area method , but it take a lot cal , I think the intersetion method is fastest .
hi Evgeniy , in the routine it can be
Code: [Select]
`(defun ss-pitp (p l)    ;;check point inside triangle .    ;;by GSLS(SS)    (< ((lambda (a b c)   (+ (length (inters p a b c nil))      (length (inters p b a c nil))      (length (inters p c a b nil))   ) ) (car l) (cadr l) (caddr l)       )       9    )  )`however yours 'ins' is Excellent ! but the wholl routine is too slow if the points nums is more , e.g. 528 points in my often dwg .
It seems to me that the ss-pitp routine do not return right results, for example:
(ss-pitp '(2. 1. 0.) '((0. 0. 0.) (5. 0. 0.) (3. 2. 0.))) returns nil even (2. 1. 0.) is inside the triangle.
Title: Re: [Challenge] Point set inscribed the max area triangle
Post by: chlh_jd on March 18, 2011, 07:30:28 AM
hi Gile
that's right result , because it change into the cond that whether point out of triangle , if to judge in or at it , use this
Code: [Select]
`(defun ss-pitp (p l)    ;;check point inside triangle .    ;;by GSLS(SS)    (= ;|if judge out of , ucs /= or < |; ((lambda (a b c)  (+ (length (inters p a b c nil))     (length (inters p b a c nil))     (length (inters p c a b nil))  ) ) (car l) (cadr l) (caddr l)       )       9    )  )`
Title: Re: [Challenge] Point set inscribed the max area triangle
Post by: chlh_jd on March 18, 2011, 07:41:42 AM
to sort point set by mesh , can use follow func , but not sure it's right
Code: [Select]
`;;;(defun sort-mesh       (pts n / minpt maxpt dvx fsx dvy fsy i dm a b mid ptm end)  ;;sort point set by mesh  ;;by GSLS(SS)  (setq minpt (apply 'mapcar (cons 'min pts)      ) maxpt      (apply 'mapcar (cons 'max pts)      ) dvx   (/ (- (car maxpt) (car minpt)) n) fsx   (car minpt) dvy   (/ (- (cadr maxpt) (cadr minpt)) n) fsy   (cadr minpt)  )  (setq pts (vl-sort pts  (function    (lambda (e1 e2)      (< (car e1) (car e2))    )  ) )  )  (setq i 1)  (while pts    (setq dm (+ fsx (* i dvx)))    (setq a (car pts))    (cond ((<= (- dm dvx) (car a) dm)   (setq mid (cons a mid) pts (cdr pts)   )  )  ((<= dm (car a) (+ dm dvx))   (setq ptn (cons mid ptn) mid nil mid (cons a mid) pts (cdr pts) i   (1+ i)   )  )  (t   (setq ptn (cons nil (cons mid ptn)) mid nil i   (1+ i)   )  )    )  )  (setq end nil)  (foreach b ptn    (if b      (progn (setq b  (vl-sort b   (function     (lambda (e1 e2)       (< (cadr e1) (cadr e2))     )   )  )      i  1      mid nil      ptm nil ) (while b  (setq dm (+ fsy (* i dvy)))  (setq a (car b))  (cond ((<= (- dm dvy) (cadr a) dm) (setq mid (cons a mid)       b   (cdr b) ) ) ((<= dm (cadr a) (+ dm dvy)) (setq ptm (cons mid ptm)       mid nil       mid (cons a mid)       b   (cdr b)       i   (1+ i) ) ) (t (setq ptm (cons nil (cons mid ptm))       mid nil       i   (1+ i) ) )  ) ) (setq end (cons (reverse ptm) end))      )      (setq end (cons (repeat n (setq b (cons nil b))) end))    )  )  end);;test (foreach a   (sort-mesh    (mapcar      (function (lambda (x) (cdr (assoc 10 (entget (cadr x)))))      )      (cdr (reverse (ssnamex (ssget '((0 . "point"))))))    )    20  )  (princ a))`
Title: Re: [Challenge] Point set inscribed the max area triangle
Post by: gile on March 18, 2011, 07:57:38 AM
hi Gile
that's right result , because it change into the cond that whether point out of triangle , if to judge in or at it , use this
Code: [Select]
`(defun ss-pitp (p l)    ;;check point inside triangle .    ;;by GSLS(SS)    (= ;|if judge out of , ucs /= or < |; ((lambda (a b c)  (+ (length (inters p a b c nil))     (length (inters p b a c nil))     (length (inters p c a b nil))  ) ) (car l) (cadr l) (caddr l)       )       9    )  )`

Sorry, I can't understand what you mean.

Your new routine still return false result IMO.

The point (3. -2. 0.) is outside the triangle ((0. 0. 0.) (5. 0. 0.) (3. 2. 0.)) but
(ss-pitp '(3. -2. 0.) '((0. 0. 0.) (5. 0. 0.) (3. 2. 0.))) returns T
Title: Re: [Challenge] Point set inscribed the max area triangle
Post by: chlh_jd on March 18, 2011, 08:03:38 AM
hi Gile
that's right result , because it change into the cond that whether point out of triangle , if to judge in or at it , use this
Code: [Select]
`(defun ss-pitp (p l)    ;;check point inside triangle .    ;;by GSLS(SS)    (= ;|if judge out of , ucs /= or < |; ((lambda (a b c)  (+ (length (inters p a b c nil))     (length (inters p b a c nil))     (length (inters p c a b nil))  ) ) (car l) (cadr l) (caddr l)       )       9    )  )`

Sorry, I can't understand what you mean.

Your new routine still return false result IMO.

The point (3. -2. 0.) is outside the triangle ((0. 0. 0.) (5. 0. 0.) (3. 2. 0.)) but
(ss-pitp '(3. -2. 0.) '((0. 0. 0.) (5. 0. 0.) (3. 2. 0.))) returns T
hi gile , my test reulet return NIL
Title: Re: [Challenge] Point set inscribed the max area triangle
Post by: gile on March 18, 2011, 08:20:18 AM
Quote
hi gile , my test reulet return NIL

I do not know how you're making your tests, but :

(inters p a b c nil) returns (15.0 -10.0 0.0) => length = 3
(inters p b a c nil) returns (15.0 10.0 0.0) => lenght = 3
(inters p c a b nil) returns (3.0 0.0 0.0) => length = 3
Total lengthes = 9 => T

Try this little test command
Code: [Select]
`(defun c:test (/ l p)  (setq l '((0. 0. 0.) (5. 0. 0.) (3. 2. 0.)))  (command "_.pline")  (mapcar '(lambda (p) (command "_non" p)) l)  (command "_close")  (while (setq p (getpoint))    (alert      (if (ss-pitp p l) "Inside" "Outside"      )    )  )  (princ))`
Title: Re: [Challenge] Point set inscribed the max area triangle
Post by: chlh_jd on March 18, 2011, 08:58:51 AM
Nice gile !
thank you for often a nice test routine .
it really take a wrong result .
Title: Re: [Challenge] Point set inscribed the max area triangle
Post by: chlh_jd on March 18, 2011, 09:04:47 AM
by the cods , it'll return error result inside ,like the picture
Code: [Select]
`(defun ss-pitp (p l)    ;;check point inside triangle .       ((lambda (a b c)   (not (or (inters p a b c) (inters p b a c) (inters p c a b))) ) (car l) (cadr l) (caddr l)       )  )`
Title: Re: [Challenge] Point set inscribed the max area triangle
Post by: chlh_jd on March 18, 2011, 09:26:34 AM
by the way , angle & inters are use in 2D plan , in 3Dplan it can't return corret reslut .
if in 3D , do it can use this func , I can't sure it because less of  'trans .
Code: [Select]
`;;;with the same direction method;;;by trans(defun ss-pitp1 (p l)  ;;check point inside triangle .  ;;by GSLS(SS)  ((lambda (a b c)     (and (<= (* (car (trans (mapcar '- p a) 0 (mapcar '- b a)))        (car (trans (mapcar '- p a) 0 (mapcar '- c a)))     )     0 ) (<= (* (car (trans (mapcar '- p b) 0 (mapcar '- a b)))        (car (trans (mapcar '- p b) 0 (mapcar '- c b)))     )     0 )     )   )    (car l)    (cadr l)    (caddr l)  ))`
Title: Re: [Challenge] Point set inscribed the max area triangle
Post by: chlh_jd on March 18, 2011, 09:28:50 AM
The way is too long , So let's begin with 2D  :-P
Title: Re: [Challenge] Point set inscribed the max area triangle
Post by: chlh_jd on March 19, 2011, 02:11:23 AM
To accurately determine the point is outside the triangle , uses this one
Code: [Select]
`;;;is outside of triangle (defun ss-ostp (p l)  (if (vl-some (function (lambda (x) (equal p x 1e-6)))       l      );_ pt at Triangle point    nil    ;;Gile & Lee Mac    ((lambda (a b c)       (not (or   (and (<= -1e-6 a) (<= -1e-6 b) (<= -1e-6 c))   (and (<= a 1e-6) (<= b 1e-6) (<= c 1e-6)) );_if at triangle edge, so add tolerance       )     )      (sin (- (angle (car l) p) (angle (car l) (cadr l))))      (sin (- (angle (cadr l) p) (angle (cadr l) (caddr l))))      (sin (- (angle (caddr l) p) (angle (caddr l) (car l))))    )  ));;;Gile (defun c:test (/ l p)  (setq l '((3. 2. 0.) (0. 0. 0.) (5. 0. 0.)))  (command "_.pline")  (mapcar '(lambda (p) (command "_non" p)) l)  (command "_close")  (while (setq p (getpoint))    (alert      (if (ss-ostp p l) "Outside" "Inside"       )    )  )  (princ))`
Title: Re: [Challenge] Point set inscribed the max area triangle
Post by: chlh_jd on March 19, 2011, 04:35:50 PM
hi All , here is a mesh method , not sure it's right .
it can improve eff too much , but slowly yet .
Code: [Select]
`;;;to draw the Embedded triangle of point set  which has max area , in the no other point of the pts inside it;;;by GSLS(SS)(defun c:test (/ ostp    area_geron        sort-mesh        pt-ishp get-ijlst cal-nil-counter     pts        minpt maxpt    fsx      fsy       hull        n lst    i      j        nil_lst_i        new_lst_i end    tri_area  new       new_lst        a1 a    b      c        d        r1_lst r2_lst    len      end_lst_i       );;;is outside of triangle   (defun ostp (p p1 p2 p3);_(check-pt (list p p1 p2 p3))      ;;Gile & Lee Mac      ((lambda (a b c) (not    (or      (and (< 0.0 a) (< 0.0 b) (< 0.0 c))      (and (< a 0.0) (< b 0.0) (< c 0.0))    ) ;_if at triangle edge, so add tolerance )       ) (sin (- (angle p1 p) (angle p1 p2))) (sin (- (angle p2 p) (angle p2 p3))) (sin (- (angle p3 p) (angle p3 p1)))      )      )  ;;cal area of triangle for Comparison   (defun area_geron (a b c / l p)    (setq l (cons 0   (mapcar (function distance) (list a b c) (list b c a))     )   p (/ (apply (function +) l) 2.)    ) ;_  setq    (abs      (apply (function *) (mapcar (function -) l (list p p p p)))    ) ;_Omit the square root  ) ;_  defun  (defun sort-mesh    (pts n / i dm a b mid ptm ptn end)    (setq dvx (/ (- (car maxpt) (car minpt)) n)   dvy (/ (- (cadr maxpt) (cadr minpt)) n)    )    (setq pts    (vl-sort pts     (function       (lambda (e1 e2) (< (cadr e1) (cadr e2))       )     )    )    ) ;_sort point set by Y coor    (setq i 1   mid nil)    (while pts      (setq dm (+ fsy (* i dvy)))      (setq a (car pts)      )      (cond ((<= (- dm dvy) (cadr a) dm)      (setq mid (cons a mid)    pts (cdr pts)      )     )     ((<= dm (cadr a) (+ dm dvy))      (setq ptn (cons mid ptn)    mid nil    mid (cons a mid)    pts (cdr pts)    i   (1+ i)      )     )     (t      (setq ptn (cons nil (cons mid ptn))    mid nil    i   (1+ i)      )     )      )    )    (if mid (setq ptn (cons mid ptn)))    (setq end nil)    (foreach b ptn ;_(setq b (car ptn))      (if b (progn   (setq b     (vl-sort b      (function        (lambda (e1 e2) (< (car e1) (car e2))        )      )     ) ;_sort points by X coor i   1 mid nil ptm nil   )   (while b     (setq dm (+ fsx (* i dvx)))     (setq a (car b))     (cond ((<= (- dm dvx) (car a) dm)    (setq mid (cons a mid) b   (cdr b)    )   )   ((<= dm (car a) (+ dm dvx))    (setq ptm (cons mid ptm) mid nil mid (cons a mid) b   (cdr b) i   (1+ i)    )   )   (t    (setq ptm (cons mid ptm) mid nil i   (1+ i)    )   )     )   )   (if mid (setq ptm (cons mid ptm)))   (repeat (- n (length ptm))     (setq ptm (cons nil ptm))     )   (setq end (cons (reverse ptm) end)) ) (setq end (cons (repeat n (setq b (cons nil b))) end))      )    )    end  )  (defun pt-ishp (pt hull / hull_cen is_inh)    (setq hull_cen (mapcar (function (lambda (x) (/ x (length hull))))    (apply 'mapcar (cons '+ hull))    )   hull    (cons (last hull) hull)   is_inh   T    )    (while (and is_inh (cadr hull))      (if (inters hull_cen pt (car hull) (cadr hull) T) (setq is_inh nil) (setq hull (cdr hull))      )    )    is_inh  );;;  (defun get-ijlst (ij n len / i j it ib jl jr new i%);;;get ij N round items i & j    (setq i  (car ij)   j  (cadr ij)   it (+ i n)   ib (- i n)   jl (- j n)   jr (+ j n)    )    (setq new (list (list i jl) (list i jr) (list ib jl) (list ib j) (list ib jr) (list it j) (list it jl) (list it jr)       )    )    (setq i% 0)    (repeat (1- n)      (setq new (append (list (list it (- j (setq i% (1+ i%))))       (list it (+ j i%))       (list ib (+ j i%))       (list ib (- j i%))       (list (+ i i%) jl)       (list (- i i%) jl)       (list (+ i i%) jr)       (list (- i i%) jr) ) new )      )    )    (vl-remove-if-not      (function (lambda (x)   (and (<= 0 (car x) (1- len))        (<= 0 (cadr x) (1- len))   ) )      )      new    )  )  ;;;  (defun cal-nil-counter (ij nil_lst_i len / is_go ij_lst i new)    (setq is_go T   i 1    )    (while is_go      (setq new    nil     ij_lst (get-ijlst ij i len)     i%    -1      )      (if (apply   'and   (mapcar (function (lambda (x) (vl-position x nil_lst_i)))   ij_lst   ) ) (setq i (1+ i)) (setq is_go nil)      )    )    i  )  ;;....................................................................................  (setq pts (mapcar       (function (lambda (x) (cdr (assoc 10 (entget (cadr x)))))       )       (cdr (reverse (ssnamex (ssget '((0 . "point"))))))     )  )  (setq minpt (apply 'mapcar (cons 'min pts)       ) ;_lb point maxpt       (apply 'mapcar (cons 'max pts)       ) ;_rt point fsx   (car minpt) fsy   (cadr minpt) hull  (Graham-scan pts) ;_Convex hull n     19  )  (while (or (null nil_lst_i) (< (length nil_lst_i) 200))    (setq lst (sort-mesh pts (setq n (1+ n)))) ;_sort points and return a mesh points list ;_(check-pt (cadr (vl-remove nil (car lst))))    (setq nil_lst_i nil   i 0    )    (foreach a lst      (setq j 0)      (foreach b a (if (= b nil)   (setq nil_lst_i (cons (list i j) nil_lst_i)) ) (setq j (1+ j))      )      (setq i (1+ i))    )  )  (setq nil_lst_i (reverse nil_lst_i) nil_lst_i (vl-remove-if-not     (function       (lambda (x) (pt-ishp (list (+ fsx (* (+ (car x) 0.5) dvx))        (+ fsy (* (+ (cadr x) 0.5) dvy)) ) hull )       )     )     nil_lst_i   ) new_lst_i (mapcar     (function       (lambda (x) (append x (list (cal-nil-counter x nil_lst_i n)) )       )     )     nil_lst_i   ) new_lst_i (vl-sort new_lst_i    (function (lambda (e1 e2)        (> (caddr e1) (caddr e2))      )    )   ) len   (caddar new_lst_i) new_lst_i (vl-remove-if-not     (function (lambda (x) (= (caddr x) len)       )     )     new_lst_i   ) end_lst_i nil end   nil tri_area  0  )  (while new_lst_i    (setq a     (car new_lst_i)   new_lst_i (cdr new_lst_i)    )    (if (null end_lst_i)      (setq end_lst_i (list (list (reverse (cdr (reverse a))))))      (if (setq b (car    (vl-remove-if-not      (function        (lambda (x) (or (vl-position (list (car a) (1- (cadr a))) x)      (vl-position (list (car a) (1+ (cadr a))) x)      (vl-position (list (1- (car a)) (cadr a)) x)      (vl-position (list (1- (car a)) (1- (cadr a))) x)      (vl-position (list (1- (car a)) (1+ (cadr a))) x) )        )      )      end_lst_i    ) )   ) (setq end_lst_i (cons (cons (reverse (cdr (reverse a))) b)       (vl-remove b end_lst_i) ) ) (setq end_lst_i        (cons (list (reverse (cdr (reverse a)))) end_lst_i) )      )    )  )  (setq end_lst_i (vl-sort end_lst_i    (function (lambda (e1 e2)        (> (length e1) (length e2))      )    )   )  )  ;;just test 4 areas   (foreach a (list (car end_lst_i) ;_(setq a (car end_lst_i))    (cadr end_lst_i)          )    (if a      (progn (setq new nil       new_lst nil ) (foreach b a   (foreach c (get-ijlst b len (1- n))     ;_here must be (append (get-ijlst b len (1- n)) (get-ijlst b (1+ len) (1- n))) , but too slow although the points number only 100 .     (setq new (cons c new))     (if (and (not (vl-position b new))      (setq d (nth (cadr c) (nth (car c) lst))) )       (setq new_lst (append new_lst d)       )     )   ) ) ;_(check-pt new_lst) ;; Evgeniy method ;; this part too slowly , how can improve it ? (princ (length new_lst));_for test (foreach b new_lst   (foreach c new_lst     (foreach d new_lst       (if (and (not (equal b c 1e-6))        (not (equal c d 1e-6))        (not (equal b d 1e-6))        (> (setq a1 (area_geron b c d)) tri_area)        (vl-every (function (lambda (p) (ostp p b c d))) new_lst        )   ) ;_  and (setq tri_area a1       end      (list b c d) ) ;_  setq       ) ;_  if     ) ;_  foreach   ) ;_  foreach )      )    )  )  (entmakex    (append      '((0 . "LWPOLYLINE") (100 . "AcDbEntity") (100 . "AcDbPolyline") (90 . 3) (70 . 1)       )      (mapcar (function (lambda (a) (cons 10 a))) end)    ) ;_  append  ) ;_  entmakex  (princ))(defun Graham-scan (ptl / det hPs rPs PsY Pt0 sPs P Q)  ;;by highflybird  ;;定义三点的行列式,即三点之倍面积  ;;Definition of the determinant of three points, that is 2 times area of triangle  (defun det (p1 p2 p3)    (- (* (- (car p2) (car p1)) (- (cadr p3) (cadr p1)))       (* (- (car p3) (car p1)) (- (cadr p2) (cadr p1)))    )  )  (if (< (length ptl) 4) ;3点以下     ptl ;是本集合     (progn      (setq rPs (mapcar (function (lambda (x)     (if (= (length x) 3)       (cdr x)       x     )   ) ) (mapcar 'reverse ptl) ) ;点_表的X和Y交换     PsY (mapcar 'cadr ptl) ;_点表的Y值的表     Pt0 (reverse (assoc (apply 'min PsY) rPs)) ;_最下面的点            sPs (sort-ad ptl Pt0) ;_按角度距离排序点集     hPs (list (caddr sPs) (cadr sPs) Pt0) ;_开始的三点       )      (foreach n (cdddr sPs) ;从第4点开始 (setq hPs (cons n hPs) ;把Pi加入到凸集       P   (cadr hPs) ;Pi-1       Q   (caddr hPs) ;Pi-2 ) (while (and q (> (det n P Q) -1e-6)) ;如果左转   (setq hPs (cons n (cddr hPs)) ;删除Pi-1点 P   (cadr hPs) ;得到新的Pi-1点 Q   (caddr hPs) ;得到新的Pi-2点   ) )      )      hPs ;返回凸集     )  ))(defun sort-ad (ptlist pt / Ang1 Ang2)`
Title: Re: [Challenge] Point set inscribed the max area triangle
Post by: chlh_jd on March 19, 2011, 05:02:52 PM
Suppose before mesh method is corret ,Now we must solve problem just cal  point set which has a big hole , like the picture .
Title: Re: [Challenge] Point set inscribed the max area triangle
Post by: Lee Mac on March 19, 2011, 05:12:50 PM
Tip:  Use 'png' or 'gif' image format to obtain better quality images when taking screenshots of a vector-based program such as AutoCAD.
Title: Re: [Challenge] Point set inscribed the max area triangle
Post by: chlh_jd on March 20, 2011, 06:40:14 AM
Thanks LEE .
Title: Re: [Challenge] Point set inscribed the max area triangle
Post by: chlh_jd on March 20, 2011, 09:03:39 AM
Hi All , this one can get the right result for the e.g. dwg , but not solve problem , Mass Calculation of the end point set
I'v upload the new test drawing .
Code: [Select]
`(defun c:test (/ ostp   area_geron       sort-mesh       pt-ishp get-ijlst get-subspace-rings     pts       minpt maxpt   fsx     fsy       hull       n lst   i     j       nil_lst_i       new_lst_i end   tri_area  new       new_lst       a1 a   b     c       d       r1_lst r2_lst   len     end_lst_i      );;;is outside of triangle   (defun ostp (p p1 p2 p3);_(check-pt (list p p1 p2 p3))      ;;Gile & Lee Mac      ((lambda (a b c) (not   (or     (and (< 1e-6 a) (< 1e-6 b) (< 1e-6 c))     (and (< a -1e-6) (< b -1e-6) (< c -1e-6))   ) ;_if at triangle edge, so add tolerance )       ) (sin (- (angle p1 p) (angle p1 p2))) (sin (- (angle p2 p) (angle p2 p3))) (sin (- (angle p3 p) (angle p3 p1)))      )      )  ;;cal area of triangle for Comparison   (defun area_geron (a b c / l p)    (setq l (cons 0  (mapcar (function distance) (list a b c) (list b c a))    )  p (/ (apply (function +) l) 2.)    ) ;_  setq    (abs      (apply (function *) (mapcar (function -) l (list p p p p)))    ) ;_Omit the square root  ) ;_  defun  (defun sort-mesh   (pts n / i dm a b mid ptm ptn end)    (setq dvx (/ (- (car maxpt) (car minpt)) n)  dvy (/ (- (cadr maxpt) (cadr minpt)) n)    )    (setq pts   (vl-sort pts    (function      (lambda (e1 e2) (< (cadr e1) (cadr e2))      )    )   )    ) ;_sort point set by Y coor    ;;    (setq i 1  mid nil)    (while pts      (setq dm (+ fsy (* i dvy)))      (setq a (car pts)      )      (cond ((<= (- dm dvy) (cadr a) dm)     (setq mid (cons a mid)   pts (cdr pts)     )    )    ((<= dm (cadr a) (+ dm dvy))     (setq ptn (cons mid ptn)   mid nil   mid (cons a mid)   pts (cdr pts)   i   (1+ i)     )    )    (t     (setq ptn (cons nil (cons mid ptn))   mid nil   i   (1+ i)     )    )      )    )    (if mid (setq ptn (cons mid ptn)))    ;(setq end nil) ;_bypass    (foreach b ptn ;_(setq b (car ptn))      (if b (progn  (setq b    (vl-sort b     (function       (lambda (e1 e2) (< (car e1) (car e2))       )     )    ) ;_sort points by X coor i   1 mid nil ptm nil  )  (while b    (setq dm (+ fsx (* i dvx)))    (setq a (car b))    (cond ((<= (- dm dvx) (car a) dm)   (setq mid (cons a mid) b   (cdr b)   )  )  ((<= dm (car a) (+ dm dvx))   (setq ptm (cons mid ptm) mid nil mid (cons a mid) b   (cdr b) i   (1+ i)   )  )  (t   (setq ptm (cons mid ptm) mid nil i   (1+ i)   )  )    )  )  (if mid (setq ptm (cons mid ptm)))  (repeat (- n (length ptm))    (setq ptm (cons nil ptm))    )  (setq end (cons (reverse ptm) end)) ) (setq end (cons (repeat n (setq b (cons nil b))) end))      )    )    end  )  (defun pt-ishp (pt hull / hull_cen is_inh)    (setq hull_cen (mapcar (function (lambda (x) (/ x (length hull))))   (apply 'mapcar (cons '+ hull))   )  hull   (cons (last hull) hull)  is_inh   T    )    (while (and is_inh (cadr hull))      (if (inters hull_cen pt (car hull) (cadr hull) T) (setq is_inh nil) (setq hull (cdr hull))      )    )    is_inh  );;; Calculating sublattice number of the ij-position expanding n outer ring   (defun get-ijlst (ij n len / i j it ib jl jr new i%)    (setq i  (car ij)  j  (cadr ij)  it (+ i n)  ib (- i n)  jl (- j n)  jr (+ j n)    )    (setq new (list (list i jl) (list i jr) (list ib jl) (list ib j) (list ib jr) (list it j) (list it jl) (list it jr)      )    )    (setq i% 0)    (repeat (1- n)      (setq new (append (list (list it (- j (setq i% (1+ i%))))      (list it (+ j i%))      (list ib (+ j i%))      (list ib (- j i%))      (list (+ i i%) jl)      (list (- i i%) jl)      (list (+ i i%) jr)      (list (- i i%) jr) ) new )      )    )    (vl-remove-if-not      (function (lambda (x)  (and (<= 0 (car x) (1- len))       (<= 0 (cadr x) (1- len))  ) )      )      new    )  )  ;;; cal sub-space  (defun get-subspace-rings (ij nil_lst_i len / is_go ij_lst i new)    (setq is_go T  i 1    )    (while is_go      (setq new   nil    ij_lst (get-ijlst ij i len)    i%   -1      )      (if (apply  'and  (mapcar (function (lambda (x) (vl-position x nil_lst_i)))  ij_lst  ) ) (setq i (1+ i)) (setq is_go nil)      )    )    i  )  ;;....................................................................................  (setq pts (mapcar      (function (lambda (x) (cdr (assoc 10 (entget (cadr x)))))      )      (cdr (reverse (ssnamex (ssget '((0 . "point"))))))    )  )  (setq minpt (apply 'mapcar (cons 'min pts)      ) ;_lb point maxpt      (apply 'mapcar (cons 'max pts)      ) ;_rt point fsx   (car minpt) fsy   (cadr minpt) hull  (Graham-scan pts) ;_Convex hull n     (fix(sqrt(* 2.9 (length pts)))) ;_changed , to get enough number of mesh ,                                      ;_The best is a prime number - 1 .  )  (while (or (null nil_lst_i) (< (length nil_lst_i) 200)) ;_the number of sub-spaces '200', is it suit ?    (setq lst (sort-mesh pts (setq n (1+ n)))) ;_sort points and return a mesh points list    (setq nil_lst_i nil  i 0    )    (foreach a lst      (setq j 0)      (foreach b a (if (= b nil)  (setq nil_lst_i (cons (list i j) nil_lst_i)) ) (setq j (1+ j))      )      (setq i (1+ i))    )  )  ;;;-----------------------------------------  ;;; Calculating contain most sub-space Area  ;;; This part is too cumbersome ... can be simplified .  (setq nil_lst_i (reverse nil_lst_i) nil_lst_i (vl-remove-if-not    (function      (lambda (x) (pt-ishp (list (+ fsx (* (+ (car x) 0.5) dvx))       (+ fsy (* (+ (cadr x) 0.5) dvy)) ) hull )      )    )    nil_lst_i  ) new_lst_i (mapcar    (function      (lambda (x) (append x (list (get-subspace-rings x nil_lst_i n)) )      )    )    nil_lst_i  ) new_lst_i (vl-sort new_lst_i   (function (lambda (e1 e2)       (> (caddr e1) (caddr e2))     )   )  ) len  (caddar new_lst_i) new_lst_i (vl-remove-if-not    (function (lambda (x) (= (caddr x) len)      )    )    new_lst_i  ) end_lst_i nil  )  (while new_lst_i    (setq a    (car new_lst_i)  new_lst_i (cdr new_lst_i)    )    (if (null end_lst_i)      (setq end_lst_i (list (list (reverse (cdr (reverse a))))))      (if (setq b (car   (vl-remove-if-not     (function       (lambda (x) (or (vl-position (list (car a) (1- (cadr a))) x)     (vl-position (list (car a) (1+ (cadr a))) x)     (vl-position (list (1- (car a)) (cadr a)) x)     (vl-position (list (1- (car a)) (1- (cadr a))) x)     (vl-position (list (1- (car a)) (1+ (cadr a))) x) )       )     )     end_lst_i   ) )  ) (setq end_lst_i (cons (cons (reverse (cdr (reverse a))) b)      (vl-remove b end_lst_i) ) ) (setq end_lst_i       (cons (list (reverse (cdr (reverse a)))) end_lst_i) )      )    )  )  (setq end_lst_i (vl-sort end_lst_i   (function (lambda (e1 e2)       (> (length e1) (length e2))     )   )  ) end  nil tri_area  0  )  ;;;--------------------------------------  ;;;end of calculating number of sub-space    ;;just test 4 areas   (foreach a (list (car end_lst_i) ;_(setq a (car end_lst_i))   (cadr end_lst_i)   (caddr end_lst_i)   (cadddr end_lst_i)     )    (if a      (progn (setq new nil      new_lst nil ) (foreach b a  (foreach c (append (get-ijlst b len (1- n)) (get-ijlst b (1+ len) (1- n)) (get-ijlst b (+ 2 len) (1- n)))    ;_here has problem , jow much the number of expand outer ring Need to search point set ?    ;_based on the grid subdivision and the discrete of point set ?    (if (and (not (vl-position c new))     (setq d (nth (cadr c) (nth (car c) lst))) )      (setq new (cons c new)    new_lst (append new_lst d)      )    )  ) )        ;_(check-pt new_lst) ;_(princ (length new_lst));_for test ;_(setq new_lst  (remove-same-pts new_lst 1e-6)) (princ (length new_lst));_for test ;_the last points for search . ;_can it search by centre scanning or other scanning method ? ;; Evgeniy method ;; this part too slowly , how can improve it ? (foreach b new_lst  (foreach c new_lst    (foreach d new_lst      (if (and (not (equal b c 1e-6))       (not (equal c d 1e-6))       (not (equal b d 1e-6))       (> (setq a1 (area_geron b c d)) tri_area)       (vl-every (function (lambda (p) (ostp p b c d))) new_lst       )  ) ;_  and (setq tri_area a1      end      (list b c d) ) ;_  setq      ) ;_  if    ) ;_  foreach  ) ;_  foreach );      )    )  )  (entmakex    (append      '((0 . "LWPOLYLINE") (100 . "AcDbEntity") (100 . "AcDbPolyline") (90 . 3) (70 . 1)       )      (mapcar (function (lambda (a) (cons 10 a))) end)    ) ;_  append  ) ;_  entmakex  (princ))`