Author Topic: Triangulation (re-visited)  (Read 312884 times)

0 Members and 2 Guests are viewing this topic.

ribarm

  • Gator
  • Posts: 3225
  • Marko Ribar, architect
Re: Triangulation (re-visited)
« Reply #345 on: March 27, 2015, 06:19:53 AM »
Marko,


Not sure, but the active triangle list al
should be modified to contain ymax of
each triangle.

Code: [Select]
al  (list (list xmax cp r sl))
      ;Initialize the Active Triangle list                            ;
      ; al, List contains active triangles defined by 4 items:        ;
      ;     item 0: Xmax of points in triangle.       ;
      ;     item 1: Center of circle circumscribing triangle.         ;
      ;     item 2: Radius of above circle.             ;
      ;     item 3: List of 3 vertices defining the triangle.         ;

ymg

ymg, I am doing this... It doesn't matter if it's only value or 2D point... Look here - from (getcircumcircle) :

Code: [Select]
      (list (mapcar '+ cp (list 0.0 rr)) cp rr (list p (car el) (cadr el))) ;;; Added Y apex of circumscribed triangle circle as first element of (getcircumcircle) output list ;;;

And for comparison of Ymax values - from (cond) of main routine :

Code: [Select]
        (cond
         ( (< (caadr tr) (cadr p)) ;;; Comparison of Y values ;;;
           (setq tl (cons (cadddr tr) tl))
         )
...

It just don't work on my PCs...
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

ribarm

  • Gator
  • Posts: 3225
  • Marko Ribar, architect
Re: Triangulation (re-visited)
« Reply #346 on: March 27, 2015, 06:31:31 AM »
Oh, yes ymg, you're right...

Should be :

Code: [Select]
        (cond
          ( (< (cadar tr) (cadr p)) ;;; Comparison of Y values ;;;
            (setq tl (cons (cadddr tr) tl))
          )
...

(replaced (caadr) with (cadar)... What a mistake... Thanks... I'll update my codes now and will make supertriangle a little bigger...)

Thanks, M.R.
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

ymg

  • Guest
Re: Triangulation (re-visited)
« Reply #347 on: March 27, 2015, 06:33:40 AM »
Marko,

I will look a little deeper.

The comparison value should be the maxY of the triangle.

The supertriangle does not need to be rotated as the
only requirement is that it be big enough to contain
any circumcircles.

ymg

ymg

  • Guest
Re: Triangulation (re-visited)
« Reply #348 on: March 27, 2015, 07:04:00 AM »
Marko,

Glad, you could straighten the problem.

ymg

ribarm

  • Gator
  • Posts: 3225
  • Marko Ribar, architect
Re: Triangulation (re-visited)
« Reply #349 on: March 27, 2015, 12:32:35 PM »
Hi all...
Here is my combined version that will do correct triangulation satisfying both X and Y axises algorithms and all this for making correct Xmax and Ymax edge of point cloud triangulation - formed triangulation must satisfy condition of convex hull of point cloud... So what's left after triangulation in X axis - it's added with Y axis algorithm - Xmax edge is convex and opposite, what's left after triangulation in Y axis - it's added with X axis algorithm - Ymax edge is convex...

Code - Auto/Visual Lisp: [Select]
  1. (defun c:triangulate-MR-EE ( / unique _vl-remove v^v mid circumcircle getcircumcircle-Xsort triangulate-Xsort getcircumcircle-Ysort triangulate-Ysort ss i p pl xmin xmax ymin ymax cs pmin pmax tl )
  2.  
  3.   (defun unique ( lst )
  4.     (if lst (cons (car lst) (unique (_vl-remove (car lst) (_vl-remove (list (caar lst) (caddar lst) (cadar lst)) (_vl-remove (list (cadar lst) (caar lst) (caddar lst)) (_vl-remove (list (cadar lst) (caddar lst) (caar lst)) (_vl-remove (list (caddar lst) (caar lst) (cadar lst)) (_vl-remove (list (caddar lst) (cadar lst) (caar lst)) (cdr lst) 1e-6) 1e-6) 1e-6) 1e-6) 1e-6) 1e-6))))
  5.   )
  6.  
  7.   (defun _vl-remove ( el lst fuzz )
  8.     (vl-remove-if '(lambda ( x ) (and (equal (car x) (car el) fuzz) (equal (cadr x) (cadr el) fuzz) (equal (caddr x) (caddr el) fuzz))) lst)
  9.   )
  10.  
  11.   (defun v^v ( u v )
  12.     (mapcar '(lambda ( s1 s2 a b ) (+ ((eval s1) (* (nth a u) (nth b v))) ((eval s2) (* (nth a v) (nth b u))))) '(+ - +) '(- + -) '(1 0 0) '(2 2 1))
  13.   )
  14.  
  15.   (defun mid ( p1 p2 )
  16.     (mapcar '(lambda ( a b ) (/ (+ a b) 2.0)) p1 p2)
  17.   )
  18.  
  19.   (defun circumcircle ( p1 p2 p3 / p12 p23 p31 c1 c2 c r )
  20.     (setq p12 (mid p1 p2))
  21.     (setq p23 (mid p2 p3))
  22.     (setq p31 (mid p3 p1))
  23.     (setq c1 (inters p12 (mapcar '+ p12 (v^v (mapcar '- p2 p1) '(0.0 0.0 1.0))) p23 (mapcar '+ p23 (v^v (mapcar '- p3 p2) '(0.0 0.0 1.0))) nil))
  24.     (setq c2 (inters p12 (mapcar '+ p12 (v^v (mapcar '- p2 p1) '(0.0 0.0 1.0))) p31 (mapcar '+ p31 (v^v (mapcar '- p3 p1) '(0.0 0.0 1.0))) nil))
  25.     (setq c (mid c1 c2))
  26.     (setq r (distance c p1))
  27.     (list (list (car c) (cadr c)) r)
  28.   )
  29.  
  30.   (defun getcircumcircle-Xsort ( p el / cp cr rr )
  31.     (setq cp (car (setq cr (circumcircle (list (car p) (cadr p) 0.0) (list (caar el) (cadar el) 0.0) (list (caadr el) (cadadr el) 0.0)))) rr (cadr cr))
  32.     (list (mapcar '+ cp (list rr 0.0)) cp rr (list p (car el) (cadr el))) ;;; Added X apex of circumscribed triangle circle as first element of (getcircumcircle) output list ;;;
  33.   )
  34.  
  35.   (defun triangulate-Xsort ( pl / t1 t2 t3 al p el tr l )
  36.     (setq pl (vl-sort pl '(lambda ( a b ) (< (car a) (car b)))))
  37.     (setq t1 (polar cs 0.0 (setq rs (* 4.0 (distance pmin cs))))) ;;; Added 0.0 in polar for rotating supertriangle t1 is max X apex ;;;
  38.     (setq t2 (polar cs (+ 0.0 (/ (* 2.0 pi) 3.0)) rs))
  39.     (setq t3 (polar cs (+ 0.0 (/ (* 4.0 pi) 3.0)) rs))
  40.     (setq al (list (list t1 cs rs (list t1 t2 t3))))
  41.     (while pl
  42.       (setq p (car pl))
  43.       (setq pl (cdr pl))
  44.       (setq el nil)
  45.       (while al
  46.         (setq tr (car al))
  47.         (setq al (cdr al))
  48.         (cond
  49.           ( (< (caar tr) (car p)) ;;; Comparison of X values ;;;
  50.             (setq tl (cons (cadddr tr) tl))
  51.           )
  52.           ( (< (distance p (cadr tr)) (caddr tr))
  53.             (setq el (append (list
  54.                               (list (car (last tr)) (cadr (last tr)))
  55.                               (list (cadr (last tr)) (caddr (last tr)))
  56.                               (list (caddr (last tr)) (car (last tr)))
  57.                             ) el
  58.                     )
  59.             )
  60.           )
  61.           ( t (setq l (cons tr l)) )
  62.         )
  63.       )
  64.       (if l (setq al l l nil))
  65.       (while el
  66.         (if (or (member (reverse (car el)) el)
  67.                (member (car el) (cdr el))
  68.             )
  69.             (setq el (vl-remove (reverse (car el)) el)
  70.                   el (vl-remove (car el) el)
  71.             )
  72.             (setq al (cons (getcircumcircle-Xsort p (car el)) al)
  73.                   el (cdr el)
  74.             )
  75.         )
  76.       )
  77.     )
  78.     (foreach tr al (setq tl (cons (cadddr tr) tl)))
  79.     (setq tl (vl-remove-if '(lambda ( x ) (or (member t1 x) (member t2 x) (member t3 x))) tl))
  80.   ) ;;; end of triangulate X-sort
  81.  
  82.   (defun getcircumcircle-Ysort ( p el / cp cr rr )
  83.     (setq cp (car (setq cr (circumcircle (list (car p) (cadr p) 0.0) (list (caar el) (cadar el) 0.0) (list (caadr el) (cadadr el) 0.0)))) rr (cadr cr))
  84.     (list (mapcar '+ cp (list 0.0 rr)) cp rr (list p (car el) (cadr el))) ;;; Added Y apex of circumscribed triangle circle as first element of (getcircumcircle) output list ;;;
  85.   )
  86.  
  87.   (defun triangulate-Ysort ( pl / t1 t2 t3 al p el tr l )
  88.     (setq pl (vl-sort pl '(lambda ( a b ) (< (cadr a) (cadr b)))))
  89.     (setq t1 (polar cs (/ pi 2.0) (setq rs (* 4.0 (distance pmin cs))))) ;;; Added (/ pi 2.0) in polar for rotating supertriangle t1 is max Y apex ;;;
  90.     (setq t2 (polar cs (+ (/ pi 2.0) (/ (* 2.0 pi) 3.0)) rs))
  91.     (setq t3 (polar cs (+ (/ pi 2.0) (/ (* 4.0 pi) 3.0)) rs))
  92.     (setq al (list (list t1 cs rs (list t1 t2 t3))))
  93.     (while pl
  94.       (setq p (car pl))
  95.       (setq pl (cdr pl))
  96.       (setq el nil)
  97.       (while al
  98.         (setq tr (car al))
  99.         (setq al (cdr al))
  100.         (cond
  101.           ( (< (cadar tr) (cadr p)) ;;; Comparison of Y values ;;;
  102.             (setq tl (cons (cadddr tr) tl))
  103.           )
  104.           ( (< (distance p (cadr tr)) (caddr tr))
  105.             (setq el (append (list
  106.                               (list (car (last tr)) (cadr (last tr)))
  107.                               (list (cadr (last tr)) (caddr (last tr)))
  108.                               (list (caddr (last tr)) (car (last tr)))
  109.                             ) el
  110.                     )
  111.             )
  112.           )
  113.           ( t (setq l (cons tr l)) )
  114.         )
  115.       )
  116.       (if l (setq al l l nil))
  117.       (while el
  118.         (if (or (member (reverse (car el)) el)
  119.                (member (car el) (cdr el))
  120.             )
  121.             (setq el (vl-remove (reverse (car el)) el)
  122.                   el (vl-remove (car el) el)
  123.             )
  124.             (setq al (cons (getcircumcircle-Ysort p (car el)) al)
  125.                   el (cdr el)
  126.             )
  127.         )
  128.       )
  129.     )
  130.     (foreach tr al (setq tl (cons (cadddr tr) tl)))
  131.     (setq tl (vl-remove-if '(lambda ( x ) (or (member t1 x) (member t2 x) (member t3 x))) tl))
  132.   ) ;;; end of triangulate Y-sort
  133.  
  134.   (setq ss (ssget '((0 . "POINT"))))
  135.   (repeat (setq i (sslength ss))
  136.     (setq p (cdr (assoc 10 (entget (ssname ss (setq i (1- i)))))))
  137.     (setq pl (cons p pl))
  138.   )
  139.  
  140.   (setq xmin (caar (vl-sort pl '(lambda ( a b ) (< (car a) (car b))))))
  141.   (setq xmax (caar (vl-sort pl '(lambda ( a b ) (> (car a) (car b))))))
  142.   (setq ymin (cadar (vl-sort pl '(lambda ( a b ) (< (cadr a) (cadr b))))))
  143.   (setq ymax (cadar (vl-sort pl '(lambda ( a b ) (> (cadr a) (cadr b))))))
  144.   (setq cs (list (+ xmin (/ (- xmax xmin) 2.0)) (+ ymin (/ (- ymax ymin) 2.0))))
  145.   (setq pmin (list xmin ymin) pmax (list xmax ymax))
  146.  
  147.   (triangulate-Xsort pl)
  148.   (triangulate-Ysort pl)
  149.  
  150.   (foreach tr (unique tl)
  151.     (entmake
  152.       (list (cons 0 "3DFACE")
  153.         (cons 10 (car tr))
  154.         (cons 11 (car tr))
  155.         (cons 12 (cadr tr))
  156.         (cons 13 (caddr tr))
  157.       )
  158.     )
  159.   )
  160.  
  161.   (princ)
  162. )
  163.  

HTH, M.R.
Regards...
P.S. After all it seems that my efforts in learning triangulation was beneficial at least for my standards...
« Last Edit: April 03, 2015, 02:19:13 PM by ribarm »
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

ribarm

  • Gator
  • Posts: 3225
  • Marko Ribar, architect
Re: Triangulation (re-visited)
« Reply #350 on: March 27, 2015, 03:14:55 PM »
I know this is now odd and slow, but it should handle the cases like this that I've attached...
BTW. Code is now bigger...

Code: [Select]
(defun c:triangulate-MR-EE ( / unique _vl-remove circumcircle getcircumcircle-Xsortmax triangulate-Xsortmax getcircumcircle-Xsortmin triangulate-Xsortmin getcircumcircle-Ysortmax triangulate-Ysortmax getcircumcircle-Ysortmin triangulate-Ysortmin ss i p pl pl1 pl2 pl3 pl4 pl5 xmin xmax ymin ymax cs pmin pmax tl0 tl1 tl2 tl3 tl4 tl5 tl )

  (defun unique ( lst )
    (if lst (cons (car lst) (unique (_vl-remove (car lst) (_vl-remove (list (caar lst) (caddar lst) (cadar lst)) (_vl-remove (list (cadar lst) (caar lst) (caddar lst)) (_vl-remove (list (cadar lst) (caddar lst) (caar lst)) (_vl-remove (list (caddar lst) (caar lst) (cadar lst)) (_vl-remove (list (caddar lst) (cadar lst) (caar lst)) (cdr lst) 1e-6) 1e-6) 1e-6) 1e-6) 1e-6) 1e-6))))
  )

  (defun _vl-remove ( el lst fuzz )
    (vl-remove-if '(lambda ( x ) (and (equal (car x) (car el) fuzz) (equal (cadr x) (cadr el) fuzz) (equal (caddr x) (caddr el) fuzz))) lst)
  )

  (defun circumcircle ( p1 p2 p3 / ang c r )
    (if
      (not
        (zerop
          (setq ang (- (angle p2 p3) (angle p2 p1)))
        )
      )
      (setq c (polar p3 (+ -1.570796326794896 (angle p3 p1) ang) (setq r (/ (distance p1 p3) (sin ang) 2.0)))
           r (abs r)
      )
    )
    (list c r)
  )

  (defun getcircumcircle-Xsortmax ( p el / cp cr rr )
    (setq cp (car (setq cr (circumcircle (list (car p) (cadr p)) (list (caar el) (cadar el)) (list (caadr el) (cadadr el))))) rr (cadr cr))
    (list (mapcar '+ cp (list rr 0.0)) cp rr (list p (car el) (cadr el))) ;;; Added X apex of circumscribed triangle circle as first element of (getcircumcircle) output list ;;;
  )

  (defun triangulate-Xsortmax ( pl / t1 t2 t3 al p el tr l n str )
    (setq pl (vl-sort pl '(lambda ( a b ) (< (car a) (car b)))))
    (setq t1 (polar cs 0.0 (if (setq n (atoi (substr (setq str (rtos (distance pmin cs) 1 0)) (- (strlen str) 2)))) (setq rs (expt 10.0 (+ n 2)))))) ;;; Added 0.0 in polar for rotating supertriangle t1 is max X apex ;;;
    (setq t2 (polar cs (+ 0.0 (/ (* 2.0 pi) 3.0)) rs))
    (setq t3 (polar cs (+ 0.0 (/ (* 4.0 pi) 3.0)) rs))
    (setq al (list (list t1 cs rs (list t1 t2 t3))))
    (while pl
      (setq p (car pl))
      (setq pl (cdr pl))
      (setq el nil)
      (while al
        (setq tr (car al))
        (setq al (cdr al))
        (cond
          ( (< (caar tr) (car p)) ;;; Comparison of X values ;;;
            (setq tl (cons (cadddr tr) tl))
          )
          ( (< (distance p (cadr tr)) (caddr tr))
            (setq el (append (list
                              (list (car (last tr)) (cadr (last tr)))
                              (list (cadr (last tr)) (caddr (last tr)))
                              (list (caddr (last tr)) (car (last tr)))
                            ) el
                    )
            )
          )
          ( t (setq l (cons tr l)) )
        )
      )
      (if l (setq al l l nil))
      (while el
        (if (or (member (reverse (car el)) el)
               (member (car el) (cdr el))
            )
            (setq el (vl-remove (reverse (car el)) el)
                  el (vl-remove (car el) el)
            )
            (setq al (cons (getcircumcircle-Xsortmax p (car el)) al)
                  el (cdr el)
            )
        )
      )
    )
    (foreach tr al (setq tl (cons (cadddr tr) tl)))
    (setq tl (vl-remove-if '(lambda ( x ) (or (member t1 x) (member t2 x) (member t3 x))) tl))
  ) ;;; end of triangulate X-sort max

  (defun getcircumcircle-Xsortmin ( p el / cp cr rr )
    (setq cp (car (setq cr (circumcircle (list (car p) (cadr p)) (list (caar el) (cadar el)) (list (caadr el) (cadadr el))))) rr (cadr cr))
    (list (mapcar '+ cp (list rr 0.0)) cp rr (list p (car el) (cadr el))) ;;; Added X apex of circumscribed triangle circle as first element of (getcircumcircle) output list ;;;
  )

  (defun triangulate-Xsortmin ( pl / t1 t2 t3 al p el tr l n str )
    (setq pl (vl-sort pl '(lambda ( a b ) (> (car a) (car b)))))
    (setq t1 (polar cs pi (if (setq n (atoi (substr (setq str (rtos (distance pmin cs) 1 0)) (- (strlen str) 2)))) (setq rs (expt 10.0 (+ n 2)))))) ;;; Added pi in polar for rotating supertriangle t1 is min X apex ;;;
    (setq t2 (polar cs (+ pi (/ (* 2.0 pi) 3.0)) rs))
    (setq t3 (polar cs (+ pi (/ (* 4.0 pi) 3.0)) rs))
    (setq al (list (list t1 cs rs (list t1 t2 t3))))
    (while pl
      (setq p (car pl))
      (setq pl (cdr pl))
      (setq el nil)
      (while al
        (setq tr (car al))
        (setq al (cdr al))
        (cond
          ( (> (caar tr) (car p)) ;;; Comparison of X values ;;;
            (setq tl (cons (cadddr tr) tl))
          )
          ( (< (distance p (cadr tr)) (caddr tr))
            (setq el (append (list
                              (list (car (last tr)) (cadr (last tr)))
                              (list (cadr (last tr)) (caddr (last tr)))
                              (list (caddr (last tr)) (car (last tr)))
                            ) el
                    )
            )
          )
          ( t (setq l (cons tr l)) )
        )
      )
      (if l (setq al l l nil))
      (while el
        (if (or (member (reverse (car el)) el)
               (member (car el) (cdr el))
            )
            (setq el (vl-remove (reverse (car el)) el)
                  el (vl-remove (car el) el)
            )
            (setq al (cons (getcircumcircle-Xsortmin p (car el)) al)
                  el (cdr el)
            )
        )
      )
    )
    (foreach tr al (setq tl (cons (cadddr tr) tl)))
    (setq tl (vl-remove-if '(lambda ( x ) (or (member t1 x) (member t2 x) (member t3 x))) tl))
  ) ;;; end of triangulate X-sort min

  (defun getcircumcircle-Ysortmax ( p el / cp cr rr )
    (setq cp (car (setq cr (circumcircle (list (car p) (cadr p)) (list (caar el) (cadar el)) (list (caadr el) (cadadr el))))) rr (cadr cr))
    (list (mapcar '+ cp (list 0.0 rr)) cp rr (list p (car el) (cadr el))) ;;; Added Y apex of circumscribed triangle circle as first element of (getcircumcircle) output list ;;;
  )

  (defun triangulate-Ysortmax ( pl / t1 t2 t3 al p el tr l n str )
    (setq pl (vl-sort pl '(lambda ( a b ) (< (cadr a) (cadr b)))))
    (setq t1 (polar cs (/ pi 2.0) (if (setq n (atoi (substr (setq str (rtos (distance pmin cs) 1 0)) (- (strlen str) 2)))) (setq rs (expt 10.0 (+ n 2)))))) ;;; Added (/ pi 2.0) in polar for rotating supertriangle t1 is max Y apex ;;;
    (setq t2 (polar cs (+ (/ pi 2.0) (/ (* 2.0 pi) 3.0)) rs))
    (setq t3 (polar cs (+ (/ pi 2.0) (/ (* 4.0 pi) 3.0)) rs))
    (setq al (list (list t1 cs rs (list t1 t2 t3))))
    (while pl
      (setq p (car pl))
      (setq pl (cdr pl))
      (setq el nil)
      (while al
        (setq tr (car al))
        (setq al (cdr al))
        (cond
          ( (< (cadar tr) (cadr p)) ;;; Comparison of Y values ;;;
            (setq tl (cons (cadddr tr) tl))
          )
          ( (< (distance p (cadr tr)) (caddr tr))
            (setq el (append (list
                              (list (car (last tr)) (cadr (last tr)))
                              (list (cadr (last tr)) (caddr (last tr)))
                              (list (caddr (last tr)) (car (last tr)))
                            ) el
                    )
            )
          )
          ( t (setq l (cons tr l)) )
        )
      )
      (if l (setq al l l nil))
      (while el
        (if (or (member (reverse (car el)) el)
               (member (car el) (cdr el))
            )
            (setq el (vl-remove (reverse (car el)) el)
                  el (vl-remove (car el) el)
            )
            (setq al (cons (getcircumcircle-Ysortmax p (car el)) al)
                  el (cdr el)
            )
        )
      )
    )
    (foreach tr al (setq tl (cons (cadddr tr) tl)))
    (setq tl (vl-remove-if '(lambda ( x ) (or (member t1 x) (member t2 x) (member t3 x))) tl))
  ) ;;; end of triangulate Y-sort max

  (defun getcircumcircle-Ysortmin ( p el / cp cr rr )
    (setq cp (car (setq cr (circumcircle (list (car p) (cadr p)) (list (caar el) (cadar el)) (list (caadr el) (cadadr el))))) rr (cadr cr))
    (list (mapcar '+ cp (list 0.0 rr)) cp rr (list p (car el) (cadr el))) ;;; Added Y apex of circumscribed triangle circle as first element of (getcircumcircle) output list ;;;
  )

  (defun triangulate-Ysortmin ( pl / t1 t2 t3 al p el tr l n str )
    (setq pl (vl-sort pl '(lambda ( a b ) (> (cadr a) (cadr b)))))
    (setq t1 (polar cs (* 3.0 (/ pi 2.0)) (if (setq n (atoi (substr (setq str (rtos (distance pmin cs) 1 0)) (- (strlen str) 2)))) (setq rs (expt 10.0 (+ n 2)))))) ;;; Added (* 3.0 (/ pi 2.0)) in polar for rotating supertriangle t1 is min Y apex ;;;
    (setq t2 (polar cs (+ (* 3.0 (/ pi 2.0)) (/ (* 2.0 pi) 3.0)) rs))
    (setq t3 (polar cs (+ (* 3.0 (/ pi 2.0)) (/ (* 4.0 pi) 3.0)) rs))
    (setq al (list (list t1 cs rs (list t1 t2 t3))))
    (while pl
      (setq p (car pl))
      (setq pl (cdr pl))
      (setq el nil)
      (while al
        (setq tr (car al))
        (setq al (cdr al))
        (cond
          ( (> (cadar tr) (cadr p)) ;;; Comparison of Y values ;;;
            (setq tl (cons (cadddr tr) tl))
          )
          ( (< (distance p (cadr tr)) (caddr tr))
            (setq el (append (list
                              (list (car (last tr)) (cadr (last tr)))
                              (list (cadr (last tr)) (caddr (last tr)))
                              (list (caddr (last tr)) (car (last tr)))
                            ) el
                    )
            )
          )
          ( t (setq l (cons tr l)) )
        )
      )
      (if l (setq al l l nil))
      (while el
        (if (or (member (reverse (car el)) el)
               (member (car el) (cdr el))
            )
            (setq el (vl-remove (reverse (car el)) el)
                  el (vl-remove (car el) el)
            )
            (setq al (cons (getcircumcircle-Ysortmin p (car el)) al)
                  el (cdr el)
            )
        )
      )
    )
    (foreach tr al (setq tl (cons (cadddr tr) tl)))
    (setq tl (vl-remove-if '(lambda ( x ) (or (member t1 x) (member t2 x) (member t3 x))) tl))
  ) ;;; end of triangulate Y-sort min

  (vl-load-com)
  (vla-startundomark (vla-get-activedocument (vlax-get-acad-object)))
  (command "_.UCS" "_W")
  (setq ss (ssget '((0 . "POINT"))))
  (repeat (setq i (sslength ss))
    (setq p (cdr (assoc 10 (entget (ssname ss (setq i (1- i)))))))
    (setq pl (cons p pl))
  )

  (setq xmin (caar (vl-sort pl '(lambda ( a b ) (< (car a) (car b))))))
  (setq xmax (caar (vl-sort pl '(lambda ( a b ) (> (car a) (car b))))))
  (setq ymin (cadar (vl-sort pl '(lambda ( a b ) (< (cadr a) (cadr b))))))
  (setq ymax (cadar (vl-sort pl '(lambda ( a b ) (> (cadr a) (cadr b))))))
  (setq cs (list (/ (+ xmax xmin) 2.0) (/ (+ ymax ymin) 2.0)))
  (setq pmin (list xmin ymin) pmax (list xmax ymax))

  (triangulate-Xsortmax pl)
  (triangulate-Xsortmin pl)
  (triangulate-Ysortmax pl)
  (triangulate-Ysortmin pl)
  (setq tl0 tl tl nil)

  (command "_.UCS" "_Z" 15)
  (setq pl1 (mapcar '(lambda ( p ) (trans p 0 1)) pl))
 
  (setq xmin (caar (vl-sort pl1 '(lambda ( a b ) (< (car a) (car b))))))
  (setq xmax (caar (vl-sort pl1 '(lambda ( a b ) (> (car a) (car b))))))
  (setq ymin (cadar (vl-sort pl1 '(lambda ( a b ) (< (cadr a) (cadr b))))))
  (setq ymax (cadar (vl-sort pl1 '(lambda ( a b ) (> (cadr a) (cadr b))))))
  (setq cs (list (/ (+ xmax xmin) 2.0) (/ (+ ymax ymin) 2.0)))
  (setq pmin (list xmin ymin) pmax (list xmax ymax))

  (triangulate-Xsortmax pl1)
  (triangulate-Xsortmin pl1)
  (triangulate-Ysortmax pl1)
  (triangulate-Ysortmin pl1)
  (setq tl1 tl tl nil)
  (setq tl1 (mapcar '(lambda ( tr ) (list (trans (car tr) 1 0) (trans (cadr tr) 1 0) (trans (caddr tr) 1 0))) tl1))

  (command "_.UCS" "_Z" 15)
  (setq pl2 (mapcar '(lambda ( p ) (trans p 0 1)) pl))
 
  (setq xmin (caar (vl-sort pl2 '(lambda ( a b ) (< (car a) (car b))))))
  (setq xmax (caar (vl-sort pl2 '(lambda ( a b ) (> (car a) (car b))))))
  (setq ymin (cadar (vl-sort pl2 '(lambda ( a b ) (< (cadr a) (cadr b))))))
  (setq ymax (cadar (vl-sort pl2 '(lambda ( a b ) (> (cadr a) (cadr b))))))
  (setq cs (list (/ (+ xmax xmin) 2.0) (/ (+ ymax ymin) 2.0)))
  (setq pmin (list xmin ymin) pmax (list xmax ymax))

  (triangulate-Xsortmax pl2)
  (triangulate-Xsortmin pl2)
  (triangulate-Ysortmax pl2)
  (triangulate-Ysortmin pl2)
  (setq tl2 tl tl nil)
  (setq tl2 (mapcar '(lambda ( tr ) (list (trans (car tr) 1 0) (trans (cadr tr) 1 0) (trans (caddr tr) 1 0))) tl2))

  (command "_.UCS" "_Z" 15)
  (setq pl3 (mapcar '(lambda ( p ) (trans p 0 1)) pl))
 
  (setq xmin (caar (vl-sort pl3 '(lambda ( a b ) (< (car a) (car b))))))
  (setq xmax (caar (vl-sort pl3 '(lambda ( a b ) (> (car a) (car b))))))
  (setq ymin (cadar (vl-sort pl3 '(lambda ( a b ) (< (cadr a) (cadr b))))))
  (setq ymax (cadar (vl-sort pl3 '(lambda ( a b ) (> (cadr a) (cadr b))))))
  (setq cs (list (/ (+ xmax xmin) 2.0) (/ (+ ymax ymin) 2.0)))
  (setq pmin (list xmin ymin) pmax (list xmax ymax))

  (triangulate-Xsortmax pl3)
  (triangulate-Xsortmin pl3)
  (triangulate-Ysortmax pl3)
  (triangulate-Ysortmin pl3)
  (setq tl3 tl tl nil)
  (setq tl3 (mapcar '(lambda ( tr ) (list (trans (car tr) 1 0) (trans (cadr tr) 1 0) (trans (caddr tr) 1 0))) tl3))

  (command "_.UCS" "_Z" 15)
  (setq pl4 (mapcar '(lambda ( p ) (trans p 0 1)) pl))
 
  (setq xmin (caar (vl-sort pl4 '(lambda ( a b ) (< (car a) (car b))))))
  (setq xmax (caar (vl-sort pl4 '(lambda ( a b ) (> (car a) (car b))))))
  (setq ymin (cadar (vl-sort pl4 '(lambda ( a b ) (< (cadr a) (cadr b))))))
  (setq ymax (cadar (vl-sort pl4 '(lambda ( a b ) (> (cadr a) (cadr b))))))
  (setq cs (list (/ (+ xmax xmin) 2.0) (/ (+ ymax ymin) 2.0)))
  (setq pmin (list xmin ymin) pmax (list xmax ymax))

  (triangulate-Xsortmax pl4)
  (triangulate-Xsortmin pl4)
  (triangulate-Ysortmax pl4)
  (triangulate-Ysortmin pl4)
  (setq tl4 tl tl nil)
  (setq tl4 (mapcar '(lambda ( tr ) (list (trans (car tr) 1 0) (trans (cadr tr) 1 0) (trans (caddr tr) 1 0))) tl4))

  (command "_.UCS" "_Z" 15)
  (setq pl5 (mapcar '(lambda ( p ) (trans p 0 1)) pl))
 
  (setq xmin (caar (vl-sort pl5 '(lambda ( a b ) (< (car a) (car b))))))
  (setq xmax (caar (vl-sort pl5 '(lambda ( a b ) (> (car a) (car b))))))
  (setq ymin (cadar (vl-sort pl5 '(lambda ( a b ) (< (cadr a) (cadr b))))))
  (setq ymax (cadar (vl-sort pl5 '(lambda ( a b ) (> (cadr a) (cadr b))))))
  (setq cs (list (/ (+ xmax xmin) 2.0) (/ (+ ymax ymin) 2.0)))
  (setq pmin (list xmin ymin) pmax (list xmax ymax))

  (triangulate-Xsortmax pl5)
  (triangulate-Xsortmin pl5)
  (triangulate-Ysortmax pl5)
  (triangulate-Ysortmin pl5)
  (setq tl5 tl tl nil)
  (setq tl5 (mapcar '(lambda ( tr ) (list (trans (car tr) 1 0) (trans (cadr tr) 1 0) (trans (caddr tr) 1 0))) tl5))

  (setq tl (append tl0 tl1 tl2 tl3 tl4 tl5))

  (foreach tr (unique tl)
    (entmake
      (list (cons 0 "3DFACE")
        (cons 10 (car tr))
        (cons 11 (car tr))
        (cons 12 (cadr tr))
        (cons 13 (caddr tr))
      )
    )
  )

  (command "_.UCS" "_P")
  (command "_.UCS" "_P")
  (command "_.UCS" "_P")
  (command "_.UCS" "_P")
  (command "_.UCS" "_P")
  (command "_.UCS" "_P")
  (vla-endundomark (vla-get-activedocument (vlax-get-acad-object)))
  (princ)
)

M.R.
« Last Edit: April 02, 2015, 11:33:33 AM by ribarm »
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

ymg

  • Guest
Re: Triangulation (re-visited)
« Reply #351 on: March 27, 2015, 04:11:18 PM »
Marko,

I do not understand!

As it is, if I run triangulate  or your version of it
I end up with the same exact triangulation.

Only difference is you are going in Y order
while it was going in x order.

For speed the getcircumcircle function is critical.
Tried as I may, I could not come up with anything
better than Evgenyi had.  I did get a very marginal speedup
by putting it inline with the code instead of calling a function.

Another marginal gain was declaring *-pi/2* as a global
variable.

ymg

ribarm

  • Gator
  • Posts: 3225
  • Marko Ribar, architect
Re: Triangulation (re-visited)
« Reply #352 on: March 27, 2015, 05:04:06 PM »
ymg, the point of my combined bigger code was to make sure triangulation will end with convex boundary... I've just tried my example with much bigger supertriangle on original Evgeniy's code - X sorting and the result was OK... But I don't think it's too much reliable approach if you only scale supertriangle - of course the speed will be good, but in my experience with dealing with point clouds I've only faced with small clouds with just few info gathered from real terrain field... In my opinion the best way to compensate this lack of info is to interpolate point data with triangulation and as you can conclude, this by my opinion must be correctly done enclosing point cloud with correct boundary triangles... Of course one can cut this triangulation to only segment that can be concave cross shaped terrain model or similar, but for my purposes I prefer circular and convex shapes describing terrain segment in wider area shape - zone... With such triangulation, you can successfully continue to gather data as you now have better approximation of terrain and you can make better and bigger sections and describe surface in its entirety with expected surroundings... If I can recall someone searched the way to create convex hull boundary from point cloud to prepare data for next process - triangulation... This is by my opinion unnecessary as triangulation by itself should create convex hull boundary... And if I may say speed gaining in triangulation should be less important than making result of computation correct... If I was to choose to wait and be sure I'll get what I want, I would wait - I for sure can't make manual corrections be better and faster than correct automatic computation of a machine... That's why we all search for good and reliable programming examples and if you can make it faster then it was in the past then success will be greater, but sometime this can't be afforded in compensation for unreliable results...

As for (getcircumcircle) function I think you may find this code also useful... It's not dealing with angles, but pure math - obtaining coordinates of circle circumscribing 3 points...

Code: [Select]
(defun circumcircle3d ( p1 p2 p3 / v^v circumcircleucs zucs p1ucs p2ucs p3ucs cr )

  (defun v^v ( u v )
    (list
      (- (* (cadr u) (caddr v)) (* (cadr v) (caddr u)))
      (+ (- (* (car u) (caddr v))) (* (car v) (caddr u)))
      (- (* (car u) (cadr v)) (* (car v) (cadr u)))
    )
  )

  (defun circumcircleucs ( p1 p2 p3 / D Dcx Dcy c r )
    (setq D (* 4.0 (- (* (- (car p1) (car p2)) (- (cadr p1) (cadr p3))) (* (- (car p1) (car p3)) (- (cadr p1) (cadr p2))))))
    (setq Dcx (* 2.0 (-
                      (* (- (cadr p1) (cadr p3)) (+ (expt (car p1) 2) (expt (cadr p1) 2) (- (expt (car p2) 2)) (- (expt (cadr p2) 2))))
                      (* (- (cadr p1) (cadr p2)) (+ (expt (car p1) 2) (expt (cadr p1) 2) (- (expt (car p3) 2)) (- (expt (cadr p3) 2))))
                    )
             )
    )
    (setq Dcy (* 2.0 (-
                      (* (- (car p1) (car p2)) (+ (expt (car p1) 2) (expt (cadr p1) 2) (- (expt (car p3) 2)) (- (expt (cadr p3) 2))))
                      (* (- (car p1) (car p3)) (+ (expt (car p1) 2) (expt (cadr p1) 2) (- (expt (car p2) 2)) (- (expt (cadr p2) 2))))
                    )
             )
    )
    (setq c (list (/ Dcx D) (/ Dcy D)))
    (setq r (distance c p1))
    (list c r)
  )
 
  (setq zucs (v^v (mapcar '- p2 p1) (mapcar '- p3 p1)))
  (setq p1ucs (trans p1 0 zucs) p2ucs (trans p2 0 zucs) p3ucs (trans p3 0 zucs))
  (setq cr (circumcircleucs p1ucs p2ucs p3ucs))
  (list (trans (list (caar cr) (cadar cr) (caddr p1ucs)) zucs 0) (cadr cr))
)
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

ymg

  • Guest
Re: Triangulation (re-visited)
« Reply #353 on: March 27, 2015, 05:38:51 PM »
Marko,

I agree that the triangulation should return only the convex hull.

But purging the triangle list of any triangle that has one of the
supertriangle vertex in it accomplish the same.

Code: [Select]
; Purge triangle list of any triangle that has a common vertex        ;
; with supertriangle.                                                 ;
   
(setq tl (vl-remove-if-not
             (function
               (lambda (a) (and (< (car a) np)(< (cadr a) np)(< (caddr a) np)))
             )
                     tl
          )
)

What is difficult is not getting the convex hull but getting
the shape of the point cloud.  I have a function Xshape
to do it somewhat interactively, because this problem
is somewhat subjective.

For circumcircle I had tried the pure math approach, it did work
but I rejected it due to the huge speed penalty.

However if you can live with the penalty the approach is
most certainly valid.

ymg


ribarm

  • Gator
  • Posts: 3225
  • Marko Ribar, architect
Re: Triangulation (re-visited)
« Reply #354 on: March 27, 2015, 07:25:38 PM »
Ok, ymg... I've replaced Evgeniy's (getcircumcircle) inside my code :
http://www.theswamp.org/index.php?topic=9042.msg542790#msg542790

It's now a little faster than before, but I think it's reliable enough in finding correct convex boundary triangulation... Still it has multiple calculations for step rotations of UCS by 15 degree and I've added fixed radius of supertriangle (if (setq n (atoi (substr (setq str (rtos (distance pmin cs) 1 0)) (- (strlen str) 2)))) (setq rs (expt 10.0 (+ n 2)))) which is big enough and satisfies the most cases for which (polar) function can obtain correct point coordinates... Yes final triangles are purged from supertriangle, but you can't for sure state that purging will leave convex shape... So this method is little slow, but I think that it's the best of two worlds - speed and reliability of getting correct convex result...
« Last Edit: March 28, 2015, 04:45:42 AM by ribarm »
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

ymg

  • Guest
Re: Triangulation (re-visited)
« Reply #355 on: March 28, 2015, 05:36:51 PM »
Marko,

Once you've removed the triangle containing a vertex
of the supertriangle, you are 100% guaranteed to have
a convex hull.

After that any triangle edge which does not have
its reversed in the edge list is on the convex hull.

However a Graham Scan is faster than searching
for reversed edges, if all you want is a convex hull.

ymg


pedroantonio

  • Guest
Re: Triangulation (re-visited)
« Reply #356 on: March 29, 2015, 02:55:03 AM »
Any news about TriangV0.5.9A.lsp .Any updated version ?

Thanks

ymg

  • Guest
Re: Triangulation (re-visited)
« Reply #357 on: March 29, 2015, 07:13:13 AM »
topographer,

Not working on it at the moment,
needs a big clean-up before attacking
such things as islands or holes in the tin.

ymg

ribarm

  • Gator
  • Posts: 3225
  • Marko Ribar, architect
Re: Triangulation (re-visited)
« Reply #358 on: April 01, 2015, 10:53:53 AM »
Marko,

Once you've removed the triangle containing a vertex
of the supertriangle, you are 100% guaranteed to have
a convex hull.

After that any triangle edge which does not have
its reversed in the edge list is on the convex hull.

However a Graham Scan is faster than searching
for reversed edges, if all you want is a convex hull.

ymg

Yes, ymg I want convex hull within triangulation...
I don't know is there a better solution than this opted for such triangulation...

Code: [Select]
(defun c:triangulate-MR-EE-LM ( / mid LM:Clockwise-p LM:ConvexHull triangulate ss i p pl tl )

  (defun mid ( p1 p2 )
    (mapcar '(lambda ( a b ) (/ (+ a b) 2.0)) p1 p2)
  )

  ;; Clockwise-p  -  Lee Mac
  ;; Returns T if p1,p2,p3 are clockwise oriented or collinear

  (defun LM:Clockwise-p ( p1 p2 p3 )
      (<  (-  (* (- (car  p2) (car  p1)) (- (cadr p3) (cadr p1)))
              (* (- (cadr p2) (cadr p1)) (- (car  p3) (car  p1)))
          )
          1e-8
      )
  )

  ;; Convex Hull  -  Lee Mac
  ;; Implements the Graham Scan Algorithm to return the Convex Hull of a list of points.

  (defun LM:ConvexHull ( lst / ch p0 )
      (cond
          (   (< (length lst) 4) lst)
          (   (setq p0 (car lst))
              (foreach p1 (cdr lst)
                  (if (or (< (cadr p1) (cadr p0))
                          (and (equal (cadr p1) (cadr p0) 1e-8) (< (car p1) (car p0)))
                      )
                      (setq p0 p1)
                  )
              )
              (setq lst
                  (vl-sort lst
                      (function
                          (lambda ( a b / c d )
                              (if (equal (setq c (angle p0 a)) (setq d (angle p0 b)) 1e-8)
                                  (< (distance p0 a) (distance p0 b))
                                  (< c d)
                              )
                          )
                      )
                  )
              )
              (setq ch (list (caddr lst) (cadr lst) (car lst)))
              (foreach pt (cdddr lst)
                  (setq ch (cons pt ch))
                  (while (and (caddr ch) (LM:Clockwise-p (caddr ch) (cadr ch) pt))
                      (setq ch (cons pt (cddr ch)))
                  )
              )
              ch
          )
      )
  )

  (defun triangulate ( pl / pll getcircumcircle xmin xmax ymin ymax cs pmin pmax t1 t2 t3 al p el tr l n str och ich )

    (defun getcircumcircle ( p el / circumcircle cp cr rr )
       
      (defun circumcircle ( p1 p2 p3 / ang c r )
        (if
          (not
            (zerop
              (setq ang (- (angle p2 p3) (angle p2 p1)))
            )
          )
          (setq c (polar p3 (+ -1.570796326794896 (angle p3 p1) ang) (setq r (/ (distance p1 p3) (sin ang) 2.0)))
               r (abs r)
          )
        )
        (list c r)
      )

      (setq cp (car (setq cr (circumcircle (list (car p) (cadr p)) (list (caar el) (cadar el)) (list (caadr el) (cadadr el))))) rr (cadr cr))
      (list (mapcar '+ cp (list rr 0.0)) cp rr (list p (car el) (cadr el))) ;;; Added X apex of circumscribed triangle circle as first element of (getcircumcircle) output list ;;;
    )

    (setq pll pl)
    (setq xmin (caar (setq pl (vl-sort pl '(lambda ( a b ) (< (car a) (car b))))))) ;;; Sorted pl by X ;;;
    (setq xmax (caar (vl-sort pl '(lambda ( a b ) (> (car a) (car b))))))
    (setq ymin (cadar (vl-sort pl '(lambda ( a b ) (< (cadr a) (cadr b))))))
    (setq ymax (cadar (vl-sort pl '(lambda ( a b ) (> (cadr a) (cadr b))))))
    (setq cs (list (+ xmin (/ (- xmax xmin) 2.0)) (+ ymin (/ (- ymax ymin) 2.0))))
    (setq pmin (list xmin ymin) pmax (list xmax ymax))
    (setq t1 (polar cs 0.0 (if (setq n (atoi (substr (setq str (rtos (distance pmin cs) 1 0)) (- (strlen str) 2)))) (setq rs (expt 10.0 (+ n 2)))))) ;;; Added 0.0 in polar for rotating supertriangle t1 is max X apex ;;;
    (setq t2 (polar cs (+ 0.0 (/ (* 2.0 pi) 3.0)) rs))
    (setq t3 (polar cs (+ 0.0 (/ (* 4.0 pi) 3.0)) rs))
    (setq al (list (list t1 cs rs (list t1 t2 t3))))
    (while pl
      (setq p (car pl))
      (setq pl (cdr pl))
      (setq el nil)
      (while al
        (setq tr (car al))
        (setq al (cdr al))
        (cond
          ( (< (caar tr) (car p)) ;;; Comparison of X values ;;;
            (setq tl (cons (cadddr tr) tl))
          )
          ( (< (distance p (cadr tr)) (caddr tr))
            (setq el (append (list
                              (list (car (last tr)) (cadr (last tr)))
                              (list (cadr (last tr)) (caddr (last tr)))
                              (list (caddr (last tr)) (car (last tr)))
                            ) el
                    )
            )
          )
          ( t (setq l (cons tr l)) )
        )
      )
      (if l (setq al l l nil))
      (while el
        (if (or (member (reverse (car el)) el)
               (member (car el) (cdr el))
            )
            (setq el (vl-remove (reverse (car el)) el)
                  el (vl-remove (car el) el)
            )
            (setq al (cons (getcircumcircle p (car el)) al)
                  el (cdr el)
            )
        )
      )
    )
    (foreach tr al (setq tl (cons (cadddr tr) tl)))
    (setq al nil)
    (setq el (mapcar '(lambda ( a b ) (list a b)) (setq och (LM:ConvexHull pll)) (cdr (reverse (cons (car och) (reverse och))))))
    (mapcar '(lambda ( x ) (setq pll (vl-remove x pll))) och)
    (setq ich (LM:ConvexHull pll))
    (foreach e el
      (if (not (vl-some '(lambda ( x ) (and (member (car e) x) (member (cadr e) x))) tl))
        (setq al (cons (getcircumcircle (car (vl-sort ich '(lambda ( a b ) (< (distance a (mid (list (caar e) (cadar e)) (list (caadr e) (cadadr e)))) (distance b (mid (list (caar e) (cadar e)) (list (caadr e) (cadadr e)))))))) e) al))
      )
    )
    (foreach tr al (setq tl (cons (cadddr tr) tl)))
    (setq tl (vl-remove-if '(lambda ( x ) (or (member t1 x) (member t2 x) (member t3 x))) tl))
  ) ;;; end of triangulate

  (setq ss (ssget '((0 . "POINT"))))
  (repeat (setq i (sslength ss))
    (setq p (cdr (assoc 10 (entget (ssname ss (setq i (1- i)))))))
    (setq pl (cons p pl))
  )
  (triangulate pl)
  (foreach tr tl
    (entmake
      (list (cons 0 "3DFACE")
        (cons 10 (car tr))
        (cons 11 (car tr))
        (cons 12 (cadr tr))
        (cons 13 (caddr tr))
      )
    )
  )
  (princ)
)
« Last Edit: April 02, 2015, 11:29:57 AM by ribarm »
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

ymg

  • Guest
Re: Triangulation (re-visited)
« Reply #359 on: April 01, 2015, 01:08:37 PM »
Marko,

The Graham Scan is more than good enough for getting the hull.

Since your point are already ordered it is an O(n)
algorithm.

There is also the Monotone Chain algo which is also O(n)
in the case where the point list is pre-ordered.

However as stated before, you do not really need it,
just remove triangles with a vertex on the supertriangles.

ymg