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

0 Members and 2 Guests are viewing this topic.

ymg

  • Guest
Re: Triangulation (re-visited)
« Reply #195 on: May 31, 2014, 01:56:03 PM »
Sloan will replace subroutine triangulate in the TIN program.

Also notes that triloc is modified.

At this point, unless you want to participate in coding for the Constrained triangulation
there is no point in replacing it, as the old one is faster in the case of  non constrained
triangulation.

ymg

XXL66

  • Newt
  • Posts: 99
Re: Triangulation (re-visited)
« Reply #196 on: June 01, 2014, 02:02:54 AM »
As this is an incremental algorithm i assume you avoid drawing those triangles that overlap the 'fixed' triangles along edges (as you suggested to get started with) whenever the 3 new triangles for a new inserted point are drawn. Not sure tho if in the end the triangulation will be complete ?...


edit: i tested the sloan version with 5000 points

     CDT V0.0.1 - Elapsed time: 47.2370 secs, 9973 3DFACES
     TIN V0.5.5 - Elapsed time: 1.4350 secs, 9964 3DFACES  :-o

The extra triangles seem to be on the outside.


« Last Edit: June 01, 2014, 07:59:44 AM by XXL66 »

ymg

  • Guest
Re: Triangulation (re-visited)
« Reply #197 on: June 01, 2014, 10:41:54 AM »
XXL66,

Result of your test are not surprising.

If you look at the algoritm and the number of subst
that are used in there.

There are a few ways where it could be accelerated
For example bin sort of the points would accelerate
point location.

But the biggest problem is list are not the best when
it comes to updating.

ymg

ymg

  • Guest
Re: Triangulation (re-visited)
« Reply #198 on: June 04, 2014, 05:03:31 PM »
Here is a new routine as well as supporting subfunctions to insert edges into an
existing triangulation.

Has not been tested thoroughly but everything seems OK.

Only possibility is that triloc could enter into a repeating loop
when operating in a Constrained Triangulation.  Will publish a fix for
that later on.

Here is the necessary code:

