Author Topic: [Challenge] Point set inscribed the max area triangle  (Read 9578 times)

0 Members and 1 Guest are viewing this topic.

chlh_jd

  • Guest
Re: [Challenge] Point set inscribed the max area triangle
« Reply #45 on: March 18, 2011, 09:28:50 AM »
The way is too long , So let's begin with 2D  :-P

chlh_jd

  • Guest
Re: [Challenge] Point set inscribed the max area triangle
« Reply #46 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)
)

chlh_jd

  • Guest
Re: [Challenge] Point set inscribed the max area triangle
« Reply #47 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)


chlh_jd

  • Guest
Re: [Challenge] Point set inscribed the max area triangle
« Reply #48 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 .

Lee Mac

  • Seagull
  • Posts: 12313
  • London, England
Re: [Challenge] Point set inscribed the max area triangle
« Reply #49 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.

chlh_jd

  • Guest
Re: [Challenge] Point set inscribed the max area triangle
« Reply #50 on: March 20, 2011, 06:40:14 AM »
Thanks LEE .

chlh_jd

  • Guest
Re: [Challenge] Point set inscribed the max area triangle
« Reply #51 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)
)
« Last Edit: March 20, 2011, 09:29:52 AM by chlh_jd »