Topic: Triangulation (re-visited)

[ymg]

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 ?

What triloc does is always start from the last triangle it found.

Then tested if points lies to the left of first edge of triangle,
if true we test the second edge and the third. If all three
test are true means we found the triangle.

If at any of the test we find that the point lies to the right
we go to the triangle that has a common edge with the
edge we were testing.

However in a triangulation with constraints the function
is not guaranteed to find it's way, it could enter in a loop.

To fix that we can use the so called "Remembering Stochastic Walk".

This one start testing on a random edge of the triangle under test
and proceed with the same kind of test as above.

This way one is certain that eventually it will find its way.  However
in some degenerate case the walk could be long.

ymg

[XXL66]

hi, thx for the explanation.
How about this method:

http://www.theswamp.org/index.php?topic=43695.msg490059#msg490059

As for the new (red) surface, i suppose this is drawn relative to the zero plane with the differences found between the 2 surfaces. If the 2 surfaces intersect then the zero elevation line on the red surface would represent the intersection line.

[ymg]

Here is some code I had developped with a friend in Spain.

Do test it as I don't remember where I was as to final result.

It uses the interfere method to find the common surface.

Code - Auto/Visual Lisp: [Select]

1. (defun c:voltin (/ *acaddoc* bmax bmin en en3 en4 en5 en6 h i layp layr
2.                    pins pmax pol rmax ss1 ss2 ssprop ssref v1 v2 v3 varl
3.                    volp volr vp vr y)
4.                  
5.    (vl-load-com)
6.  
7.    ;;; Error Handler by ElpanovEvgenyi                                        ;
8.    (defun *error* (msg)
9.         (mapcar 'eval varl)
10.         (if (and msg (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*EXIT*")))
11.            (princ (strcat "\nError: " msg))
12.         )
13.         (and *AcadDoc* (vla-endundomark *AcadDoc*))
14.         (princ)
15.    )
16.      
17.    (setq varl '("CLAYER" "OSMODE" "CMDECHO" "DIMZIN")
18.          varl (mapcar (function (lambda (a) (list 'setvar a (getvar a)))) varl)
19.    )    
20.      
21.    (or *AcadDoc* (setq *AcadDoc* (vla-get-activedocument (vlax-get-acad-object))))
22.            
23.      
24.    (setvar 'CMDECHO 0)
25.    (setvar 'DIMZIN 0)
26.    (setvar 'OSMODE 0)
27.  
28.    (if (and (setq layr (cdr (assoc 8 (entget (car (entsel "\nPick a 3DFACE on Reference Layer: ")))))
29.                   ss1 (ssget "_X" (list '(0 . "3DFACE")(cons 8 layr)))
30.             )
31.             (setq layp (cdr (assoc 8 (entget (car (entsel "\nPick a 3DFACE on Proposed Layer: ")))))
32.                   ss2 (ssget "_X" (list '(0 . "3DFACE")(cons 8 layp)))
33.             )
34.        )    
35.       (progn
36.          (vla-startundomark *AcadDoc*)
37.  
38.          
39.          (setvar 'CLAYER layr)
40.          (setq ssref (ssadd))
41.          (repeat (setq i (sslength ss1))
42.               (setq   en (ssname ss1 (setq i (1- i)))
43.                    ssref (ssadd (3df2sol en) ssref)
44.               )
45.           )
46.           (vl-cmdf "_UNION" ssref "")
47.           (setq en3 (entlast))
48.           (vla-GetBoundingBox (vlax-eName->vla-Object en3) 'rmin 'rmax)
49.           (setq rmax (vlax-SafeArray->List rmax))
50.          
51.           (setvar 'CLAYER layp)
52.           (setq ssprop (ssadd))
53.           (repeat (setq i (sslength ss2))
54.               (setq en (ssname ss2 (setq i (1- i)))
55.                    ssprop (ssadd (3df2sol en) ssprop)
56.               )
57.           )
58.           (vl-cmdf "_UNION" ssprop "")
59.           (setq en4 (entlast))
60.           (vla-GetBoundingBox (vlax-eName->vla-Object en4) 'pmin 'pmax)
61.           (setq pmax (vlax-SafeArray->List pmax))
62.          
63.           (vl-cmdf "_-LAYER" "_M" "SUPERFICIES" "")
64.  
65.           (vl-cmdf "_-INTERFERE" en3 "" en4 "" "_Y")
66.           (setq en5 (entlast))
67.           (vla-GetBoundingBox (vlax-eName->vla-Object en5) 'bmin 'bMax)
68.           (setq bmin (vlax-SafeArray->List bmin)
69.                 bmax (vlax-SafeArray->List bmax)                
70.                 pins (mapcar '/ (mapcar '+ bmin bmax) '(2. 2.))
71.           )
72.          
73.           (vl-cmdf "_-BOUNDARY" "_A" "_B" "_N" en5 "" "_O" "_P" "" pins "" )        
74.           (setq pol (entlast))
75.           (vl-cmdf "_EXTRUDE" pol "" (max (caddr rmax) (caddr pmax)))
76.           (setq pol (entlast))
77.          
78.           (setvar 'CLAYER layr)
79.           (vl-cmdf "_-INTERFERE" en3 "" pol "" "_Y")
80.           (setq volr (entlast))
81.           (setvar 'CLAYER layp)
82.           (vl-cmdf "_-INTERFERE" en4 "" pol "" "_Y")
83.           (setq volp (entlast))
84.           (entdel pol)
85.          
86.           (setq vr (vlax-get-property (vlax-ename->vla-object volr) 'Volume)
87.                 vp (vlax-get-property (vlax-ename->vla-object volp) 'Volume)
88.           )
89.           (setvar 'CLAYER layr)
90.           (setq y (cadr bmin)
91.                 h (* (getvar 'TEXTSIZE) 1.5)
92.           )      
93.           (vl-cmdf "_text" "_J" "_MC" (list (car pins) y)         0 (strcat "Reference Volume: " (rtos vr 2 1) " m3"))
94.           (setq v1 (entlast))
95.           (setvar 'CLAYER layp)
96.           (vl-cmdf "_text" "_J" "_MC" (list (car pins) (- y h))   0 (strcat " Proposed Volume: " (rtos vp 2 1) " m3"))
97.           (setq v2 (entlast))          
98.           (if (> vr vp) (setvar 'CLAYER layr))          
99.           (vl-cmdf "_text" "_J" "_MC" (list (car pins) (- y h h)) 0 (strcat "      Net Volume: " (rtos (- vr vp) 2 1) " m3"))
100.           (setq v3 (entlast))
101.           (vl-cmdf "_MOVE" volp volr v1 v2 v3 "" pins pause)
102.           (vl-cmdf "_VSCURRENT" "_S" "")
103.       )      
104.    )  
105.    (*error* nil)
106. )
107.  
108. ;; 3df2sol                                                                    ;
109. ;; Given a 3DFACE Loft it Down to Elevation 0                                 ;
110. ;; Returns the ename of the Solid created.                                    ;
111.  
112. (defun 3df2sol (en / en1 en2 p1 p2 p3 p4)
113.    (setq  ent (entget en)
114.            p1 (cdr (assoc 10 ent))
115.            p2 (cdr (assoc 11 ent))
116.            p3 (cdr (assoc 12 ent))
117.            p4 (cdr (assoc 13 ent))
118.    )
119.    
120.    (setq en1 (entmakex
121.                 (list
122.                   (cons 0 "3DFACE")  
123.                   (cons 10 (list (car p1) (cadr p1) 0.))
124.                   (cons 11 (list (car p2) (cadr p2) 0.))
125.                   (cons 12 (list (car p3) (cadr p3) 0.))
126.                   (cons 13 (list (car p4) (cadr p4) 0.))
127.                 )
128.              )
129.    )
130.    (vl-cmdf "_loft" en  en1 "_MO" "_SOLID" "" "")
131.    (entlast)
132. )  
133.  

[XXL66]

hi,

thx, but this is based on solids. I have similar code that computes in fact the volume of the prism's, it's  basicly the same method.

[ymg]

XXL66,

If you cannot go the Solid Way,  you will have to compute
the intersecting polyline between the two surfaces.

This will creates some surfaces that are not 3dface
on the perimeter.  However you still can compute
their volume by Average End Area.

It can be done but it's messy .

How about posting the code you have,
we may get ideas out of it.

ymg

[XXL66]

The code i have is written in c++ (and i'm very bad c coder...), it works and gives a good result but the results cannot be displayed graphical in any way...
It just computes the differences from the union.

I think the example method is the way to go, compute the red surface, so this is (i think) a new computed triangulation based on every intersecting 3Dface point and the existing points (overlapping).

However problems may arrise when the original surfaces are constraint. So you would have to include the constraints into the new surface too.

btw: does your edge solution work with ElpanovEvgenyi triangulation method ?

[XXL66]

As for the edges i also have created c++ code (long time ago) that computes the intersections and draws 2 new triangles (in case of one 3dface edge intersection) and 3 new triangles (in case of 2 two edge 3dface intersection).

It is however slow, i would like to do this in lisp (no need for recompilation for every bcad/acad) but for optimization work woth an index list of some sort...


Notice that in this case 2 or more neighbouring 3dface's might be in the same plane (this could be improved by join it to a single one.

[ymg]

XXL66,

btw: does your edge solution work with ElpanovEvgenyi triangulation method

Yes it does.  However as told, I need to change TRILOC some in order for it to
work correctly in a CDT.

Another bottleneck is that presently I recompute the List of neighours after each
insertions.  Will replace by an adjustment of the list.

Also instead of deleting the triangles in the cavity formed by the inserted edge
I could substitute the new triangles.

But I've been lazy this week.

ymg

[XXL66]

lazy, maybe because of the weather ? It's hot here ! Just enjoyed i nice belgian beer...

CDT ? what's that ?

any ideas for the fastest method to find the list position in tl that contain a certain pt indexnr ?

f.e.
: !tl
((2 1 0) (3 1 2) (4 1 3) (6 4 3) (5 1 4) (7 6 3) (9 3 (9 7 3) (8 3 2) (11 5 10) (10 5 4) (10 4 6) (12 6 7) (12 7 9) (12 9 (13 6 12) (13 10 6) (14 12 (15 13 14) (15 10 13) (15 11 10) (8 2 0) (14 13 12))
: (mapcar '(lambda (x) (member 2 x)) tl)
((2 1 0) (2) NIL NIL NIL NIL NIL NIL (2) NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL (2 0) NIL)

if would like a list of position numbers  (0 1 8 21) in this case

...

[ymg]

CDT ? what's that ?

CDT is a Constrained Delaunay Triangulation

Code: [Select]

(setq temp (vl-remove nil (mapcar '(lambda (x) (if (member 2 x) x)) tl)))
(foreach p temp
   (setq l (cons (vl-position p tl) l))
)


((2 1 0) (3 1 2) (8 3 2) (8 2 0))
(21 8 1 0)

[XXL66]

thx,

btw: is there a 'inters' function that works 2D only ?

[ymg]

Here is TRILOC modified to operates in a CDT:

Code - Auto/Visual Lisp: [Select]

1. ;;****************************************************************************;
2. ;; (triloc p)                                                                 ;
3. ;;                                                                            ;
4. ;; Locates triangle which encloses point p using Remembering Stochastic Walk. ;
5. ;;                                                                            ;
6. ;; Given p a point, Returns Index in tl of triangle containing the point.     ;
7. ;; If outside the triangulation Return is nil.                                ;
8. ;;                                                                            ;
9. ;; Point List pl and Neigbour List nl are defined outside this routine.       ;
10. ;; by ymg  August 2013                                                        ;
11. ;; Optimized Speed and re-organized code January 2014                         ;
12. ;; Nice but get lost when triangulation is disjointed.                        ;
13. ;;****************************************************************************;
14.  
15. (defun triloc (p pl tl nl / notfound i p1 p2 p3 x x1 x2 x3 y y1 y2 y3)
16.      
17.     (if (not tn) (setq tn (/ (length tl) 2)))
18.     (setq x (car p)  y (cadr p)  notfound t)  
19.     (while (and notfound tn)        
20.         (setq   i (nth tn tl)
21.                p1 (nth (car   i) pl)  p2 (nth (cadr  i) pl) p3 (nth (caddr i) pl)                
22.               x1x (- (car p1) x)  y1y (- (cadr p1) y)
23.               x2x (- (car p2) x)  y2y (- (cadr p2) y)
24.               x3x (- (car p3) x)  y3y (- (cadr p3) y)
25.                 e (fix (mrand 3))
26.         )
27.         (cond
28.            ((= e 0)  (cond
29.                        ((minusp (- (* x1x y2y) (* y1y x2x))) (setq tn (car   (nth tn nl))))
30.                        ((minusp (- (* x2x y3y) (* y2y x3x))) (setq tn (cadr  (nth tn nl))))
31.                        ((minusp (- (* x3x y1y) (* y3y x1x))) (setq tn (caddr (nth tn nl))))          
32.                        ((setq notfound nil))      
33.                      ))
34.            ((= e 1)  (cond
35.                        ((minusp (- (* x2x y3y) (* y2y x3x))) (setq tn (cadr  (nth tn nl))))
36.                        ((minusp (- (* x3x y1y) (* y3y x1x))) (setq tn (caddr (nth tn nl))))
37.                        ((minusp (- (* x1x y2y) (* y1y x2x))) (setq tn (car   (nth tn nl))))
38.                        ((setq notfound nil))      
39.                      ))
40.           ((= e 2)  (cond
41.                        ((minusp (- (* x3x y1y) (* y3y x1x))) (setq tn (caddr (nth tn nl))))
42.                        ((minusp (- (* x1x y2y) (* y1y x2x))) (setq tn (car   (nth tn nl))))
43.                        ((minusp (- (* x2x y3y) (* y2y x3x))) (setq tn (cadr  (nth tn nl))))
44.                        ((setq notfound nil))      
45.                      ))
46.         )  
47.     )  
48.     tn
49. )
50.  

Also modified TRIPOL so that the triangles formed will always be CCW:

Code - Auto/Visual Lisp: [Select]

1. ;;****************************************************************************;
2. ;; tripol                    by ymg                                           ;
3. ;;                                                                            ;
4. ;; Arguments: p, list of point index.                                         ;
5. ;;            a, Index of First point of an Edge.                             ;
6. ;;            b, Index of Second point of Edge.                               ;
7. ;;            r, Flag for ccw polygon.                                        ;
8. ;;                                                                            ;
9. ;; Will accumulates in external variable newtri the Delaunay's Triangles      ;
10. ;; formed by the defining Points and Edge.                                    ;
11. ;;                                                                            ;
12. ;;****************************************************************************;
13.  
14.  
15. (defun tripol (p a b r / c pe pd v)
16.    (setq c (car p))
17.    (if (> (length p) 1)
18.       (progn
19.          (foreach v (cdr p)
20.             (if (swap a b c v) (setq c v))
21.          )
22.          (setq pe (trunc c p)
23.                pd (cdr (member c p))
24.          )
25.          (if pe (tripol pe a c r))
26.          (if pd (tripol pd c b r))
27.       )
28.    )
29.    (if p (setq newtri (cons (if r (list a b c)(list c b a)) newtri)))
30. )
31.  

[ymg]

btw: is there a 'inters' function that works 2D only ?

No, but I believe if a single point is 2d, inters will give you 2d

ymg

[ribarm]

thx,

btw: is there a 'inters' function that works 2D only ?

Modify this code :
http://www.theswamp.org/index.php?topic=46848.msg518851#msg518851

M.R.

[XXL66]

btw: is there a 'inters' function that works 2D only ?

No, but I believe if a single point is 2d, inters will give you 2d

ymg

This seems to be correct.

I'm trying to add adges but before the triangles are drawn. It seems that you use a fence selection on the 3dfaces ? Is that correct ?

However to learn more about the program is did a test with 4 points

: !tl
((2 0 1) (3 2 1))

2 triangles = OK

: !pl
((4522.88 5437.91 59.1125) (4525.7 5431.95 55.493) (4533.9 5442.11 58.5841) (4536.59 5429.13 58.079))

4 points = OK

: !nl
((1 8 7) (6 NIL 0) (7 8 3) (5 2 4) (3 NIL 6) (6 7 3) (4 1 5) (0 2 5) (0 NIL 2))
: !el
((2 5) (5 0) (0 2) (2 4) (4 5) (5 2) (1 0) (0 6) (6 1) (3 1) (1 6) (6 3) (3 6) (6 4) (4 3) (3 2) (2 1) (1 3) (3 4) (4 2) (2 3) (2 0) (0 1) (1 2) (0 5) (5 6) (6 0))

Can you explain nl and el ?