Code - Auto/Visual Lisp: [Select]
  1. ;;****************************************************************************;
  2. ;; swap          by ymg                                                           ;
  3. ;; Cline & Renka Swap Test                                                    ;
  4. ;;                                                                            ;
  5. ;; Given a triangle defined by three points indices v1, v2, v3                ;
  6. ;; and an index to point p,                                                   ;
  7. ;; Returns T is p is inside circle circumscribing triangle v1 v2 v3.          ;
  8. ;;                                                                            ;
  9. ;;****************************************************************************;
  10.  
  11. (defun swap (v1 v2 v3 p / cosa cosb sina sinb v1 v2 v3
  12.                             x1 x13 x1p x2 x23 x2p x3 xp
  13.                             y1 y13 y1p y2 y23 y2p y3 yp)
  14.    
  15.     (setq  p (nth p pl)  xp (car  p) yp (cadr  p)
  16.           v1 (nth v1 pl) x1 (car v1) y1 (cadr v1)
  17.           v2 (nth v2 pl) x2 (car v2) y2 (cadr v2)
  18.           v3 (nth v3 pl) x3 (car v3) y3 (cadr v3)
  19.          x13 (- x1 x3)  y13 (- y1 y3)
  20.          x23 (- x2 x3)  y23 (- y2 y3)
  21.          x1p (- x1 xp)  y1p (- y1 yp)
  22.          x2p (- x2 xp)  y2p (- y2 yp)
  23.         cosa (+ (* x13 x23) (* y13 y23))
  24.         cosb (+ (* x1p x2p) (* y1p y2p))  
  25.     )            
  26.     (cond
  27.        ((and (not (minusp cosa))(not (minusp cosb))) nil)
  28.        ((and (minusp cosa)(minusp cosb)))
  29.        (t  (setq sina (- (* x13 y23) (* x23 y13))
  30.                  sinb (- (* x2p y1p) (* x1p y2p))
  31.            )    
  32.            (minusp (+ (* sina cosb)(* sinb cosa)))
  33.        )         
  34.     )
  35. )  
  36.  
  37. ;;****************************************************************************;
  38. ;; (topp l v tl nl)                                                           ;
  39. ;;                                                                            ;
  40. ;; Find Triangle Opposed to Vertex v.                                         ;
  41. ;;                                                                            ;
  42. ;; Input: tr Triangle as a list of 3 indices.                                 ;
  43. ;;         v Vertex number  (Must be a member of triangle tr)                 ;
  44. ;'        tl Triangle List                                                    ;
  45. ;;        nl Neighbour List                                                   ;
  46. ;;                                                                            ;
  47. ;;****************************************************************************;
  48.  
  49. (defun topp (tr v tl nl /  ln tr pos)
  50.    (setq ln (nth (vl-position tr tl) nl)
  51.         pos (nth (rem (1+ (vl-position v tr)) 3) ln)
  52.    )     
  53.    (if pos (nth pos tl))
  54. )
  55.  
  56. ;;****************************************************************************;
  57. ;; (Vopp t1 t2)         by ymg                                                ;
  58. ;;                                                                            ;
  59. ;; Find  Opposed  Vertex v.                                                   ;
  60. ;;                                                                            ;
  61. ;; Input: t1 Triangle as a list of 3 Indices.                                 ;
  62. ;;        t2 Opposed Triangle as a list of 3 indices.                         ;
  63. ;;                                                                            ;
  64. ;; Returns Index of Opposed Vertex.                                           ;
  65. ;;                                                                            ;
  66. ;;****************************************************************************;
  67.  
  68. (defun vopp (t1 t2)
  69.    (while (member (car t2) t1)
  70.       (setq t2 (cdr t2))
  71.    )
  72.    (car t2)
  73. )
  74.  
  75. (defun onleft_p (p v1 v2 pl)
  76.    (setq  p (nth p pl)   xp (car  p) yp (cadr  p)
  77.           v1 (nth v1 pl) x1 (car v1) y1 (cadr v1)
  78.           v2 (nth v2 pl) x2 (car v2) y2 (cadr v2)
  79.           x1p (- x1 xp) y1p (- y1 yp)
  80.           x2p (- x2 xp) y2p (- y2 yp)
  81.    )
  82.    (minusp (- (* y1p x2p) (* x1p y2p)))
  83. )
  84.  
  85. ;;****************************************************************************;
  86. ;; trunc     by Gile Chanteau                                                 ;
  87. ;; Retourne la liste tronquée à partir de la première occurrence              ;
  88. ;; de l'expression (liste complémentaire de celle retournée par MEMBER)       ;
  89. ;;                                                                            ;
  90. ;; Arguments                                                                  ;
  91. ;; expr : l'expression recherchée                                             ;
  92. ;; lst : la liste                                                             ;
  93. ;;****************************************************************************;
  94.  
  95. (defun trunc (expr lst)
  96.   (if (and lst
  97.            (not (equal (car lst) expr))
  98.       )
  99.     (cons (car lst) (trunc expr (cdr lst)))
  100.   )
  101. )
  102.  
  103. ;;****************************************************************************;
  104. ;; (triloc p)                                                                 ;
  105. ;;                                                                            ;
  106. ;; Locates triangle which encloses point p using Lawson's Walk.               ;
  107. ;;                                                                            ;
  108. ;; Given p a point, Returns Index in tl of triangle containing the point.     ;
  109. ;; If outside the triangulation Return is nil.                                ;
  110. ;;                                                                            ;
  111. ;; Point List pl and Neigbour List nl are defined outside this routine.       ;
  112. ;; by ymg  August 2013                                                        ;
  113. ;; Optimized Speed and re-organized code January 2014                         ;
  114. ;; Nice but get lost when triangulation is disjointed.                        ;
  115. ;;****************************************************************************;
  116.  
  117. (defun triloc (p pl tl nl / notfound i p1 p2 p3 x x1 x2 x3 y y1 y2 y3)
  118.      
  119.     (if (not tn) (setq tn (/ (length tl) 2)))
  120.     (setq x (car p)  y (cadr p)  notfound t)  
  121.     (while (and notfound tn)        
  122.         (setq   i (nth tn tl)
  123.                p1 (nth (car   i) pl)  p2 (nth (cadr  i) pl) p3 (nth (caddr i) pl)                
  124.               x1x (- (car p1) x)  y1y (- (cadr p1) y)
  125.               x2x (- (car p2) x)  y2y (- (cadr p2) y)
  126.               x3x (- (car p3) x)  y3y (- (cadr p3) y)  
  127.         )      
  128.         (cond
  129.            ((minusp (- (* x1x y2y) (* y1y x2x))) (setq tn (car   (nth tn nl))))
  130.            ((minusp (- (* x2x y3y) (* y2y x3x))) (setq tn (cadr  (nth tn nl))))
  131.            ((minusp (- (* x3x y1y) (* y3y x1x))) (setq tn (caddr (nth tn nl))))          
  132.            ((setq notfound nil))      
  133.         )        
  134.     )  
  135.     tn
  136. )
  137.          
  138. ;;****************************************************************************;
  139. ;; addedge     by ymg                        May   2014                       ;
  140. ;;                                                                            ;
  141. ;; As per paper: An Improved Incremental Algorithm For Constructing           ;
  142. ;;               Restricted Delaunay Triangulations. by Marc Vigo Anglada     ;
  143. ;;                                                                            ;
  144. ;; Arguments: a, Index of point in a triangulation.                           ;
  145. ;;            b, Index second point, defining edge ab to be inserted          ;
  146. ;;                                                                            ;
  147. ;; External Variables tl and nl will be modified.                             ;
  148. ;;                                                                            ;
  149. ;; Will insert an edge in an existing triangulation.  Triangles crossed by    ;
  150. ;; the edge will be deleted.  Cavity will  be re-triangulated to restore      ;
  151. ;; Delaunay's condition. New triangle will be redrawn.                        ;
  152. ;;                                                                            ;
  153. ;;****************************************************************************;
  154.  
  155. (defun addedge (a b / 3df dl newtri pa pb poll polu topo tr v vopo vshr)
  156.    (setq pa (nth a pl)
  157.          pb (nth b pl)
  158.          tn nil
  159.          tn (triloc (polar pa (angle pa pb) 0.001) pl tl nl)
  160.          tr (nth tn tl)
  161.           v a
  162.          dl nil
  163.        vshr (vl-remove v tr)     
  164.    )
  165.    (if (onleft_p (car vshr) a b pl)
  166.       (setq polu (list (car  vshr)) poll (list (cadr vshr)))
  167.       (setq polu (list (cadr vshr)) poll (list (car  vshr)))
  168.    )  
  169.    (while (not (member b tr))
  170.       (setq topo (topp tr v tl nl)
  171.             vopo (vopp tr topo)
  172.             vshr (vl-remove vopo topo)
  173.       )
  174.       (if (onleft_p vopo a b pl)
  175.          (setq polu (cons vopo polu) v (if (onleft_p (car vshr) a b pl) (car vshr) (cadr vshr)))
  176.          (setq poll (cons vopo poll) v (if (not (onleft_p (car vshr) a b pl)) (car vshr) (cadr vshr)))
  177.       )
  178.       (setq dl (cons tr dl) ; dl List of triangle to be deleted               ;
  179.             tr topo
  180.       )
  181.    )
  182.    (setq dl (cons tr dl))   ; Adding last triangle to be deleted              ;
  183.    (setq polu (reverse polu)      poll (reverse poll)
  184.          polu (vl-remove b polu)  poll (vl-remove b poll)
  185.    )
  186.          
  187.    (setq newtri nil)        ; New Triangles will be accumulated in newtri     ;
  188.      (tripol polu a b nil)
  189.      (tripol poll a b t  )
  190.    (foreach tr dl
  191.       (entdel (get_trname tr pl))
  192.       (setq tl (vl-remove tr tl))
  193.    )
  194.    (mk_layer (list "TIN" 8))
  195.    (setq 3df '(0 . "3DFACE"))
  196.    (foreach tr newtri
  197.       (entmakex (list 3df                        
  198.                     (cons 10 (nth (car tr)   pl))
  199.                     (cons 11 (nth (car tr)   pl))
  200.                     (cons 12 (nth (cadr tr)  pl))
  201.                     (cons 13 (nth (caddr tr) pl))
  202.                 )
  203.        )
  204.    )  
  205.    (setq tl (append tl newtri)
  206.          nl (get_neighbour tl)
  207.    )
  208. )
  209.  
  210. ;;****************************************************************************;
  211. ;; tripol                    by ymg                                           ;
  212. ;;                                                                            ;
  213. ;; Arguments: p, list of point index.                                         ;
  214. ;;            a, Index of First point of an Edge.                             ;
  215. ;;            b, Index of Second point of Edge.                               ;
  216. ;;            r, Flag for ccw polygon.                                        ;
  217. ;;                                                                            ;
  218. ;; Will accumulates in external variable newtri the Delaunay's Triangles      ;
  219. ;; formed by the defining Points and Edge.                                    ;
  220. ;;                                                                            ;
  221. ;;****************************************************************************;
  222.  
  223.  
  224. (defun tripol (p a b r / c pe pd v)
  225.    (setq c (car p))
  226.    (if (> (length p) 1)
  227.       (progn
  228.          (foreach v (cdr p)
  229.             (if (swap a b c v)
  230.                (if (not r) (setq c v))
  231.             )  
  232.          )
  233.          (setq pe (trunc c p)
  234.                pd (cdr (member c p))
  235.          )
  236.          (if pe (tripol pe a c r))
  237.          (if pd (tripol pd c b r))
  238.       )
  239.    )
  240.    (if p (setq newtri (cons (list a b c) newtri)))
  241. )
  242.  
  243.  
  244. ;;****************************************************************************;
  245. ;; get_trname                by ymg                                           ;
  246. ;;                                                                            ;
  247. ;; Given a triangle defined as a list of 3 indices into point list,           ;
  248. ;; Returns the ENAME of 3DFACE.                                               ;
  249. ;;                                                                            ;
  250. ;;****************************************************************************;
  251.  
  252. (defun get_trname (tr pl / cn f1 f2 p1 p2 p3 ss x1 x2 x3 y1 y2 y3)
  253.    (setq p1 (nth (car tr) pl) p2 (nth (cadr tr) pl) p3 (nth (caddr tr) pl)
  254.          x1 (car p1) y1 (cadr p1)
  255.          x2 (car p2) y2 (cadr p2)
  256.          x3 (car p3) y3 (cadr p3)
  257.          cn (list (/ (+ x1 x2 x3) 3.) (/ (+ y1 y2 y3) 3.))
  258.          f1 (list (list (min x1 x2 x3) (cadr cn)) cn)  f2 (list cn (list (max x1 x2 x3)(cadr cn)))
  259.          ss (acet-ss-intersection (ssget "_F" f1 '((0 . "3DFACE"))) (ssget "_F" f2 '((0 . "3DFACE"))))
  260.    )     
  261.    (ssname ss 0)
  262. )  
  263.  

To test use the existing triang program, then insert the edges.

Will revise triang so that if edges are present when we select the points
we will first do a Delaunay's Triangulation and then insert all the edges
thus turning it into  a Constrained Delaunay Triangulation.

ymg
« Last Edit: June 04, 2014, 05:15:02 PM by ymg »

ymg

  • Guest
Re: Triangulation (re-visited)
« Reply #199 on: June 04, 2014, 07:13:11 PM »
I did find a bug in the above, will post a revision.

ymg

XXL66

  • Newt
  • Posts: 99
Re: Triangulation (re-visited)
« Reply #200 on: June 05, 2014, 10:20:54 AM »
nice work.

Do i understand correctly that edges are added AFTER the TIN is computed ?

ymg

  • Guest
Re: Triangulation (re-visited)
« Reply #201 on: June 05, 2014, 02:51:41 PM »
XXL66,

Yes they will be added after triangulation, so this way we can use Evgenyi's triangulation.

This is not ideal, as normally inserting edges first would prevent a lot of unnecessary swap
on the stack.  But whatever works !

This being said, there is still a nasty bug in there and possibly a second.
Currently working on a solution.

ymg

XXL66

  • Newt
  • Posts: 99
Re: Triangulation (re-visited)
« Reply #202 on: June 06, 2014, 06:34:53 AM »
hi,

don't you think the removing and adding entities will it slow down to much, wouldn't it be possible to compute the edges with triangle list after triangulation ?
I assume the points for every edge is added before triangulation ?

ymg

  • Guest
Re: Triangulation (re-visited)
« Reply #203 on: June 06, 2014, 03:50:07 PM »
XXL66,

Too early to optimize, just trying to get it going.

Best way would be to start with edges and prevent swap
when you have a fixed edge.

However try as I may, I cannot get Evgenyi's algorithm
to enforce that.

We could do it with Sloan's algorithm but it is way slower
than the other one.

Assuming that breaklines are going to be much fewer than
points, I believe this solution is probably OK.

We shall see.

ymg

ymg

  • Guest
Re: Triangulation (re-visited)
« Reply #204 on: June 06, 2014, 10:18:07 PM »
Managed to lick the bugs I could see.

Here is the revised code:

Code - Auto/Visual Lisp: [Select]
  1. ;;****************************************************************************;
  2. ;; (topp l v tl nl)                                                           ;
  3. ;;                                                                            ;
  4. ;; Find Triangle Opposed to Vertex v.                                         ;
  5. ;;                                                                            ;
  6. ;; Input: tr Triangle as a list of 3 indices.                                 ;
  7. ;;         v Vertex number  (Must be a member of triangle tr)                 ;
  8. ;'        tl Triangle List                                                    ;
  9. ;;        nl Neighbour List                                                   ;
  10. ;;                                                                            ;
  11. ;;****************************************************************************;
  12.  
  13. (defun topp (tr v tl nl /  ln tr pos)
  14.    (setq ln (nth (vl-position tr tl) nl)
  15.         pos (nth (rem (1+ (vl-position v tr)) 3) ln)
  16.    )     
  17.    (if pos (nth pos tl))
  18. )
  19.  
  20. ;;****************************************************************************;
  21. ;; (Vopp t1 t2)         by ymg                                                ;
  22. ;;                                                                            ;
  23. ;; Find  Opposed  Vertex v.                                                   ;
  24. ;;                                                                            ;
  25. ;; Input: t1 Triangle as a list of 3 Indices.                                 ;
  26. ;;        t2 Opposed Triangle as a list of 3 indices.                         ;
  27. ;;                                                                            ;
  28. ;; Returns Index of Opposed Vertex.                                           ;
  29. ;;                                                                            ;
  30. ;;****************************************************************************;
  31.  
  32. (defun vopp (t1 t2)
  33.    (while (member (car t1) t2)
  34.       (setq t1 (cdr t1))
  35.    )
  36.    (car t1)
  37. )
  38.  
  39. (defun onleft_p (p v1 v2)
  40.    (setq  p (nth p pl)   xp (car  p) yp (cadr  p)
  41.           v1 (nth v1 pl) x1 (car v1) y1 (cadr v1)
  42.           v2 (nth v2 pl) x2 (car v2) y2 (cadr v2)
  43.           x1p (- x1 xp) y1p (- y1 yp)
  44.           x2p (- x2 xp) y2p (- y2 yp)
  45.    )
  46.    (minusp (- (* y1p x2p) (* x1p y2p)))
  47. )
  48.  
  49. ;;****************************************************************************;
  50. ;; trunc     by Gile Chanteau                                                 ;
  51. ;; Retourne la liste tronquée à partir de la première occurrence              ;
  52. ;; de l'expression (liste complémentaire de celle retournée par MEMBER)       ;
  53. ;;                                                                            ;
  54. ;; Arguments                                                                  ;
  55. ;; expr : l'expression recherchée                                             ;
  56. ;; lst : la liste                                                             ;
  57. ;;****************************************************************************;
  58.  
  59. (defun trunc (expr lst)
  60.   (if (and lst
  61.            (not (equal (car lst) expr))
  62.       )
  63.     (cons (car lst) (trunc expr (cdr lst)))
  64.   )
  65. )
  66.  
  67. ;;****************************************************************************;
  68. ;; (triloc p)                                                                 ;
  69. ;;                                                                            ;
  70. ;; Locates triangle which encloses point p using Lawson's Walk.               ;
  71. ;;                                                                            ;
  72. ;; Given p a point, Returns Index in tl of triangle containing the point.     ;
  73. ;; If outside the triangulation Return is nil.                                ;
  74. ;;                                                                            ;
  75. ;; Point List pl and Neigbour List nl are defined outside this routine.       ;
  76. ;; by ymg  August 2013                                                        ;
  77. ;; Optimized Speed and re-organized code January 2014                         ;
  78. ;; Nice but get lost when triangulation is disjointed.                        ;
  79. ;;****************************************************************************;
  80.  
  81. (defun triloc (p pl tl nl / notfound i p1 p2 p3 x x1 x2 x3 y y1 y2 y3)
  82.      
  83.     (if (not tn) (setq tn (/ (length tl) 2)))
  84.     (setq x (car p)  y (cadr p)  notfound t)  
  85.     (while (and notfound tn)        
  86.         (setq   i (nth tn tl)
  87.                p1 (nth (car   i) pl)  p2 (nth (cadr  i) pl) p3 (nth (caddr i) pl)                
  88.               x1x (- (car p1) x)  y1y (- (cadr p1) y)
  89.               x2x (- (car p2) x)  y2y (- (cadr p2) y)
  90.               x3x (- (car p3) x)  y3y (- (cadr p3) y)  
  91.         )      
  92.         (cond
  93.            ((minusp (- (* x1x y2y) (* y1y x2x))) (setq tn (car   (nth tn nl))))
  94.            ((minusp (- (* x2x y3y) (* y2y x3x))) (setq tn (cadr  (nth tn nl))))
  95.            ((minusp (- (* x3x y1y) (* y3y x1x))) (setq tn (caddr (nth tn nl))))          
  96.            ((setq notfound nil))      
  97.         )        
  98.     )  
  99.     tn
  100. )
  101.          
  102. ;;****************************************************************************;
  103. ;; addedge     by ymg                        May   2014                       ;
  104. ;;                                                                            ;
  105. ;; As per paper: An Improved Incremental Algorithm For Constructing           ;
  106. ;;               Restricted Delaunay Triangulations. by Marc Vigo Anglada     ;
  107. ;;                                                                            ;
  108. ;; Arguments: a, Index of point in a triangulation.                           ;
  109. ;;            b, Index second point, defining edge ab to be inserted          ;
  110. ;;                                                                            ;
  111. ;; External Variables tl and nl will be modified.                             ;
  112. ;;                                                                            ;
  113. ;; Will insert an edge in an existing triangulation.  Triangles crossed by    ;
  114. ;; the edge will be deleted.  Cavity will  be re-triangulated to restore      ;
  115. ;; Delaunay's condition. New triangle will be redrawn.                        ;
  116. ;;                                                                            ;
  117. ;;****************************************************************************;
  118.  
  119. (defun addedge (a b / 3df dl newtri pa pb poll polu topo tr v vopo vshr)
  120.    (setq pa (nth a pl)
  121.          pb (nth b pl)
  122.          tn nil
  123.          tn (triloc (polar pa (angle pa pb) 0.001) pl tl nl)
  124.          tr (nth tn tl)
  125.           v a
  126.          dl nil polu nil poll nil
  127.    )
  128.    
  129.    (while (not (member b tr))
  130.       (setq topo (topp tr v tl nl)
  131.             vopo (vopp topo tr)
  132.             vshr (vl-remove vopo topo)
  133.       )
  134.       (if (onleft_p vopo a b)
  135.          (setq  v (if (onleft_p (car vshr) a b) (car vshr) (cadr vshr)) polu (cons v polu))
  136.          (setq  v (if (not (onleft_p (car vshr) a b)) (car vshr) (cadr vshr)) poll (cons v poll))
  137.       )
  138.       (setq dl (cons tr dl) ; dl List of triangle to be deleted               ;
  139.             tr topo
  140.       )
  141.    )
  142.    (setq v (car (vl-remove v vshr)))
  143.    (if (onleft_p v a b)
  144.       (setq polu (cons v polu))
  145.       (setq poll (cons v poll))
  146.    )  
  147.    (setq dl (cons tr dl))   ; Adding last triangle to be deleted              ;
  148.    (setq polu (reverse polu)      poll (reverse poll)
  149.          ;polu (vl-remove b polu)  poll (vl-remove b poll)
  150.    )
  151.    (print polu) (print poll)
  152.          
  153.    (setq newtri nil)        ; New Triangles will be accumulated in newtri     ;
  154.      (tripol polu a b   t)
  155.      (tripol poll a b nil)
  156.    (foreach tr dl
  157.       (entdel (get_trname tr pl))
  158.       (setq tl (vl-remove tr tl))
  159.    )
  160.    (mk_layer (list "TIN" 8))
  161.    (setq 3df '(0 . "3DFACE"))
  162.    (foreach tr newtri
  163.       (entmakex (list 3df                        
  164.                     (cons 10 (nth (car tr)   pl))
  165.                     (cons 11 (nth (car tr)   pl))
  166.                     (cons 12 (nth (cadr tr)  pl))
  167.                     (cons 13 (nth (caddr tr) pl))
  168.                 )
  169.        )
  170.    )  
  171.    (setq tl (append tl newtri)
  172.          nl (get_neighbour tl)
  173.    )
  174.    (princ)
  175. )
  176.  
  177. ;;****************************************************************************;
  178. ;; tripol                    by ymg                                           ;
  179. ;;                                                                            ;
  180. ;; Arguments: p, list of point index.                                         ;
  181. ;;            a, Index of First point of an Edge.                             ;
  182. ;;            b, Index of Second point of Edge.                               ;
  183. ;;            r, Flag for ccw polygon.                                        ;
  184. ;;                                                                            ;
  185. ;; Will accumulates in external variable newtri the Delaunay's Triangles      ;
  186. ;; formed by the defining Points and Edge.                                    ;
  187. ;;                                                                            ;
  188. ;;****************************************************************************;
  189.  
  190.  
  191. (defun tripol (p a b r / c pe pd v)
  192.    (setq c (car p))
  193.    (if (> (length p) 1)
  194.       (progn
  195.          (foreach v (cdr p)
  196.             (if (swap a b c v) (setq c v))
  197.          )
  198.          (setq pe (trunc c p)
  199.                pd (cdr (member c p))
  200.          )
  201.          (if pe (tripol pe a c r))
  202.          (if pd (tripol pd c b r))
  203.       )
  204.    )
  205.    (if p (setq newtri (cons (if r (list c b a) (list a b c)) newtri)))
  206. )
  207.  
  208.  
  209. ;;****************************************************************************;
  210. ;; get_trname                by ymg                                           ;
  211. ;;                                                                            ;
  212. ;; Given a triangle defined as a list of 3 indices into point list,           ;
  213. ;; Returns the ENAME of 3DFACE.                                               ;
  214. ;;                                                                            ;
  215. ;;****************************************************************************;
  216.  
  217. (defun get_trname (tr pl / cn f1 f2 p1 p2 p3 ss x1 x2 x3 y1 y2 y3)
  218.    (setq p1 (nth (car tr) pl) p2 (nth (cadr tr) pl) p3 (nth (caddr tr) pl)
  219.          x1 (car p1) y1 (cadr p1)
  220.          x2 (car p2) y2 (cadr p2)
  221.          x3 (car p3) y3 (cadr p3)
  222.          cn (list (/ (+ x1 x2 x3) 3.) (/ (+ y1 y2 y3) 3.))
  223.          f1 (list (list (min x1 x2 x3) (cadr cn)) cn)  f2 (list cn (list (max x1 x2 x3)(cadr cn)))
  224.          ss (acet-ss-intersection (ssget "_F" f1 '((0 . "3DFACE"))) (ssget "_F" f2 '((0 . "3DFACE"))))
  225.    )     
  226.    (ssname ss 0)
  227. )
  228.  
  229. (defun swap (a b c p)
  230.    (setq a (nth a pl) b (nth b pl) c (nth c pl) p (nth p pl)
  231.         c2 (list (car c) (cadr c)) ; c2 is point c but in 2d                  ;
  232.    )
  233.    (if (not (zerop (setq ang (- (angle b c) (angle b a)))))
  234.       (setq cp (polar c2 (+ (angle c a) ang *-pi/2*) (setq r (/ (distance a c2) (sin ang) 2.0)))
  235.              r (abs r)
  236.       )    
  237.    )
  238.    (minusp (- (distance cp p) r))
  239. )          
  240.  

XXL66

  • Newt
  • Posts: 99
Re: Triangulation (re-visited)
« Reply #205 on: June 07, 2014, 07:15:51 AM »
i'm working on a c:cmap function. solids are drawn according layer (representing height). Still some bugs to fix tho.

It seems to work quite fast, as soon i have the known bugs fixed i'll post the code.

XXL66

  • Newt
  • Posts: 99
Re: Triangulation (re-visited)
« Reply #206 on: June 09, 2014, 04:57:44 AM »
Here is the code with a c:gcmap function that creates a gradient color map for a TIN.
It works up to the mm level.

It uses the HUE range from 0 (red) to 200 (magenta) and suggests a 20 level interval however you can select more levels of course (up to 200 color levels).
Currently this hue color range is fixed (0-200), a dialog could be added to make color range user selectable and f.e. lightness and saturation level also.

Solids are drawn in seperate layers according the elevation level, initially i wanted to create layers and draw the solids color BYLAYER.
A legend can be added also later maybe.

Please try it and of course better code suggestions are welcome. I'm not a schooled prgrammer, every coding i learned is self-taught, so there might be some stupid coding in there...

btw: DOSLIB needs to be loaded (color conversion) !



Code: [Select]
;*****************************************************************************;
; Initiated by XXL at TheSwamp                                                ;
;                                                                             ;
; June 2014                                                                   ;
; c:gcmap draws a gradient color map on a TIN                                  ;
; DOSLIB needs to be loaded for 'dos_hlstorgb' function                       ;
;*****************************************************************************;


(defun c:gcmap (/       col_Hb  col_He  col_L   col_S   s       i
       zl      ent     ival    Hue_i   TinMaxZ    TinMinZ    sug_ival
       hue_i
      )

  (setq col_Hb 0)
  ;; color min hue value
  (setq col_He 200)
  ;; color max hue value
  (setq col_L 120)
  ;; color light
  (setq col_S 240)
  ;; color saturation

  ;; select 3DFACES
  (setq s (ssget '((0 . "3DFACE"))))

  ;; make a list from every elevation value in the TIN
  (repeat (setq i (sslength s))
    (setq ent (ssname s (setq i (1- i))))
    (setq
      zl (append
   (mapcar 'cadddr
   (mapcar '(lambda (key) (assoc key (entget ent)))
   '(11 12 13)
   )
   )
   zl
)
    )
  )

  (setq TinMaxZ (apply 'max zl)
;; min TIN elevation
TinMinZ (apply 'min zl)
        ;; max TIN elevation
  )

  ;; compute an interval suggestion for about 20 levels
  (setq sug_ival (/ (- TinMaxZ TinMinZ) 20.0))
  ;; round to mm level
  (setq sug_ival (/ (fix (+ 0.5 (* sug_ival 1000.0))) 1000.0))
 
 
  ;; computed suggestion is rounded
  (cond ((> sug_ival 1.0)
(setq sug_ival (fix sug_ival))
)
((< sug_ival 0.099)
(setq sug_ival (/ (fix (+ 0.5 (* 100.0 sug_ival))) 100.0))
)
((< sug_ival 0.999)
(setq sug_ival (/ (fix (+ 0.5 (* 10.0 sug_ival))) 10.0))
)
  )
 
  ;; get user interval input and verify
  (while (not ival)
    (setq ival
   (getreal
     (strcat
       "\nEnter interval (suggested: "
       (rtos sug_ival 2 3)
       "m): "
     )
   )
    )
    (cond
      ((not ival)
       (setq ival sug_ival)
      )
      (t
       (progn
(if (> (/ (- TinMaxZ TinMinZ) ival) (- col_He col_Hb))
   (progn
     (alert
       "\nEntered interval is too small for color range, please choose a larger interval."
     )
     (setq ival nil)
   )
)
       )
      )
    )
  )
  (prompt (strcat "\nComputing "
  (rtos (/ (- TinMaxZ TinMinZ) ival) 2 0)
  " elevation levels... "
  )
  )
 
  ;; compute Hue increment for each elevation level based on color hue range, TIN delta elevation and interval
  (setq Hue_i (fix (/ (- col_He col_Hb) (/ (- TinMaxZ TinMinZ) ival))))
 
  ;; process every 3DFACE entity from selectionset s
  (repeat (setq i (sslength s))
    (setq ent (ssname s (setq i (1- i))))
    (trfill ent)
  )
  (princ "done.")
  (princ)
)


;; fill every 3DFACE with gradient colors
(defun trfill (e / pl pi1 pi2 pi3 i1 i2 i3 minz maxz dval dval$ cl)
  ;; create pointlist from 3Dface
  (setq
    pl (mapcar
'cdr
(mapcar '(lambda (key) (assoc key (entget e))) '(11 12 13))
       )
  )
  (setq pl (vl-sort pl
    (function (lambda (a b) (< (caddr a) (caddr b))))
   )
  )

  ;; min and max elevation of 3Dface
  (setq minz (caddr (car pl)))
  (setq maxz (caddr (car (reverse pl))))

  (setq dval (* ival (+ 1 (fix (/ minz ival)))))
  (setq dval$ (strcat "SOLID_" (rtos (- dval ival) 2 2)))
  (if (>= dval maxz)
;;; there will be no intersections, colour the entire 3DFACE with a single solid
    (progn
      (setq
cl (rgbtotruecolor
     (dos_hlstorgb
       (+ col_Hb (fix (* (/ (- dval TinMinZ) ival) Hue_i)))
       col_L
       col_S
     )
   )
      )
      (entmake (list (cons 0 "SOLID")
     (cons 8 dval$)
     (cons 420 cl)
     (cons 10 (nth 0 pl))
     (cons 11 (nth 1 pl))
     (cons 12 (nth 2 pl))
     (cons 13 (nth 2 pl))
       )
      )
    )
    (progn
      (while (< dval maxz)
(progn
  (setq
    cl (rgbtotruecolor
(dos_hlstorgb
   (+ col_Hb (fix (* (/ (- dval TinMinZ) ival) Hue_i)))
   col_L
   col_S
)
       )
  )
  (setq
    i2 (inters (nth 0 pl)
       (nth 1 pl)
       (list (car (nth 0 pl)) (cadr (nth 0 pl)) dval)
       (list (car (nth 1 pl)) (cadr (nth 1 pl)) dval)
       t
       )
  )
  (setq
    i1 (inters (nth 0 pl)
       (nth 2 pl)
       (list (car (nth 0 pl)) (cadr (nth 0 pl)) dval)
       (list (car (nth 2 pl)) (cadr (nth 2 pl)) dval)
       t
       )
  )
  (setq
    i3 (inters (nth 1 pl)
       (nth 2 pl)
       (list (car (nth 1 pl)) (cadr (nth 1 pl)) dval)
       (list (car (nth 2 pl)) (cadr (nth 2 pl)) dval)
       t
       )
  )
  (cond ((and i1 i2)
(if (and (not pi1) (not pi2))
   ;; no previous intersections on edges
   (entmake (list (cons 0 "SOLID")
  (cons 8 dval$)
  (cons 420 cl)
  (cons 10 (nth 0 pl))
  (cons 11 i1)
  (cons 12 i2)
  (cons 13 i2)
    )
   )
   (entmake (list (cons 0 "SOLID")
  (cons 8 dval$)
  (cons 420 cl)
  (cons 10 pi1)
  (cons 11 i1)
  (cons 12 pi2)
  (cons 13 i2)
    )
   )
)
(setq pi1 i1
       pi2 i2
)
)
((and i1 i3)
(if (and (not pi1) (not pi2))
   ;; no previous intersections on edges
   (entmake (list (cons 0 "SOLID")
  (cons 8 dval$)
  (cons 420 cl)
  (cons 10 (nth 0 pl))
  (cons 11 i1)
  (cons 12 (nth 1 pl))
  (cons 13 i3)
    )
   )
   (progn
     (entmake (list (cons 0 "SOLID")
    (cons 8 dval$)
    (cons 420 cl)
    (cons 10 pi1)
    (cons 11 i1)
    (cons 12 pi2)
    (cons 13 i3)
      )
     )
     (if (< (caddr pi1) (caddr (nth 1 pl)))
       (entmake (list (cons 0 "SOLID")
      (cons 8 dval$)
      (cons 420 cl)
      (cons 10 pi2)
      (cons 11 i3)
      (cons 12 (nth 1 pl))
      (cons 13 (nth 1 pl))
)
       )
     )

   )
)
(setq pi1 i1
       pi2 i3
)
)

  )
  (setq dval$ (strcat "SOLID_" (rtos dval 2 2)))
  (setq dval (+ ival dval))
  (setq
    cl (rgbtotruecolor
(dos_hlstorgb
  (+ col_Hb (fix (* (/ (- dval TinMinZ) ival) Hue_i)))
   col_L
   col_S
)
       )
  )
  (if (>= dval maxz)
    (progn
      ;; draw last level
      (if i3
(entmake
  (list (cons 0 "SOLID")
(cons 8 dval$)
(cons 420 cl)
(cons 10 pi1)
(cons 11 pi2)
(cons 12 (nth 2 pl))
(cons 13 (nth 2 pl))
  )
)
(entmake
  (list (cons 0 "SOLID")
(cons 8 dval$)
(cons 420 cl)
(cons 10 pi1)
(cons 11 pi2)
(cons 12 (nth 2 pl))
(cons 13 (nth 1 pl))
  )
)
      )
    )
  )
)
      )
    )
  )
  (princ)
)

;; returns a integer for 420 dxf group code, input: rgb list
(defun RGBToTrueColor (rgb / tcol)
  (setq r (lsh (car rgb) 16))
  (setq g (lsh (cadr rgb) 8))
  (setq b (caddr rgb))
  (setq tcol (+ (+ r g) b))
)


(princ)

ymg

  • Guest
Re: Triangulation (re-visited)
« Reply #207 on: June 09, 2014, 10:41:58 AM »
XXL66,

Well done !

You could get a tiny speed improvement, (maybe 0.1 s for 500 faces)
by replacing the 8 entmake with entmakex

ymg

XXL66

  • Newt
  • Posts: 99
Re: Triangulation (re-visited)
« Reply #208 on: June 09, 2014, 11:14:08 AM »
thx,

It helpes indeed but in BCAD very minor, didn't test it in ACAD.
In BCAD 200000 solids takes about 14.539 seconds, with entmake it's 14.789 seconds.

I'm already working on a new function, compute volume based on a grid overlay.
Any ideas on what would be a good approach ?

I tried with your triloc function. Is it correct that this keeps track of the previous found triangle ?
So assuming i go to the next point in the grid and when this is inside of the same triangle, this one is tested first ?













ymg

  • Guest
Re: Triangulation (re-visited)
« Reply #209 on: June 09, 2014, 12:01:16 PM »
XXL66,

I believe volume on a grid overlay are a dead-end.

Did some work with the 3dface (see function voltin)

Essentially, you loft the 3dface down to Elevation 0
then union all of it and you get a volume.

Now for two tin one needs to find the intersecting
area. and compute the volume of each.

Sutracting one volume from the other will give you
your net total volume in cut or fill.

If you color the two solids say green for Initial Ground
condition and magenta for final ground and overlap
both solid you have some feel for where is the fill
and the cut.

ymg