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

ribarm · « **Reply #360 on:** April 01, 2015, 02:01:03 PM »

Quote from: ymg on April 01, 2015, 01:08:37 PM

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

ymg

That's correct, but how can you guarantee that supertriangle is good and big enough to make such conclusion...

Look in my attachments...

M.R.

ymg · « **Reply #361 on:** April 01, 2015, 05:12:34 PM »

Marko,

There is an alternative to supertriangle.

You could start the triangulation with points p1 and p2 plus an infinite point. (Ray)
You would have triangle p1 p2 pinf and p2 p1 pinf as a start.

I've never tried it myself, but see the comments by Wolfgang Ortmann
at bottom of this page : http://www.codeguru.com/cpp/cpp/algorithms/general/article.php/c8901/Delaunay-Triangles.htm

ymg

ribarm · « **Reply #362 on:** April 01, 2015, 06:18:19 PM »

I've developed my variant to satisfy all possibilities - now should make convex triangulation in my opinion no matter how points are distributed...

[EDIT : Even better optimized LM:Convex Hull subfunction for this purpose - triangulation]

Code - Auto/Visual Lisp: [Select]

(defun c:triangulate-MR-EE-LM ( / mid 3D->2D MR:Collinear-p LM:Clockwise-p LM:ConvexHull triangulate ss i p pl ell tl z )
 
  (defun mid ( p1 p2 )
    (mapcar '(lambda ( a b ) (/ (+ a b) 2.0)) p1 p2)
  )
 
  ;; 3D to 2D point  -  M.R.
  ;; Returns 2D point list from supplied 3D point list or returns supplied argument if it isn't 3D point list
 
  (defun 3D->2D ( p )
      (if (and (listp p) (vl-every '(lambda ( x ) (eq (type x) 'REAL)) p) (eq (length p) 3))
          (list (car p) (cadr p))
          p
      )
  )
 
  ;; Collinear-p  -  M.R.
  ;; Returns T if p1,p2,p3 are collinear
 
  (defun MR:Collinear-p ( p1 p2 p3 )
      (equal  (distance p1 p3)
              (+ (distance p1 p2) (distance p2 p3))
          1e-8
      )
  )
 
  ;; 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))
                                  (< (if (equal c (* 2.0 pi) 1e-8) 0.0 c) (if (equal d (* 2.0 pi) 1e-8) 0.0 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) (not (MR:Collinear-p (3D->2D (caddr ch)) (3D->2D (cadr ch)) (3D->2D pt))))
                      (setq ch (cons pt (cddr ch)))
                  )
              )
              ch
          )
      )
  )
 
  (defun triangulate ( pl factor / tl pll getcircumcircle xmin xmax ymin ymax cs pmin pmax t1 t2 t3 al p el tr l n str och ich iche i )
 
    (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 (3D->2D p) (3D->2D (car el)) (3D->2D (cadr 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 factor (+ n 2)))))) ;;; Added 0.0 in polar for rotating supertriangle t1 is max X apex ;;;
    ;;(setq t1 (polar cs 0.0 (setq rs (* 2.0 factor (distance pmin cs)))))
    (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 tl (vl-remove-if '(lambda ( x ) (or (member t1 x) (member t2 x) (member t3 x))) tl))
    (setq pl pll)
    (if (null ell)
      (progn
        (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))
      )
    )
    (if ich
      (progn
        (setq ell t)
        (foreach e el
          (if (not (vl-some '(lambda ( x ) (and (member (car e) x) (member (cadr e) x))) tl))
            (progn
              (setq ich (vl-sort ich '(lambda ( a b ) (< (distance a (mid (3D->2D (car e)) (3D->2D (cadr e)))) (distance b (mid (3D->2D (car e)) (3D->2D (cadr e))))))))
              (setq iche (vl-remove-if '(lambda ( x ) (> (distance x (mid (3D->2D (car e)) (3D->2D (cadr e)))) (distance (car e) (mid (3D->2D (car e)) (3D->2D (cadr e)))))) ich))
              (foreach p iche
                (if (or
                      (and
                        (vl-some '(lambda ( x ) (if (and (member (car e) x) (member p x)) (setq tr x))) tl)
                        (vl-some '(lambda ( x ) (and (member (car e) x) (member p x))) (vl-remove tr tl))
                      )
                      (and
                        (vl-some '(lambda ( x ) (if (and (member (cadr e) x) (member p x)) (setq tr x))) tl)
                        (vl-some '(lambda ( x ) (and (member (cadr e) x) (member p x))) (vl-remove tr tl))
                      )
                    )
                    (setq iche (vl-remove p iche))
                )
              )
              (setq i (length iche))
              (setq iche (cons (car e) iche) iche (cons (cadr e) iche))
              (if (null z)
                (setq z 10.0)
              )
              (setq z
                (cond
                  ( (<= i (length (car (triangulate iche 10.0))))
                    (if (>= z 10.0)
                      z
                      (setq z 10.0)
                    )
                  )
                  ( (<= i (length (car (triangulate iche 25.0))))
                    (if (>= z 25.0)
                      z
                      (setq z 25.0)
                    )
                  )
                  ( (<= i (length (car (triangulate iche 50.0))))
                    (if (>= z 50.0)
                      z
                      (setq z 50.0)
                    )
                  )
                  ( (<= i (length (car (triangulate iche 100.0))))
                    (if (>= z 100.0)
                      z
                      (setq z 100.0)
                    )
                  )
                  ( (<= i (length (car (triangulate iche 250.0))))
                    (if (>= z 250.0)
                      z
                      (setq z 250.0)
                    )
                  )
                  ( (<= i (length (car (triangulate iche 500.0))))
                    (if (>= z 500.0)
                      z
                      (setq z 500.0)
                    )
                  )
                  ( (<= i (length (car (triangulate iche 1000.0))))
                    (if (>= z 1000.0)
                      z
                      (setq z 1000.0)
                    )
                  )
                )
              )
            )
          )
        )
      )
    )
    (list tl z)
  ) ;;; 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))
  )
  (setq z (cadr (triangulate pl 10.0)))
  (foreach tr (car (triangulate pl z))
    (entmake 
      (list (cons 0 "3DFACE")
        (cons 10 (car tr))
        (cons 11 (car tr))
        (cons 12 (cadr tr))
        (cons 13 (caddr tr))
      ) 
    ) 
  )
  (princ)
)
 

ribarm · « **Reply #363 on:** April 02, 2015, 05:50:07 AM »

I had modified my last code further more... Had to change Lee's Convex Hull subfunction to include collinear points along Hull...
I think that now is fine, test it and if you find some bug, please inform us...

Regards, M.R.

lamarn · « **Reply #364 on:** April 02, 2015, 05:58:25 AM »

Will do! Thanks..

lamarn · « **Reply #365 on:** April 02, 2015, 06:18:00 AM »

I tried it on a vertical en horizontal node model.
Seems so create some strange 3D faces .. (?)
Hope it helps you a bit futher

ribarm · « **Reply #366 on:** April 02, 2015, 07:18:08 AM »

I don't understand, triangulation is planar algorithm that can be applied to 3D points to form TOP view triangulated surface... I've changed again Convex Hull sub - checking collinear positions of 2D projected points as Convex Hull sub is also planar algorithm that can be also applied on 3D points... This intervention may fix some bugs, but I don't know what do you want to achieve with vertical triangulation... You can make it normal WCS oriented and then if you want you can rotate 3d FACES in 3D space using rotate3d command...

ribarm · « **Reply #367 on:** April 02, 2015, 11:03:24 AM »

I've noticed also that when supplied to (circumcircle) subfunction 3D points as arguments with Z=0.0 there is some sort of bug in triangulation... So I've changed this to supply only 2D points inside (getcircumcircle) to (circumcircle) subfunction... So, please retest the code again and inform me if something's also wrong...

Regards...

ymg · « **Reply #368 on:** April 02, 2015, 05:34:47 PM »

Marko,

When you use the polar function in getcircumcircle is
where you need your 2d point.

Another way to insure your convex hull would be to
normalize the points on the interval 0,1

Also has the advantage of adding to the accuracy,
specially when using big coordinates.

ymg

ribarm · « **Reply #369 on:** April 04, 2015, 04:30:32 AM »

ymg, can you show your implementation if you are not busy... I've cleaned and updated once again all my posted codes, and I've changed animated gif along with its example...

lamarn, if you still have trouble with your point cloud, can you upload your example to us to try to fix where the problem occur - maybe final Convex triangulation code needs more cleaning...

M.R.

ymg · « **Reply #370 on:** April 04, 2015, 06:40:15 PM »

Marko,

What I mean by normalizing the point list is this:

Code - Auto/Visual Lisp: [Select]

          (setq bb (list (apply 'mapcar (cons 'min pl))
                          (apply 'mapcar (cons 'max pl))
                        )
               xmin (caar bb)       
               xmax (caadr bb)      
               ymin (cadar bb)      
               ymax (cadadr bb)
               dmax (max (- xmax xmin)(- ymax ymin)) 
                 ; Points are Scaled to 1 along Max of x and y dimensions     ;
                 pl (mapcar
                       (function
                           (lambda (a) (list (/ (- (car a) xmin) dmax)
                                             (/ (- (cadr a) ymin) dmax)
                                             (caddr a)
                                       )
                           )        
                       )
                       pl
                    )
 

Then before outputting the triangle, you reverse the process:

Code - Auto/Visual Lisp: [Select]

(setq pl (mapcar
                     (function
                         (lambda (a) (list (+ (* (car  a) dmax) xmin)
                                           (+ (* (cadr a) dmax) ymin)
                                           (caddr a)
                                     )
                         )
                      )  
                      pl
                  )
         )
 

For the circumcircle function, I've removed the call to a routine
and put the code inline.

Code - Auto/Visual Lisp: [Select]

;Removes doubled edges, computes circumcircles and add them to al ;
            
            (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)
                 )
                 (progn  ; This replaces call to getcircumcircle function     ;
                      (setq p (nth n pl)
                            b (nth (caar el) pl)
                            c (nth (cadar el) pl)
                            c (list (car c) (cadr c)) ; Point c has to be 2d
                           vl (list n (caar el) (cadar el)) 
                      )
                      (if (not (zerop (setq ang (- (angle b c) (angle b p)))))
                         (setq cp (polar c (+ *-pi/2* (angle c p) ang)(setq r (/ (distance p c) (sin ang) 2.0))) 
                               al (cons (list (+ (car cp) (abs r)) cp (abs r) vl) al)
                               el (cdr el)
                         ) 
                      ) 
                 ) 
               )
            )
 

ymg

ribarm · « **Reply #371 on:** April 06, 2015, 11:01:15 AM »

I've added here :

http://www.theswamp.org/index.php?topic=9042.msg543147#msg543147

The second better optimized code for Convex Hull variant - it should be faster than previous one especially on larger point clouds...

Regards and thanks for the input ymg, although I think that now it's not necessary to make such implementation - maybe in your versions...

ymg · « **Reply #372 on:** April 06, 2015, 01:14:32 PM »

Marko,

I do not scale the point list in my implementation.

It is however done by Sloan and also by Shewchuk.

As I told you, you gain some accuracy specially
if your point are like (5356897.235 287561.236 99.63)

The important thing is to know about the limitation
of any algorithm.

ymg

ribarm · « **Reply #373 on:** April 29, 2015, 01:56:03 PM »

Now that I saw your newest version of TriangV0.6.2.6 I saw that you used LOFT command to create 3DSOLIDs and by my tests it's faster 10% than my previous version with EXTRUDE "D"... Still I am using my version of convex triangulation as base for creating single terrain 3DSOLID... Here is the code and if you have some remarks how to make it even faster I am all your ears...

Code - Auto/Visual Lisp: [Select]

(defun c:terrain ( / mid 3D->2D MR:Collinear-p LM:Clockwise-p LM:ConvexHull triangulate 3df2sol ss i p pl elmin elevmin ss3f ti ell z )
 
  (defun mid ( p1 p2 )
    (mapcar '(lambda ( a b ) (/ (+ a b) 2.0)) p1 p2)
  )
 
  ;; 3D to 2D point  -  M.R.
  ;; Returns 2D point list from supplied 3D point list or returns supplied argument if it isn't 3D point list
 
  (defun 3D->2D ( p )
      (if (and (listp p) (vl-every '(lambda ( x ) (eq (type x) 'REAL)) p) (eq (length p) 3))
          (list (car p) (cadr p))
          p
      )
  )
 
  ;; Collinear-p  -  M.R.
  ;; Returns T if p1,p2,p3 are collinear
 
  (defun MR:Collinear-p ( p1 p2 p3 )
      (equal  (distance p1 p3)
              (+ (distance p1 p2) (distance p2 p3))
          1e-8
      )
  )
 
  ;; 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))
                                  (< (if (equal c (* 2.0 pi) 1e-8) 0.0 c) (if (equal d (* 2.0 pi) 1e-8) 0.0 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) (not (MR:Collinear-p (3D->2D (caddr ch)) (3D->2D (cadr ch)) (3D->2D pt))))
                      (setq ch (cons pt (cddr ch)))
                  )
              )
              ch
          )
      )
  )
 
  (defun triangulate ( pl factor / tl pll getcircumcircle xmin xmax ymin ymax cs pmin pmax t1 t2 t3 al p el tr l n str ich iche i )
 
    (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 (3D->2D p) (3D->2D (car el)) (3D->2D (cadr el))))) rr (cadr cr))
      (list (+ (car cp) rr) cp rr (list p (car el) (cadr el))) ;;; Added X max 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 factor (+ n 2)))))) ;;; Added 0.0 in polar for rotating supertriangle t1 is max X apex ;;;
    ;;(setq t1 (polar cs 0.0 (setq rs (* 2.0 factor (distance pmin cs)))))
    (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 (car 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
          ( (< (car 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 tl (vl-remove-if '(lambda ( x ) (or (member t1 x) (member t2 x) (member t3 x))) tl))
    (setq pl pll)
    (if (null ell)
      (progn
        (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))
      )
    )
    (if ich
      (progn
        (setq ell t)
        (foreach e el
          (if (not (vl-some '(lambda ( x ) (and (member (car e) x) (member (cadr e) x))) tl))
            (progn
              (setq ich (vl-sort ich '(lambda ( a b ) (< (distance a (mid (3D->2D (car e)) (3D->2D (cadr e)))) (distance b (mid (3D->2D (car e)) (3D->2D (cadr e))))))))
              (setq iche (vl-remove-if '(lambda ( x ) (> (distance x (mid (3D->2D (car e)) (3D->2D (cadr e)))) (distance (car e) (mid (3D->2D (car e)) (3D->2D (cadr e)))))) ich))
              (foreach p iche
                (if (or
                      (and
                        (vl-some '(lambda ( x ) (if (and (member (car e) x) (member p x)) (setq tr x))) tl)
                        (vl-some '(lambda ( x ) (and (member (car e) x) (member p x))) (vl-remove tr tl))
                      )
                      (and
                        (vl-some '(lambda ( x ) (if (and (member (cadr e) x) (member p x)) (setq tr x))) tl)
                        (vl-some '(lambda ( x ) (and (member (cadr e) x) (member p x))) (vl-remove tr tl))
                      )
                    )
                    (setq iche (vl-remove p iche))
                )
              )
              (setq i (length iche))
              (setq iche (cons (car e) iche) iche (cons (cadr e) iche))
              (if (null z)
                (setq z 10.0)
              )
              (setq z
                (cond
                  ( (<= i (length (car (triangulate iche 10.0))))
                    (if (>= z 10.0)
                      z
                      (setq z 10.0)
                    )
                  )
                  ( (<= i (length (car (triangulate iche 25.0))))
                    (if (>= z 25.0)
                      z
                      (setq z 25.0)
                    )
                  )
                  ( (<= i (length (car (triangulate iche 50.0))))
                    (if (>= z 50.0)
                      z
                      (setq z 50.0)
                    )
                  )
                  ( (<= i (length (car (triangulate iche 100.0))))
                    (if (>= z 100.0)
                      z
                      (setq z 100.0)
                    )
                  )
                  ( (<= i (length (car (triangulate iche 250.0))))
                    (if (>= z 250.0)
                      z
                      (setq z 250.0)
                    )
                  )
                  ( (<= i (length (car (triangulate iche 500.0))))
                    (if (>= z 500.0)
                      z
                      (setq z 500.0)
                    )
                  )
                  ( (<= i (length (car (triangulate iche 1000.0))))
                    (if (>= z 1000.0)
                      z
                      (setq z 1000.0)
                    )
                  )
                )
              )
            )
          )
        )
      )
    )
    (list tl z)
  ) ;;; end of triangulate
 
  ;;                                                                            ;
  ;; 3df2sol     by  ymg   mod by M.R.                                          ;
  ;;                                                                            ;
  ;; Given a triangle point list of 3DFACE Loft it Down to Elevation - elev     ;
  ;; Returns the ename of the Solid created.                                    ;
  ;; Original 3DFACE is deleted.                                                ;
  ;;                                                                            ;
 
  (defun 3df2sol ( tr elev / en1 en2 p1 p2 p3 p4 )
    (setq
      p1 (car tr)
      p2 (cadr tr)
      p3 (caddr tr)
      p4 (car tr)
    )
    (setq
      en1 
      (entmakex
        (list 
          (cons 0 "3DFACE")
          (cons 10 (list (car p1) (cadr p1) elev))
          (cons 11 (list (car p2) (cadr p2) elev))
          (cons 12 (list (car p3) (cadr p3) elev))
          (cons 13 (list (car p4) (cadr p4) elev))
        )
      )
    )
    (setq
      en2
      (entmakex
        (list 
          (cons 0 "3DFACE")
          (cons 10 p1)
          (cons 11 p2)
          (cons 12 p3)
          (cons 13 p4)
        ) 
      )
    )
    (vl-cmdf "_.LOFT" en1 en2 "_MO" "_SOLID")
    (while (> (getvar 'cmdactive) 0) (vl-cmdf ""))
    (if (entget en1) (entdel en1))
    (if (entget en2) (entdel en2))
    (entlast)
  )
 
  (prompt "\n................................................")
  (prompt "\nTERRAIN TRIANGULATION IRREGULAR NETWORK MODELING")
  (prompt "\n................................................")
  (prompt "\n................................................")
  (prompt "\nSELECT RANDOM 3D POINTS...")
  (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 elevmin (caddar (setq pl (vl-sort pl '(lambda ( a b ) (< (caddr a) (caddr b)))))))
  (setq elmin (getreal (strcat "\nInput base elevation of terrain (must be < " (rtos elevmin 2 15) " ) : ")))
  (while (>= elmin elevmin)
    (setq elmin (getreal (strcat "\nInput base elevation of terrain (must be < " (rtos elevmin 2 15) " ) : ")))
  )
 
  (setq ti (car (_vl-times)))
  (setq ss3f (ssadd))
  (setq z (cadr (triangulate pl 10.0)))
  (foreach tr (car (triangulate pl z))
    (ssadd
      (3df2sol tr elmin)
      ss3f
    ) 
  )
 
  (vl-cmdf "_.UNION" ss3f "")
 
  (prompt (strcat "\nElapsed time: " (rtos (/ (- (car (_vl-times)) ti) 1000.) 2 4) " secs."))
  (princ)
)
 

M.R.

ymg · « **Reply #374 on:** April 29, 2015, 03:41:57 PM »

Marko,

I may as well post this version here.

I've done some work on the c:prof command,
the dialog box is mpe or less completed for it.

I've also corrected some nasties in c:Xshape
plus a few speed improvements and some clean up
of routine not used.

I will look at your code when I have a chance and
share any though I might have.

Still lots of work required to make the layer control
fully effective when switching between surfaces.

I also attached a drawing with four different surfaces
for those who would like to experiment with Xshapes.

ymg

News:

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

ribarm

Re: Triangulation (re-visited)

ymg

Re: Triangulation (re-visited)

ribarm

Re: Triangulation (re-visited)

ribarm

Re: Triangulation (re-visited)

lamarn

Re: Triangulation (re-visited)

lamarn

Re: Triangulation (re-visited)

ribarm

Re: Triangulation (re-visited)

ribarm

Re: Triangulation (re-visited)

ymg

Re: Triangulation (re-visited)

ribarm

Re: Triangulation (re-visited)

ymg

Re: Triangulation (re-visited)

ribarm

Re: Triangulation (re-visited)

ymg

Re: Triangulation (re-visited)

ribarm

Re: Triangulation (re-visited)

ymg

Re: Triangulation (re-visited)