Topic: Triangulation (re-visited)

[ymg]

XXL66,

Post so we can see it.

The only reason for nl or el is to locate the triangle
with the starting vertex of an edge.

Yes there could be alternate way.

ymg

[XXL66]

i also don't do it inline with triangulation, but compute with tl,pl, nl and next draw the 3Dfaces. Thus avoiding removing (searching) and replacing entities.
To find the first triangle of a constraint is use this method (see code as posted earlier), with larger sets this will be probably much faster then triloc because the triangle search list is reduced to in most cases a few triangles.
I add intersection points to the triangulation and thus only remove triangles and modify tl, pl, el instead of complete rebuilding it.

I build cdtl based on vertices only, vertices + points or points only.

It seems to be very stable, even with 'bad' data sets (duplicate points, constraints etc). However with duplicate 2D constraints but different Z you can get a bad result, but garbage in = garbage out.
But also still need to fix a bug when a vertex of a constraint is colinear within another constraint. But this will probably be solved when verifying for constraint intersections, which is needed in any way.

I'll post complete code when cleaned up and optimized.

Code: [Select]

(defun addedge_xxl
       (a b / pnr tl_r pl_a tl_a el_a el_r ac bc ls v ip z cnt tr)
;;;last point position in pl
  (setq pnr  (- (length pl) 1)
;;;triangle list that will be removed
tl_r nil
;;;point list that will be added
pl_a nil
;;;triangle list that will be added
tl_a nil
;;;coordinates of point a, first point of constraint
ac   (nth a pl)
;;;coordinates of point a, second point of constraint
bc   (nth b pl)
  )
;;; skip null length constraints both 2D and 3D
  (if (> (distance ac bc) 0.001)
    (progn
;;; reduce tl to ls that have connection with point a of the constraint
      (setq ls (vl-remove-if-not
'vl-consp
(mapcar '(lambda (x)
    (if (member a x)
      x
    )
  )
tl
)
       )
      )
;;;counter for position in ls
      (setq cnt 0)
;;;loop ls until intersection with opposed edge of point a is found
      (while (not ip)
(setq trr (nth cnt ls))
;;;opposed edge to point a
(if (= (vl-position a trr) 1)
  (setq v (reverse (vl-remove a trr)))
  (setq v (vl-remove a trr))
)
;;;search for intersection of constraint a-b with the triangle edge opposed to point a
(if (setq ip (inters (list (car ac) (cadr ac))
     bc
     (nth (car v) pl)
     (nth (cadr v) pl)
     t
     )
    )
  (progn
;;;add trr to remove list
    (setq tl_r (cons trr tl_r))

[motee-z]

Great job had be done thanks ymg
would you please add chainage start for profile because it always gives zero

[XXL66]

Discovered a bug when using 'rectangular' contraints. Sorting goes wrong in specifc cases.

[ymg]

motee-z

Profile is not complete and eventually there will be an option
for starting chainage.

ymg

[ymg]

Here is an alternative to using triloc for the starting triangle
Based on vl-remove-if-not and do away with nl and el

Code: [Select]

;; startri    by ymg                                                                ;
;; Given index a and b defining an edge                                   ;
;; Will find the starting triangle with a as vertex                        ;
;; Based on orientation of ab                                                  ;

(defun startri (a b / an1 an2 ed found p ref tmp tr trl)
   (setq trl (vl-remove-if-not '(lambda (x) (member a x)) tl))
   (setq  p (nth a pl)
        ref (angle p (nth b pl))
       found nil
   )
   (while (and trl (not found))
      (setq tr (car trl)
           trl (cdr trl)
            ed (vl-remove a tr)
           an1 (if (> (setq tmp (angle p (nth (car  ed) pl))) pi) (- tmp (* 2 pi)) tmp)
           an2 (if (> (setq tmp (angle p (nth (cadr ed) pl))) pi) (- tmp (* 2 pi)) tmp)
      )
      (if (< (min an1 an2)  ref (max an1 an2))
         (setq found t)
      )
   )
   tr
)


ymg

[ymg]

And here an alternate for topp also doing away with nl or el.

Code: [Select]

;;****************************************************************************;
;; (topp tr v)          by ymg                       ;
;;                                                    ;
;; Find Triangle Opposed to Vertex v.                                         ;
;;                                                                            ;
;; Input: tr Triangle as a list of 3 indices.                            ;
;;         v Vertex number  (Must be a member of triangle tr)                 ;
;;        tl Triangle List  (External Variable)                               ;
;;                                                                            ;
;;****************************************************************************;

(defun topp (tr v / ed trl)
   (setq ed (vl-remove v tr)
trl (vl-remove-if-not '(lambda (x) (and (member (car  ed) x) (member (cadr ed) x))) tl)
   )      
   (car (vl-remove tr trl))
) 



[ymg]

Here STARTRI improved, now works with the onleft_p function.

Also includes Version 0.5.9 which do away with the need to update
nl and el, so improved speed.

Code: [Select]

;; startri    by ymg                                                                ;
;; Given index a and b defining an edge                                   ;
;; Will find the starting triangle with a as vertex                        ;
;; Based on orientation of ab                                                  ;

(defun startri (a b / an1 an2 ed found p ref tmp tr trl)
   (setq trl (vl-remove-if-not '(lambda (x) (member a x)) tl))
   (setq  found nil)
   (while (and trl (not found))
      (setq tr (car trl)
           trl (cdr trl)
      )
      (if (and (member a tr) (member b tr))
(setq found t) ; edge already exist
(progn
     (setq ed (list (list (car   tr) (cadr  tr))
    (list (cadr  tr) (caddr tr))
    (list (caddr tr) (car   tr))
      )
   ed (vl-remove-if-not '(lambda (x) (member a x)) ed)
     )    
                 
             (if (and (onleft_p b (caar  ed) (cadar  ed))
      (onleft_p b (caadr ed) (cadadr ed))
)
                (setq found t)
             )
)
      )
   )
   tr
)


[ymg]

Here I have modified so that the breaklines remain on their original layer.

However I bring them to the front of the drawing order on completion of the TIN.
Makes it easier to inspect the triangulation.

Could probably gain some speed by maintaining a list of ename for the 3dfaces.

Now need to implement boundaries and holes.

ymg

[motee-z]

I believe that it is more powerfull if you consider 3d polyline with vertices and points because most times 3d polylines are converted from spline to make edges more dense so 3dpolyline will have too many vertices without points see attachment dwg   

[ymg]

I believe that it is more powerfull if you consider 3d polyline with vertices and points

Don't really understand here, but as it is a constraint cannot add a point to the
triangulation.

Points have to be pre-existing and constraints have to go from nodes to nodes.

ymg

[motee-z]

i know it is not easy to modify but i mean it can be consider vertices of 3d poly line as a beak line instead of points being on 3d poly see attached dwg

[ymg]

motee-z,

Conceptually all you need is to create your point list from the
polylines.  Function LISTPOL will give you that.

Already when you run TIN you may choose between Points
or Blocks.  So we could add an option there for 3dPoly.

Would be handy also if you want to recreate a TIN from contours.

ymg

[ymg]

motee-z,


Here I modified get_constraints to add the points to the point list
instead of rejecting the constraint.

If you load this after you've loaded TRIANG, this will be the one that executes
when you run TIN

This is a fast hack, but it does work on your drawing.

Code - Auto/Visual Lisp: [Select]

1. ;; get_constraints                by ymg                                      ;
2. ;; Modified for motee-z                                                         ;
3.  
4. (defun get_constraints (ss / a b cdtl ent i nfl)
5.    (setq cdtl nil lst nil)
6.    
7.    (if ss
8.       (repeat (setq i (sslength ss))
9.          (setq ent (entget (ssname ss (setq i (1- i)))))
10.          
11.          (if (= (cdr (assoc 0 ent)) "LINE")
12.             (setq a (cdr (assoc 10 ent))
13.                   b (cdr (assoc 11 ent))
14.                   cdtl (cons (list a b) cdtl)
15.                   pl (if (not (vl-position a pl)) (cons a pl) pl)
16.                   pl (if (not (vl-position b pl)) (cons b pl) pl)
17.             )    
18.             (progn
19.                (setq lst (listpol (cdr (assoc -1 ent))))
20.                (foreach p lst
21.                   (setq pl (if (not (vl-position p pl)) (cons p pl) pl))
22.                )         
23.                (setq lst (mapcar '(lambda (a b) (list a b)) lst (cdr lst)))    
24.                (foreach item lst
25.                   (setq cdtl (cons item cdtl))
26.                )         
27.             )
28.          )
29.       )
30.       (alert "There Were No Constraints In Your Selection.")
31.    )
32.  
33.    ;; Re-Sort pl on X and Y Coordinate                                        ;
34.    (setq pl (vl-remove nil pl)
35.          pl (vl-sort pl (function (lambda (a b) (or (< (car a) (car b)) (and (= (car a) (car b)) (< (cadr a) (cadr b)))))))
36.          pl (remduppts pl 0.005)
37.    )   
38.          
39.    (setq lst nil nfl nil)
40.    (if cdtl
41.       (foreach e cdtl
42.          (setq a (vl-position (car e) pl)
43.                a (if (not a) (if (setq a (assoc-fuzz (caar e) pl 0.005)) (vl-position a pl)) a)
44.                b (vl-position (cadr e) pl)
45.                b (if (not b) (if (setq b (assoc-fuzz (caar e) pl 0.005)) (vl-position b pl)) b)
46.              nfl (if (or (not a) (not b)) (cons (list a b) nfl) nfl)
47.              lst (if (and a b) (cons (list a b) lst))
48.          )      
49.       )
50.    )
51.    (if nfl
52.       (msgbox "Triangulation"  64 (strcat  "There Were " (itoa (length nfl)) " Breakline Who"
53.                                            "\nHad An Endpoint Not In The Point Set\n"
54.                                            "\nProceeding With Triangulation"
55.                                            "\nWith Remaining Breaklines.") 5)
56.      
57.    )
58.  
59.    lst
60. )
61.  

On my laptop|:

     TIN - Elapsed time: 3.4470 secs, 3909 3DFACES
     CDT V0.6.0 - Elapsed time: 11.7000 secs, 1941 Constraints

[XXL66]

This is a nice test example for c:gcmap also. In order to add it i was looking for a lisp alternative for dos_hlstorgb and found one from LM on his site. But unfortunally is gives me a bad result ?
Not sure what goes wrong. For speed the DOS_ versions only improves 0.2 seconds.

Code: [Select]

(defun LM:HSL->RGB ( h s l / u v )
    (setq h (/ h 360.0)
          s (/ s 100.0)
          l (/ l 100.0)
    )
    (cond
        (   (zerop s)
            (setq l (fix (+ 0.5 (* 255.0 l))))
            (list l l l)
        )
        (   (zerop l)
           '(0 0 0)
        )
        (   (if (< l 0.5)
                (setq v (* l (1+ s)))
                (setq v (- (+ l s) (* l s)))
            )
            (setq u (- (* 2.0 l) v))
            (mapcar
                (function
                    (lambda ( h )
                        (setq h (rem (1+ h) 1))
                        (cond
                            (   (< (* 6.0 h) 1.0)
                                (fix (+ 0.5 (* 255.0 (+ u (* 6.0 h (- v u))))))
                            )
                            (   (< (* 2.0 h) 1.0)
                                (fix (+ 0.5 (* 255.0 v)))
                            )
                            (   (< (* 3.0 h) 2.0)
                                (fix (+ 0.5 (* 255.0 (+ u (* 6.0 (- (/ 2.0 3.0) h) (- v u))))))
                            )
                            (   (fix (+ 0.5 (* 255.0 u))))
                        )
                    )
                )
                (list (+ h (/ 1.0 3.0)) h (- h (/ 1.0 3.0)))
            )
        )
    )
)
BTW: the drawing contains 4 constraint intersections. Not sure how TIN handles them, seems some are skipped.
(-267634.0 160537.0)
(-267632.0 160625.0)
(-267656.0 160626.0)
(-267739.0 160570.0)