TheSwamp

Code Red => AutoLISP (Vanilla / Visual) => Topic started by: Didge on March 13, 2006, 09:43:53 AM

Title: Triangulation (re-visited)
Post by: Didge on March 13, 2006, 09:43:53 AM
[ Link to the latest version in this thread: http://www.theswamp.org/index.php?topic=9042.msg555891#msg555891 (http://www.theswamp.org/index.php?topic=9042.msg555712#msg555712)   updated 11/17/15]


The attached code creates Triangulated Irregular Networks (TIN), and generally it does a wonderful job of it. Big credits due to the original authors, Messrs  Paul Bourke & Daniele Piazza.

Unfortunately I've found a re-produceable bug, consequently I've spent the past weekend scratching my head with very little sleep.

When selecting the points (see 'Points.dwg' A2k)  all appears well with the TIN, ie no 3Dface edges overlap their neighbouring faces.

Now when I scale those same points down by 0.1 (from any arbitary base point) and re-run the code, I get un-wanted over-lapping of the 3Dfaces.

I suspect much of this coding would benefit from some VL enhancements, but the new Vl-sort was about as far as my vanilla experience would take me.

I would appreciate any suggestions.

Code: [Select]
;******************************************************************;
; TRIANGULATE - Lisp command to create a TIN from 3D points.       ;
; ===========                                                      ;
;                                                                  ;
; Written by Daniele Piazza, ADN member Mechanical Solution s.r.l. ;
; http://pdcode.com/code.htm                                       ;
;                                                                  ;
; Original C coding "Triangulate"  written by PAUL BOURKE          ;
; http://astronomy.swin.edu.au/~pbourke/modelling/triangulate/     ;
;                                                                  ;
; This program triangulates an irregular set of points.            ;
; You can replace some code (sorting, list manipulation,...) with  ;
; VLisp functions to reduce the execution time.                    ;
;                                                                  ;
; This code is not seriously tested, if you find a bug...sorry!!   ;
; Goodbye, Daniele                                                 ;
;*******************************************************************
;
(defun C:TRIANGULATE (/ fuzzy nulllist ss1 ptlst nv supertriangle trianglelst i j k edgelst
                        circle pt flag perc)

 (setq OLDCMD (getvar "CMDECHO"))
 (setvar "CMDECHO" 0)
 (command ".UNDO" "GROUP")
 (setq OLDSNAP (getvar "OSMODE"))
 (setvar "OSMODE" 0)
 (setq fuzzy 1e-8)   ; tolerance in equality test
 (setq nulllist nil)
 
 (princ "\nSelect points...")
 (setq ss1 (ssget '((0 . "POINT"))))
 (setq start (getvar "date") THINK-CNT 0)            ; initiate timer & Progress Spinner Counter
 (setq ptlst (getptlist ss1))                        ; convert selection set to point list
 (setq ptlst (xsort ptlst))                          ; sort point list by X co-ordinate
 (setq nv (length ptlst))              ; number of points
 (setq supertriangle (findsupertriangle ptlst))      ; find super triangle
 (setq ptlst (append ptlst supertriangle))        ; append coordinates to the end of vertex list
 (setq trianglelst (list (list supertriangle nil)))  ; add supertriangle to the triangle list

 (setq i 0)
 (while   (< i nv)
   (THINKING (strcat "Processing TIN - " (itoa (/ (* i 100) nv)) "%    "))  ; update progress spinner
   (setq pt (nth i ptlst))
   (setq edgelst nil)                                ; initialize edge buffer
   (setq j 0)
   (while (and trianglelst (setq triangle (car (nth j trianglelst))))
     (setq flag T)
     (if (not (cadr (nth j trianglelst)))
       (progn
         (setq circle (getcircircumcircle triangle))       ; calculate circumcircle   
    (if (< (+ (caar circle) (cadr circle)) (car pt))  ; test point x and (pt) location
      (setq trianglelst (nth_subst j (list (car (nth j trianglelst)) T) trianglelst))
    )
    (if (isinside pt circle)
      (setq edgelst     (addtriangleedges triangle edgelst)
       trianglelst (nth_del j trianglelst)
       flag        nil
      )
    )
       ) ; end progn
     )   ; end if
     (if flag (setq j (1+ j)) )
   ) ; end while loop
   (setq edgelst (removedoublyedges edgelst fuzzy nulllist))           ; remove all doubly specified edges
   (setq trianglelst (addnewtriangles pt edgelst trianglelst))         ; form new triangles for current point
   (setq i (1+ i))                                                     ; get next vertex
 ) ; end while loop
 (setq trianglelst (purgetrianglelst trianglelst supertriangle fuzzy)) ; remove triangles with supertriangles edges

 (foreach triangle (mapcar 'car trianglelst)                           ; draw triangles
   (drawtriangle triangle)
 )

 (setvar "OSMODE" OLDSNAP)
 (setq OLDSNAP nil)
 (command ".UNDO" "END")
 (setq stop (getvar "date"))
 (princ (strcat "\r TIN Complete - Elapsed time: " (rtos (* 86400.0 (- stop start)) 2 2) " secs."))
 (setvar "CMDECHO" OLDCMD) 
 (princ)
)



;   XSORT - Original Shell Sort function replaced with VLISP sort (much quicker  ;
;                                                                                        ;
(defun XSORT ( PTLST /)
  (vl-sort PTLST (function (lambda (e1 e2) (< (car e1) (car e2)) ) ) )
)

;   NTH_DEL                              ;
;                                 ;
;   delete the n item in the list (by position, not by value!!)         ;
;                                 ;
;   Elimina l'oggetto che si trova nella posizione N della lista LST. L'utilizzo di   ;
;   funzioni ricorsive,oltre a non assicurare maggiore velocità, può creare problemi;
;   di overflow dello stack in caso di liste molto lunghe.            ;
(defun NTH_DEL (N LST / l)
 (repeat n
  (setq l (cons (car lst) l)
   lst (cdr lst)
  )
 )
 (append (reverse l)(cdr lst))
)

;   NTH_SUBST                           ;
;                                 ;
;   Replace the index element in the list with new element. This function is    ;
;   recursive this is not a great solution with a large amount of data.      ;
;                                 ;
(defun NTH_SUBST (index new Alist)
 (cond
  ((minusp index) Alist)
  ((zerop index)(cons new (cdr Alist)))
  (T (cons (car Alist)(nth_subst (1- index) new (cdr Alist))))
 )
)

;   GETPTLIST                           ;
;                                 ;
;   sset -> list (p1 p2 p3 ... pn)                     ;
;                                 ;
(defun GETPTLIST (ss1 / i pt ptlst)
 (if (not (zerop (sslength ss1)))
  (progn
   (setq i 0)
   (while
     (setq pt (ssname ss1 i))
     (setq ptlst (cons (cdr (assoc 10 (entget pt))) ptlst))
     (setq i (1+ i))
   )
  )
 )
 ptlst
)

;   FINDSUPERTRIANGLE                        ;
;                                 ;
;   Search the supertriangle that contain all points in the data set      ;
;                                 ;
(defun FINDSUPERTRIANGLE (ptlst / xmax xmin ymax ymin dx dy dmax xmid ymid
                   trx1 trx2 trx3 try1 try2 try3 trz1 trz2 trz3
          )
 (setq xmax (apply 'max (mapcar 'car ptlst))
       xmin (apply 'min (mapcar 'car ptlst))
       ymax (apply 'max (mapcar 'cadr ptlst))
       ymin (apply 'min (mapcar 'cadr ptlst))
       dx (- xmax xmin)
       dy (- ymax ymin)
       dmax (max dx dy)
       xmid (* (+ xmax xmin) 0.5)
       ymid (* (+ ymax ymin) 0.5)
       trx1 (- xmid (* dmax 2.0))
       try1 (- ymid dmax)
       trz1 0.0
       trx2 xmid
       try2 (+ ymid dmax)
       trz2 0.0
       trx3 (+ xmid (* dmax 2.0))
       try3 (- ymid dmax)
       trz3 0.0       
 )
 (list (list trx1 try1 trz1)
       (list trx2 try2 trz2)
       (list trx3 try3 trz3)
 )
)

;   GETCIRCIRCUMCIRCLE                        ;
;                                 ;
;   Calculate the circumcircle (center, radius) of triangle in input      ;
;                                 ;
(defun GETCIRCIRCUMCIRCLE (triangle / p1 p2 p3 p1x p2x p3x p1y p2y p3y d xc yc rad)
 (setq p1 (car triangle)
       p2 (cadr triangle)
       p3 (caddr triangle)
       p1x (car p1) p1y (cadr p1)
       p2x (car p2) p2y (cadr p2)
       p3x (car p3) p3y (cadr p3)
       d (* 2.0 (+ (* p1y p3x)
                   (* p2y p1x)
                   (- (* p2y p3x))
                   (- (* p1y p2x))
                   (- (* p3y p1x))
                   (* p3y p2x)
                )
         )
       xc (/ (+ (* p2y p1x p1x )
                (- (* p3y p1x p1x))
                (- (* p2y p2y p1y))
                (* p3y p3y p1y)
                (* p2x p2x p3y)
                (* p1y p1y p2y)
                (* p3x p3x p1y)
                (- (* p3y p3y p2y))
                (- (* p3x p3x p2y))
                (- (* p2x p2x p1y))
                (* p2y p2y p3y)
                (- (* p1y p1y p3y))
             )
             d
          )
       yc (/ (+ (* p1x p1x p3x)
                (* p1y p1y p3x)
                (* p2x p2x p1x)
                (- (* p2x p2x p3x))
                (* p2y p2y p1x)
                (- (* p2y p2y p3x))
                (- (* p1x p1x p2x))
                (- (* p1y p1y p2x))
                (- (* p3x p3x p1x))
                (* p3x p3x p2x)
                (- (* p3y p3y p1x))
                (* p3y p3y p2x)
             )
             d
          )
       rad (sqrt (+ (* (- p1x xc)(- p1x xc))
                    (* (- p1y yc)(- p1y yc))
                 )
           )
 )
 (list (list xc yc) rad)
)

;   ISINSIDE                           ;
;                                 ;
;   test if pt is inside a circle                     ;
;                                 ;
(defun ISINSIDE (pt circle)
 (setq ctr (car circle)
       rad (cadr circle)
 )
 (< (distance pt ctr) rad)
)

;   ADDTRIANGLEEDGES                        ;
;                                 ;
;   add triangle edges at the edge queue                  ;
;                                 ;
(defun ADDTRIANGLEEDGES (triangle edgelst)
 (append edgelst (list (list (car triangle)  (cadr triangle))
                       (list (cadr triangle) (caddr triangle))
                       (list (caddr triangle)(car triangle))
                 )
 )
)

;   DRAWTRIANGLE                           ;
;                                 ;
;   the fun side of the algorithm. Draw triangulation.            ;
;                                 ;
(defun DRAWTRIANGLE (triangle)
  (entmake (list (cons 0 "3DFACE") (cons 10 (car triangle))  (cons 11 (caddr triangle))
                                   (cons 12 (cadr triangle)) (cons 13 (cadr triangle))))
)

;   EQUALMEMBER                           ;
;                                 ;
;   Check if "item" is in "lista" or not by equality test. With real number the   ;
;   standard fuction "member" not work correctly.               ;
;                                 ;
(defun EQUALMEMBER (item lista fuzzy /)
 (apply 'or (mapcar '(lambda (x) (equal x item fuzzy)) lista))
)         

;   REMOVEDOUBLYEDGES                        ;
;                                 ;
;   Test the edge queue to remove duplicates (warning CW & CCW!)         ;
;                                 ;
(defun REMOVEDOUBLYEDGES (edgelst fuzzy nulllist /)
 (setq j 0)
 (while (< j (length edgelst))
  (setq k (1+ j))
  (while (< k (length edgelst))
   (if
    (or (and (equal (car  (nth j edgelst)) (car  (nth k edgelst)) fuzzy)
             (equal (cadr (nth j edgelst)) (cadr (nth k edgelst)) fuzzy)
        )
        (and (equal (car  (nth j edgelst)) (cadr (nth k edgelst)) fuzzy)
             (equal (cadr (nth j edgelst)) (car  (nth k edgelst)) fuzzy)
        )
    )
    (setq edgelst (nth_subst j nulllist edgelst)
          edgelst (nth_subst k nulllist edgelst)
    )
   )
   (setq k (1+ k))
  )
  (setq j (1+ j))
 )
 edgelst
)

;   ADDNEWTRIANGLES                           ;
;                                 ;
;   Add new triangle generated by pt to triangle list.            ;
;                                 ;
(defun ADDNEWTRIANGLES (pt edgelst trianglelst / j triangle )
 (setq j 0)
 (while (< j (length edgelst))
  (if (nth j edgelst)
   (setq triangle    (cons pt (nth j edgelst))
         trianglelst (cons (list triangle nil) trianglelst)
   )
  )
  (setq j (1+ j))
 )
 trianglelst
)

;   PURGETRIANGLELST                        ;
;                                 ;
;   replace all triangles that share a vertex with supertriangle         ;
;                                 ;
(defun PURGETRIANGLELST (trianglelst supertriangle fuzzy /)
 (setq j 0)
 (while (and trianglelst (setq triangle (car (nth j trianglelst))))
  (if (apply 'or
             (mapcar '(lambda (x) (equalmember x supertriangle fuzzy))
                     triangle
             )
      )
   (setq trianglelst (nth_del j trianglelst))
   (setq j (1+ j))
  )
 )
)


;                                       ;
; THINKING - STANDARD PROGRESS SPINNER  ;
;                                       ;
(defun THINKING (prmpt)
  (setq THINK-CNT (1+ THINK-CNT))
  (princ (strcat "\r" (nth (rem THINK-CNT 4) '("\|" "\/" "\-" "\\")) prmpt))
)


; ********************************* END OF CODING *******************************************
(princ "\n'TRIANGULATE' Loaded \n")
(princ)
Title: Re: Triangulation (re-visited)
Post by: CAB on March 13, 2006, 10:34:40 AM
Running the lisp with drawing as is. Then undo, scaling by 0.1, running again, I did not see the edge
overlap. But I am not into 3D so perhaps I did not know what to look for. Is the overlap obvious?
As you can see here examining 2 triangles, the first points are identical as are the third & second
points respectively.

Using plain ACAD2000.


Code: [Select]
Command: list
1 found
                  3D FACE   Layer: "GS-ELEV"
                            Space: Model space
                   Handle = AB8
             first point, X=539837.13728  Y=293829.99543  Z=  2.82000
            second point, X=539828.96328  Y=293844.62043  Z=  2.82000
             third point, X=539826.73328  Y=293843.57243  Z=  2.87000
            fourth point, X=539826.73328  Y=293843.57243  Z=  2.87000


Command:
Command: list
1 found
                  3D FACE   Layer: "GS-ELEV"
                            Space: Model space
                   Handle = AB9
             first point, X=539837.13728  Y=293829.99543  Z=  2.82000
            second point, X=539826.73328  Y=293843.57243  Z=  2.87000
             third point, X=539835.71028  Y=293829.00243  Z=  2.87000
            fourth point, X=539835.71028  Y=293829.00243  Z=  2.87000

Oh, it took .99 seconds of the first run & 1.25 sec on the second run.
Title: Re: Triangulation (re-visited)
Post by: Didge on March 13, 2006, 11:17:57 AM
Thank-you for taking a look at this one CAB, I've attached a ".jpg" to demonstrate the bug.

The leftmost image is a correct triangulation, the bug appears in the right-hand image as over-lapping magenta edges to the 3Dfaces.

As a temporary fix, I tried scaling-up the co-ordinates in the "getpntlist" function and then scaling them down again in the "drawtriangle" function - sadly this didn't work. The equality "Fuzzy" factor also grabbed my attention but my tweaks failed to correct the issue.



 

Title: Re: Triangulation (re-visited)
Post by: CAB on March 13, 2006, 11:32:14 AM
How about posting the scaled drawing.
I assume you posted the drawing before the scaling operation.
I did not get that error.
Title: Re: Triangulation (re-visited)
Post by: Didge on March 13, 2006, 11:40:15 AM
As requested, they're the same points but scaled down by 0.1

I've tried these points on 3 different PC's and had the same results on each.

Title: Re: Triangulation (re-visited)
Post by: CAB on March 13, 2006, 11:52:31 AM
Hold on, I do see the problem now.
Title: Re: Triangulation (re-visited)
Post by: Didge on March 13, 2006, 12:07:23 PM
I'm not sure if thats good or bad news, lol, I was beginning to hope it was something as basic as drawing units.

I noticed various versions of the code on Paul Bourke's site, most languages are represented but alas no lisp version as yet.

When used with the GET-Z function (in previous thread) we have the basis of an open-source 3D ground modelling package in the making.
( "Swamp Desktop" maybe :-)
Title: Re: Triangulation (re-visited)
Post by: LE on March 13, 2006, 12:15:24 PM
Didge;

I have used this library:

http://www.cs.cmu.edu/~quake/triangle.html

But it is to be use with your C++ solutions.   :-(
Title: Re: Triangulation (re-visited)
Post by: CAB on March 13, 2006, 01:45:14 PM
Looks like there may be a problem with the GETCIRCIRCUMCIRCLE function.
Not sure though. See this picture, the one on the left has an error where the points in yellow are
the triangle & the circle should pass through those points as it does on the right frame.
I'm out of time so maybe someone else has some help for you.
Title: Re: Triangulation (re-visited)
Post by: CAB on March 13, 2006, 05:05:03 PM
Test this:

Code: [Select]
;******************************************************************;
; TRIANGULATE - Lisp command to create a TIN from 3D points.       ;
; ===========                                                      ;
;                                                                  ;
; Written by Daniele Piazza, ADN member Mechanical Solution s.r.l. ;
; http://pdcode.com/code.htm                                       ;
;                                                                  ;
; Original C coding "Triangulate"  written by PAUL BOURKE          ;
; http://astronomy.swin.edu.au/~pbourke/modelling/triangulate/     ;
;                                                                  ;
; This program triangulates an irregular set of points.            ;
; You can replace some code (sorting, list manipulation,...) with  ;
; VLisp functions to reduce the execution time.                    ;
;                                                                  ;
; This code is not seriously tested, if you find a bug...sorry!!   ;
; Goodbye, Daniele                                                 ;
;*******************************************************************
;
;;
;;  Changes by CAB 03/13/06
;;  replaced the GETCIRCIRCUMCIRCLE routine
;;
(defun C:TRIANGULATE (/ fuzzy nulllist ss1 ptlst nv supertriangle trianglelst i j k edgelst
                        circle pt flag perc)

(setq OLDCMD (getvar "CMDECHO"))
(setvar "CMDECHO" 0)
(command ".UNDO" "GROUP")
(setq OLDSNAP (getvar "OSMODE"))
(setvar "OSMODE" 0)
(setq fuzzy 1e-8)   ; tolerance in equality test
(setq nulllist nil)
 
(princ "\nSelect points...")
(setq ss1 (ssget '((0 . "POINT"))))
(setq start (getvar "date") THINK-CNT 0)            ; initiate timer & Progress Spinner Counter
(setq ptlst (getptlist ss1))                        ; convert selection set to point list
(setq ptlst (xsort ptlst))                          ; sort point list by X co-ordinate
(setq nv (length ptlst))      ; number of points
(setq supertriangle (findsupertriangle ptlst))      ; find super triangle
(setq ptlst (append ptlst supertriangle))      ; append coordinates to the end of vertex list
(setq trianglelst (list (list supertriangle nil)))  ; add supertriangle to the triangle list

(setq i 0)
(setq cab 0) ; CAB debug
(while (< i nv)
   (THINKING (strcat "Processing TIN - " (itoa (/ (* i 100) nv)) "%    "))  ; update progress spinner
   (setq pt (nth i ptlst))
   (setq edgelst nil)                                ; initialize edge buffer
   (setq j 0)
   (while (and trianglelst (setq triangle (car (nth j trianglelst))))
     (setq flag T)
     (if (not (cadr (nth j trianglelst)))
       (progn
         (setq circle (getcircircumcircle triangle))       ; calculate circumcircle   
(if (< (+ (caar circle) (cadr circle)) (car pt))  ; test point x and (pt) location
   (setq trianglelst (nth_subst j (list (car (nth j trianglelst)) T) trianglelst))
)
(if (isinside pt circle)
   (setq edgelst     (addtriangleedges triangle edgelst)
trianglelst (nth_del j trianglelst)
flag      nil
   )
)
       ) ; end progn
     )   ; end if
     (if flag (setq j (1+ j)) )
   ) ; end while loop
   (setq edgelst (removedoublyedges edgelst fuzzy nulllist))           ; remove all doubly specified edges
   (setq trianglelst (addnewtriangles pt edgelst trianglelst))         ; form new triangles for current point
   (setq i (1+ i))                                                     ; get next vertex
) ; end while loop
(setq trianglelst (purgetrianglelst trianglelst supertriangle fuzzy)) ; remove triangles with supertriangles edges

(foreach triangle (mapcar 'car trianglelst)                           ; draw triangles
   (drawtriangle triangle)
)

(setvar "OSMODE" OLDSNAP)
(setq OLDSNAP nil)
(command ".UNDO" "END")
(setq stop (getvar "date"))
(princ (strcat "\r TIN Complete - Elapsed time: " (rtos (* 86400.0 (- stop start)) 2 2) " secs."))
(setvar "CMDECHO" OLDCMD) 
(princ)
)



; XSORT - Original Shell Sort function replaced with VLISP sort (much quicker :-)  ;
;                                                                                        ;
(defun XSORT ( PTLST /)
  (vl-sort PTLST (function (lambda (e1 e2) (< (car e1) (car e2)) ) ) )
)

; NTH_DEL ;
; ;
; delete the n item in the list (by position, not by value!!) ;
; ;
; Elimina l'oggetto che si trova nella posizione N della lista LST. L'utilizzo di ;
; funzioni ricorsive,oltre a non assicurare maggiore velocità, può creare problemi;
; di overflow dello stack in caso di liste molto lunghe. ;
(defun NTH_DEL (N LST / l)
(repeat n
  (setq l (cons (car lst) l)
lst (cdr lst)
  )
)
(append (reverse l)(cdr lst))
)

; NTH_SUBST ;
; ;
; Replace the index element in the list with new element. This function is ;
; recursive this is not a great solution with a large amount of data. ;
; ;
(defun NTH_SUBST (index new Alist)
(cond
  ((minusp index) Alist)
  ((zerop index)(cons new (cdr Alist)))
  (T (cons (car Alist)(nth_subst (1- index) new (cdr Alist))))
)
)

; GETPTLIST ;
; ;
; sset -> list (p1 p2 p3 ... pn) ;
; ;
(defun GETPTLIST (ss1 / i pt ptlst)
(if (not (zerop (sslength ss1)))
  (progn
   (setq i 0)
   (while
     (setq pt (ssname ss1 i))
     (setq ptlst (cons (cdr (assoc 10 (entget pt))) ptlst))
     (setq i (1+ i))
   )
  )
)
ptlst
)

; FINDSUPERTRIANGLE ;
; ;
; Search the supertriangle that contain all points in the data set ;
; ;
(defun FINDSUPERTRIANGLE (ptlst / xmax xmin ymax ymin dx dy dmax xmid ymid
          trx1 trx2 trx3 try1 try2 try3 trz1 trz2 trz3
)
(setq xmax (apply 'max (mapcar 'car ptlst))
       xmin (apply 'min (mapcar 'car ptlst))
       ymax (apply 'max (mapcar 'cadr ptlst))
       ymin (apply 'min (mapcar 'cadr ptlst))
       dx (- xmax xmin)
       dy (- ymax ymin)
       dmax (max dx dy)
       xmid (* (+ xmax xmin) 0.5)
       ymid (* (+ ymax ymin) 0.5)
       trx1 (- xmid (* dmax 2.0))
       try1 (- ymid dmax)
       trz1 0.0
       trx2 xmid
       try2 (+ ymid dmax)
       trz2 0.0
       trx3 (+ xmid (* dmax 2.0))
       try3 (- ymid dmax)
       trz3 0.0       
)
(list (list trx1 try1 trz1)
       (list trx2 try2 trz2)
       (list trx3 try3 trz3)
)
)




;;=============================================================
;;  Changes by CAB 03/13/06
;;  replaced the GETCIRCIRCUMCIRCLE routine
;;=============================================================

(defun getcircircumcircle (triangle / p1 p2 p3 pr1 pr2 cen rad bisector)
  ;;  return a pt list for a perpendicular bisector 20 units long
  (defun bisector (p1 p2 / perp_ang midpt)
    (setq p1       (list (car p1) (cadr p1)) ; make sure 2d point
          perp_ang (+ (angle p1 p2) (/ pi 2.0))) ; perpendicular angle
    (setq midpt (mapcar '(lambda (pa pb) (+ (/ (- pb pa) 2.0) pa)) p1 p2))
    (list (polar midpt perp_ang 10) (polar midpt (+ pi perp_ang) 10))
  )
  (setq p1  (car triangle)
        p2  (cadr triangle)
        p3  (caddr triangle)
        pr1 (bisector p1 p2)
        pr2 (bisector p1 p3)
        cen (inters (car pr1) (cadr pr1) (car pr2) (cadr pr2) nil)
        rad (distance cen p1)
  )
  (list cen rad)
)
;;=============================================================



; ISINSIDE ;
; ;
; test if pt is inside a circle ;
; ;
(defun ISINSIDE (pt circle)
(setq ctr (car circle)
       rad (cadr circle)
)
(< (distance pt ctr) rad)
)

; ADDTRIANGLEEDGES ;
; ;
; add triangle edges at the edge queue ;
; ;
(defun ADDTRIANGLEEDGES (triangle edgelst)
(append edgelst (list (list (car triangle)  (cadr triangle))
                       (list (cadr triangle) (caddr triangle))
                       (list (caddr triangle)(car triangle))
                 )
)
)

; DRAWTRIANGLE ;
; ;
; the fun side of the algorithm. Draw triangulation. ;
; ;
(defun DRAWTRIANGLE (triangle)
  (entmake (list (cons 0 "3DFACE") (cons 10 (car triangle))  (cons 11 (caddr triangle))
                                   (cons 12 (cadr triangle)) (cons 13 (cadr triangle))))
)

; EQUALMEMBER ;
; ;
; Check if "item" is in "lista" or not by equality test. With real number the ;
; standard fuction "member" not work correctly. ;
; ;
(defun EQUALMEMBER (item lista fuzzy /)
(apply 'or (mapcar '(lambda (x) (equal x item fuzzy)) lista))
)         

; REMOVEDOUBLYEDGES ;
; ;
; Test the edge queue to remove duplicates (warning CW & CCW!) ;
; ;
(defun REMOVEDOUBLYEDGES (edgelst fuzzy nulllist /)
(setq j 0)
(while (< j (length edgelst))
  (setq k (1+ j))
  (while (< k (length edgelst))
   (if
    (or (and (equal (car  (nth j edgelst)) (car  (nth k edgelst)) fuzzy)
             (equal (cadr (nth j edgelst)) (cadr (nth k edgelst)) fuzzy)
        )
        (and (equal (car  (nth j edgelst)) (cadr (nth k edgelst)) fuzzy)
             (equal (cadr (nth j edgelst)) (car  (nth k edgelst)) fuzzy)
        )
    )
    (setq edgelst (nth_subst j nulllist edgelst)
          edgelst (nth_subst k nulllist edgelst)
    )
   )
   (setq k (1+ k))
  )
  (setq j (1+ j))
)
edgelst
)

; ADDNEWTRIANGLES ;
; ;
; Add new triangle generated by pt to triangle list. ;
; ;
(defun ADDNEWTRIANGLES (pt edgelst trianglelst / j triangle )
(setq j 0)
(while (< j (length edgelst))
  (if (nth j edgelst)
   (setq triangle    (cons pt (nth j edgelst))
         trianglelst (cons (list triangle nil) trianglelst)
   )
  )
  (setq j (1+ j))
)
trianglelst
)

; PURGETRIANGLELST ;
; ;
; replace all triangles that share a vertex with supertriangle ;
; ;
(defun PURGETRIANGLELST (trianglelst supertriangle fuzzy /)
(setq j 0)
(while (and trianglelst (setq triangle (car (nth j trianglelst))))
  (if (apply 'or
             (mapcar '(lambda (x) (equalmember x supertriangle fuzzy))
                     triangle
             )
      )
   (setq trianglelst (nth_del j trianglelst))
   (setq j (1+ j))
  )
)
)


;                                       ;
; THINKING - STANDARD PROGRESS SPINNER  ;
;                                       ;
(defun THINKING (prmpt)
  (setq THINK-CNT (1+ THINK-CNT))
  (princ (strcat "\r" (nth (rem THINK-CNT 4) '("\|" "\/" "\-" "\\")) prmpt))
)


; ********************************* END OF CODING *******************************************
(princ "\n'TRIANGULATE' Loaded \n")
(princ)
Title: Re: Triangulation (re-visited)
Post by: Didge on March 14, 2006, 06:18:47 AM
Thats seems to have fixed the bug, thank-you very very muchly CAB.
I can't believe how quickly your mind debugs, whatsmore, like a few others on this site, you achieve it with just a few lines of code. I'm now off to study your changes in great detail.

Thanks for the link LE, unfortunately my employer contracts it's  IT management out to an external company, consequently any sign of an exe, com or DLL incurs disciplinary action :-(
We're therefore restricted to plain acad extensions, although it is amazing how much can be achieved through lisp alone.

I use the excellent 'Ezysurf' terrain modelling package on my home PC, but sadly this requires an exe file for it's licence management.

Ironically, I guess nobody this end realises that lisp could do just as much damage to a network as a virus.
Title: Re: Triangulation (re-visited)
Post by: qjchen on June 30, 2006, 06:41:17 AM
CAB, your code is very good:)
and it let me like the solution.
recently, eachy ( a lisp expert) tell me a website
http://astronomy.swin.edu.au/~pbourke/modelling/triangulate/
I try my best to translate it to Lisp
But my codes is too tedious.
I think after some changes, it could done the effect done by CAB.


Code: [Select]
;;; Purpose: To Generate the triangle by incresing point
;;; Version: 0.1
;;; Credit to Paul Bourke (pbourke@swin.edu.au) for the original C

Program :))
;;; http://astronomy.swin.edu.au/~pbourke/modelling/triangulate/
;;; The following codes are translate from C to AutoLisp by QJCHEN
;;; South China University of Technology
;;; Thanks : Eachy at xdcad.net introduce the source code pages
;;; and the STDLIB Function of Reini Urban at http://xarch.tu-

graz.ac.at/autocad/stdlib/archive/
;;; 2006.06.30
(defun c:test (/ tpoints temp howmany ij p1 p2 p3)
  (setq tpoints 1
vertex (givever)
triangle (givetri)
edges (giveedg)
  )
  (while (setq temp (getpoint))
    (setq vertex (qj-setnmth (nth 0 temp) tpoints 1 vertex))
    (setq vertex (qj-setnmth (nth 1 temp) tpoints 2 vertex))
    (if (> tpoints 2)
      (progn
(setq howmany (Triangulate tpoints))
      )
    )
    (setq tpoints (1+ tpoints))
    (setq ij 0)
    (command "redraw")
    (if (>= tpoints 4)
      (progn
(repeat howmany
  (setq ij (1+ ij))
  (setq p1 (nth (1- (nth 0 (nth (1- ij) triangle))) vertex))
  (setq p2 (nth (1- (nth 1 (nth (1- ij) triangle))) vertex))
  (setq p3 (nth (1- (nth 2 (nth (1- ij) triangle))) vertex))
  (grdraw p2 p1 1)
  (grdraw p1 p3 1)
  (grdraw p2 p3 1)
)
      )
    )           ; (grdraw p1 p3 1)
       ; (grdraw p2 p3 1)
       ; (grdraw p3 p1 1)
  )
)
;|The main function|;
(defun Triangulate (nvert / xmin ymin xmax ymax i dx dy xmid ymid

complete
  ntri inc nedge i j Triangulate1
   )
  (setq xmin (xofv vertex 1))
  (setq ymin (yofv vertex 1))
  (setq xmax xmin
ymax ymin
  )
  (setq i 2)
  (while (<= i nvert)
    (if (< (xofv vertex i) xmin)
      (setq xmin (xofv vertex i))
    )
    (if (> (xofv vertex i) xmax)
      (setq xmax (xofv vertex i))
    )
    (if (< (yofv vertex i) ymin)
      (setq ymin (yofv vertex i))
    )
    (if (> (yofv vertex i) ymax)
      (setq ymax (yofv vertex i))
    )
    (setq i (1+ i))
  )
  (setq dx (- xmax xmin))
  (setq dy (- ymax ymin))
  (if (> dx dy)
    (setq dmax dx)
    (setq dmax dy)
  )
  (setq xmid (/ (+ xmax xmin) 2))
  (setq ymid (/ (+ ymax ymin) 2))
  (setq vertex (qj-setnmth (- xmid (* dmax 2)) (1+ nvert) 1 vertex))
  (setq vertex (qj-setnmth (- ymid dmax) (1+ nvert) 2 vertex))
  (setq vertex (qj-setnmth xmid (+ nvert 2) 1 vertex))
  (setq vertex (qj-setnmth (+ ymid (* 2 dmax)) (+ nvert 2) 2 vertex))
  (setq vertex (qj-setnmth (+ xmid (* 2 dmax)) (+ nvert 3) 1 vertex))
  (setq vertex (qj-setnmth (- ymid dmax) (+ nvert 3) 2 vertex))
  (setq triangle (qj-setnmth (+ nvert 1) 1 1 triangle))
  (setq triangle (qj-setnmth (+ nvert 2) 1 2 triangle))
  (setq triangle (qj-setnmth (+ nvert 3) 1 3 triangle))
  (setq complete (append
   complete
   (list nil)
)
  )
  (setq ntri 1);;;;;;;;;;;start loop i
  (setq i 1)
  (while (<= i nvert)
    (setq nedge 0);;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    (setq j 0
  temp (- 1)
    )
    (while (< temp ntri)
      (setq j (1+ j)
    temp j
      )
      (if (/= (nth (1- j) complete) T)
(progn
  (setq inc (InCircle1 (xofv vertex i) (yofv vertex i) (xof vertex

triangle


    j 1


       )
       (yof vertex triangle j 1) (xof vertex


      triangle j 2


 ) (yof vertex


triangle j 2


   ) (xof vertex


  triangle j


  3


     ) (yof vertex triangle


    j 3


       )
    )
  )
)
      )
      (if inc
(progn
  (setq edges (qj-setnmth (nth 0 (nth (1- j) triangle)) 1
  (+ nedge 1) edges
      )
  )
  (setq edges (qj-setnmth (nth 1 (nth (1- j) triangle)) 2
  (+ nedge 1) edges
      )
  )
  (setq edges (qj-setnmth (nth 1 (nth (1- j) triangle)) 1
  (+ nedge 2) edges
      )
  )
  (setq edges (qj-setnmth (nth 2 (nth (1- j) triangle)) 2
  (+ nedge 2) edges
      )
  )
  (setq edges (qj-setnmth (nth 2 (nth (1- j) triangle)) 1
  (+ nedge 3) edges
      )
  )
  (setq edges (qj-setnmth (nth 0 (nth (1- j) triangle)) 2
  (+ nedge 3) edges
      )
  )
  (setq Nedge (+ Nedge 3))
  (setq triangle (qj-setnmth ([n,m] triangle ntri 1) j 1 triangle))
  (setq triangle (qj-setnmth ([n,m] triangle ntri 2) j 2 triangle))
  (setq triangle (qj-setnmth ([n,m] triangle ntri 3) j 3 triangle))
  (setq complete (std-setnth (nth (1- ntri) complete) (1- j)
     complete
)
  )
  (setq j (1- j)
temp j
  )
  (setq ntri (1- ntri))
)
      )
    );;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    (setq j 1)
    (while (<= j (1- Nedge))
      (if (and
    (/= ([n,m] edges 1 j) 0)
    (/= ([n,m] edges 2 j) 0)
  )
(progn
  (setq k (1+ j))
  (while (<= k Nedge)
    (if (and
  (/= ([n,m] edges 1 k) 0)
  (/= ([n,m] edges 2 k) 0)
)
      (if (= ([n,m] edges 1 j) ([n,m] edges 2 k))
(if (= ([n,m] edges 2 j) ([n,m] edges 1 k))
  (progn
    (setq edges (qj-setnmth 0 1 j edges))
    (setq edges (qj-setnmth 0 2 j edges))
    (setq edges (qj-setnmth 0 1 k edges))
    (setq edges (qj-setnmth 0 1 k edges))
  )
)
      )
    )
    (setq k (1+ k))
  )
)
      )
      (setq j (1+ j))
    );;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;
    (setq j 1)
    (while (<= j Nedge)
      (if (and
    (/= ([n,m] edges 1 j) 0)
    (/= ([n,m] edges 2 j) 0)
  )
(progn
  (setq ntri (1+ ntri))
  (setq triangle (qj-setnmth ([n,m] edges 1 j) ntri 1 triangle))
  (setq triangle (qj-setnmth ([n,m] edges 2 j) ntri 2 triangle))
  (setq triangle (qj-setnmth i ntri 3 triangle))
  (setq complete (std-setnth nil (1- ntri) complete))
)
      )
      (setq j (1+ j))
    );;;;;;;;;;;;;;;;;;;;;;;;;;;
    (setq i (1+ i))
  );;;;;end of loop i
  (setq i 0
temp (- 1)
  )
  (while (< temp ntri)
    (setq i (1+ i)
  temp i
    )
    (if (or
  (> ([n,m] triangle i 1) nvert)
  (> ([n,m] triangle i 2) nvert)
  (> ([n,m] triangle i 3) nvert)
)
      (progn
(setq triangle (qj-setnmth ([n,m] triangle ntri 1) i 1 triangle))
(setq triangle (qj-setnmth ([n,m] triangle ntri 2) i 2 triangle))
(setq triangle (qj-setnmth ([n,m] triangle ntri 3) i 3 triangle))
(setq i (1- i)
      temp i
)
(setq ntri (1- ntri))
      )
    )
  )
  (setq Triangulate1 ntri)
  Triangulate1
)
;;; stdlib - to substitute the i element of the list to new value
(defun std-%setnth (new i lst / fst len)
  (cond
    ((minusp i)
      lst
    )
    ((> i (setq len (length lst)))
      lst
    )
    ((> i (/ len 2))
      (reverse (std-%setnth new (1- (- len i)) (reverse lst)))
    )
    (t
      (append
(progn
  (setq fst nil)        ; ; possible vl lsa compiler bug
  (repeat (rem i 4)
    (setq fst (cons (car lst) fst)
  lst (cdr lst)
    )
  )
  (repeat (/ i 4)
    (setq fst (cons (cadddr lst) (cons (caddr lst) (cons


(cadr lst)


(cons


       (car lst)


       fst


)


   )
)
      )
  lst (cddddr lst)
    )
  )
  (reverse fst)
)
(if (listp new)
  new
  (list new)
)        ; v0.4001
(cdr lst)
      )
    )
  )
)
(defun std-setnth (new i lst)
  (std-%setnth (list new) i lst)
)
;;; substitute the i row j column of a 2 dimension array
(defun qj-setnmth (new i j lst / listb lista)
  (setq listb lst)
  (setq i (1- i))
  (setq j (1- j))
  (setq lista (nth i lst))
  (setq lista (std-setnth new j lista))
  (setq listb (std-setnth lista i listb))
  listb
)
;;; get the n row m column of the two dimension array
(defun [n,m] (a n m / i)      
  (setq i (nth (1- m) (nth (1- n) a)))
  i
)
;;; get the n row of the one dimension array
(defun [n] (a n / i)      
  (setq i (nth (1- n) a))
  i
)
;|Vertex has the form '((x1 y1)(x2 y2)(x3 y3)(x4 y4)())
The function xofv is to get the x value of the i element,i start from 1|;
(defun xofv (vertex i / res)
  (setq res (nth 0 (nth (- i 1) vertex)))
  res
)
;|Vertex has the form '((x1 y1)(x2 y2)(x3 y3)(x4 y4)())
The function yofv is to get the y value of the i element,i start from 1|;
(defun yofv (vertex i / res)
  (setq res (nth 1 (nth (- i 1) vertex)))
  res
)
;|Lis has the form '(((x11 y11)(x12 y12)(x13 y13))((x21 y21)(x22 y22)(x23

y23))(()()()))
The function xof is to get the x value of the i,j element,i and j start from

1
and j is the outer sequence, and i is the inter sequence, total 3|;
(defun xof (lisa lisb j v123 / res1 res2 res)
  (setq res1 (nth (1- j) lisb))
  (setq res2 (nth (1- v123) res1))
  (setq res3 (nth (1- res2) lisa))
  (setq res (nth 0 res3))
  res
)
;|Lis has the form '(((x11 y11)(x12 y12)(x13 y13))((x21 y21)(x22 y22)(x23

y23))(()()()))
The function xof is to get the y value of the i,j element,i and j start from

1
and j is the outer sequence, and i is the inter sequence, total 3|;
(defun yof (lisa lisb j v123 / res1 res2 res)
  (setq res1 (nth (1- j) lisb))
  (setq res2 (nth (1- v123) res1))
  (setq res3 (nth (1- res2) lisa))
  (setq res (nth 1 res3))
  res
)
;(defun append1 (new n lis / res1 res2 res)
;
;  (setq res1 (nth (1- n) lis))
;  (setq res2 (append
;        res1
;        (list new)
;      )
;  )
;  (setq res (std-setnth res2 (1- n) lis))
;  res
;)
;
;|Return TRUE if the point (xp,yp) lies inside the circumcircle
made up by points (x1,y1) (x2,y2) (x3,y3)
The circumcircle centre is returned in (xc,yc) and the radius r
NOTE: A point on the edge is inside the circumcircle|;
(defun InCircle1 (xp yp x1 y1 x2 y2 x3 y3 / InCircle eps mx2 my2 xc yc

m1
     mx1 my1 m2 mx2 my2 dx dy rsqr r drsqr
)
  (setq eps 0.000001)
  (setq InCircle nil)
  (if (and
(< (abs (- y1 y2)) eps)
(< (abs (- y2 y3)) eps)
      )
    (alert "INCIRCUM - F - Points are coincident !!")
    (progn
      (cond
((< (abs (- y2 y1)) eps)
  (setq m2 (/ (- x2 x3) (- y3 y2)))
  (setq mx2 (/ (+ x2 x3) 2))
  (setq my2 (/ (+ y2 y3) 2))
  (setq xc (/ (+ x2 x1) 2))
  (setq yc (+ my2 (* m2 (- xc mx2))))
)
((< (abs (- y3 y2)) eps)
  (setq m1 (/ (- x1 x2) (- y2 y1)))
  (setq mx1 (/ (+ x1 x2) 2))
  (setq my1 (/ (+ y1 y2) 2))
  (setq xc (/ (+ x3 x2) 2))
  (setq yc (+ my1 (* m1 (- xc mx1))))
)
(T
  (setq m1 (/ (- x1 x2) (- y2 y1)))
  (setq m2 (/ (- x2 x3) (- y3 y2)))
  (setq mx1 (/ (+ x1 x2) 2))
  (setq mx2 (/ (+ x2 x3) 2))
  (setq my1 (/ (+ y1 y2) 2))
  (setq my2 (/ (+ y2 y3) 2))
  (setq xc (/ (- (+ (* m1 mx1) my2) my1 (* m2 mx2)) (- m1

m2)))
  (setq yc (+ my1 (* m1 (- xc mx1))))
)
      )
      (setq dx (- x2 xc))
      (setq dy (- y2 yc))
      (setq rsqr (+ (* dx dx) (* dy dy)))
      (setq r (sqrt rsqr))
      (setq dx (- xp xc))
      (setq dy (- yp yc))
      (setq drsqr (+ (* dx dx) (* dy dy)))
      (if (<= drsqr rsqr)
(setq InCircle T)
      )
    )
  )
  InCircle
)
;|Determines which side of a line the point (xp,yp) lies.
The line goes from (x1,y1) to (x2,y2)
Returns -1 for a point to the left
         0 for a point on the line
        +1 for a point to the right|;
(defun whichside (xp yp x1 y1 x2 y2 / equation)
  (setq equation (- (* (- yp y1) (- x2 x1)) (* (- y2 y1) (- xp x1))))
  (cond
    ((> equation 0)
      (setq whichside (- 0 1))
    )
    ((= equation 0)
      (setq whichside 0)
    )
    (T
      (setq whichside 1)
    )
  )
  whichside
)
(defun givetri (/ lis)
  (repeat 200
    (setq lis (append
lis
(list (list nil nil nil))
      )
    )
  )
  lis
)
(defun givever (/ lis)
  (repeat 200
    (setq lis (append
lis
(list (list nil nil))
      )
    )
  )
  lis
)
(defun giveedg (/ lis lis1 lis2)
  (repeat 200
    (setq lis1 (append
lis1
(list nil)
       )
    )
  )
  (setq lis2 lis1)
  (setq lis (append
      lis
      (list lis1)
    )
  )
  (setq lis (append
      lis
      (list lis2)
    )
  )
  lis
)

effect

Title: Re: Triangulation (re-visited)
Post by: ElpanovEvgeniy on October 17, 2008, 10:13:33 AM
Recently, I too needed to use the triangulation program...


Code: [Select]
(defun c:test (/ I L S)
 (princ (strcat "\n select points"))
 (if (setq i 0
           s (ssget '((0 . "POINT")))
     ) ;_  setq
  (progn (repeat (sslength s)
          (setq l (cons (cdr (assoc 10 (entget (ssname s i)))) l)
                i (1+ i)
          ) ;_  setq
         ) ;_  repeat
         (eea-delone-triangulate i l)
  ) ;_  progn
 ) ;_  if
) ;_  defun
(defun eea-delone-triangulate (i1  L   /   A   A1  A2  A3
                               I   I2  L1  L2  L3  LP  MA
                               MI  P   S   TI  TR  X1  X2
                               Y1  Y2
                              )
 ;;*********************************************************
 ;;
 ;; Written by  ElpanovEvgeniy
 ;; 17.10.2008
 ;; Program triangulate an irregular set of 3d points.     
 ;;
 ;;*********************************************************
 (if l
  (progn
   (setq ti (car (_VL-TIMES))
         i  1
         i1 (/ i1 100.)
         i2 0
         l  (vl-sort
             (mapcar
              (function (lambda (p)
                         (list (/ (fix (* (car p) 1000)) 1000.)
                               (/ (fix (* (cadr p) 1000)) 1000.)
                               (caddr p)
                         ) ;_  list
                        ) ;_  lambda
              ) ;_  function
              l
             ) ;_  mapcar
             (function (lambda (a b) (>= (car a) (car b))))
            ) ;_  vl-sort
         x2 (caar l)
         y1 (cadar l)
         y2 y1
   ) ;_  setq
   (while l
    (setq a  (fix (caar l))
          a1 (list (car l))
          l  (cdr l)
    ) ;_  setq
    (while (and l (= (fix (caar l)) a))
     (setq a2 (car l))
     (if (<= (cadr a2) y1)
      (setq y1 (cadr a2))
      (if (> (cadr a2) y2)
       (setq y2 (cadr a2))
      ) ;_  if
     ) ;_  if
     (setq a1 (cons (car l) (vl-remove a2 a1))
           l  (cdr l)
     ) ;_  setq
    ) ;_  while
    (foreach a a1 (setq lp (cons a lp)))
   ) ;_  while
   (setq x1 (caar lp)
         a  (list (/ (+ x1 x2) 2) (/ (+ y1 y2) 2))
         a1 (distance a (list x1 y1))
         ma (+ (car a) a1 a1)
         mi (- (car a) a1)
         s  (list (list ma (cadr a) 0)
                  (list mi (+ (cadr a) a1 a1) 0)
                  (list (- (car a) a1) (- (cadr a) a1 a1) 0)
            ) ;_  list
         l  (list (cons x2 (cons a (cons (+ a1 a1) s))))
         ma (1- ma)
         mi (1+ mi)
   ) ;_  setq
   (while lp
    (setq p  (car lp)
          lp (cdr lp)
          l1 nil
    ) ;_  setq
    (while l
     (setq tr (car l)
           l  (cdr l)
     ) ;_  setq
     (cond
      ((< (car tr) (car p)) (setq l2 (cons (cdddr tr) l2)))
      ((< (distance p (cadr tr)) (caddr tr))
       (setq tr (cdddr tr)
             a1 (car tr)
             a2 (cadr tr)
             a3 (caddr tr)
             l1 (cons (list (+ (car a1) (car a2))
                            (+ (cadr a1) (cadr a2))
                            a1
                            a2
                      ) ;_  list
                      (cons (list (+ (car a2) (car a3))
                                  (+ (cadr a2) (cadr a3))
                                  a2
                                  a3
                            ) ;_  list
                            (cons (list (+ (car a3) (car a1))
                                        (+ (cadr a3) (cadr a1))
                                        a3
                                        a1
                                  ) ;_  list
                                  l1
                            ) ;_  cons
                      ) ;_  cons
                ) ;_  cons
       ) ;_  setq
      )
      (t (setq l3 (cons tr l3)))
     ) ;_  cond
    ) ;_  while
    (setq l  l3
          l3 nil
          l1 (vl-sort l1
                      (function (lambda (a b)
                                 (if (= (car a) (car b))
                                  (<= (cadr a) (cadr b))
                                  (< (car a) (car b))
                                 ) ;_  if
                                ) ;_  lambda
                      ) ;_  function
             ) ;_  vl-sort
    ) ;_  setq
    (while l1
     (if (and (= (caar l1) (caadr l1))
              (= (cadar l1) (cadadr l1))
         ) ;_  and
      (setq l1 (cddr l1))
      (setq l  (cons (eea-data-triangle p (cddar l1)) l)
            l1 (cdr l1)
      ) ;_  setq
     ) ;_  if
    ) ;_  while
    (if (and (< (setq i (1- i)) 1) (< i2 100))
     (progn
      (setvar
       "MODEMACRO"
       (strcat
        "     "
        (itoa (setq i2 (1+ i2)))
        " %    "
        (substr
         "||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||"
         1
         i2
        ) ;_  substr
        (substr
         "..."
         1
         (- 100 i2)
        ) ;_  substr
       ) ;_  strcat
      ) ;_  setvar
      (setq i i1)
     ) ;_  progn
    ) ;_  if
   ) ;_  while
   (foreach a l (setq l2 (cons (cdddr a) l2)))
   (setq
    l2 (vl-remove-if-not
        (function
         (lambda (a)
          (and (< mi (caadr a) ma) (< mi (caaddr a) ma))
         ) ;_  lambda
        ) ;_  function
        l2
       ) ;_  vl-remove-if
   ) ;_  setq
   (foreach a l2
    (entmake (list (cons 0 "3DFACE")
                   (cons 10 (car a))
                   (cons 11 (car a))
                   (cons 12 (cadr a))
                   (cons 13 (caddr a))
             ) ;_  list
    ) ;_  entmake
   ) ;_  foreach
  ) ;_  progn
 ) ;_  if
 (setvar "MODEMACRO" "")
 (princ (strcat "\n "
                (rtos (/ (- (car (_VL-TIMES)) ti) 1000.) 2 4)
                " secs."
        ) ;_  strcat
 ) ;_  princ
 (princ)
) ;_  defun
(defun eea-data-triangle (P1 l / A A1 P2 P3 P4 S)
 ;;*********************************************************
 ;;
 ;; Written by  ElpanovEvgeniy
 ;; 17.10.2008
 ;; Calculation of the centre of a circle and circle radius
 ;; for program triangulate
 ;;
 ;; (eea-data-triangle (getpoint)(list(getpoint)(getpoint)))
 ;;*********************************************************
 (setq p2 (car l)
       p3 (cadr l)
       p4 (list (car p3) (cadr p3))
 ) ;_  setq
 (if
  (not
   (zerop
    (setq s (sin (setq a (- (angle p2 p4) (angle p2 p1)))))
   ) ;_  zerop
  ) ;_  not
  (progn (setq a  (polar p4
                         (+ -1.570796326794896 (angle p4 p1) a)
                         (setq a1 (/ (distance p1 p4) s 2.))
                  ) ;_  polar
               a1 (abs a1)
         ) ;_  setq
         (list (+ (car a) a1) a a1 p1 p2 p3)
  ) ;_  progn
 ) ;_  if
) ;_  defun

Additional programs on a subject (CHALLENGE: Triangulation) (http://www.theswamp.org/index.php?topic=15784.0)
Title: Re: Triangulation (re-visited)
Post by: ElpanovEvgeniy on October 17, 2008, 10:31:30 AM
The main task of my code - to work quickly.

The report of job of the program on my the worker computer:

AutoCAD 2008
Windows XP sp2
Intel(R) Core(TM)2 Duo CPU
E8400 @ 3000GHz
3.25 Gb  RAM

Code: [Select]
Command:
Command: (LOAD "D:/Work/triangle/test/test.VLX") nil
Command: test
 select points
Select objects: Specify opposite corner: 100000 found
Select objects:
 39.0630 secs.
Command:

Title: Re: Triangulation (re-visited)
Post by: Arthur Gan on October 17, 2008, 01:16:26 PM
there's no information about and your email is hidden and i noticed you contributed a lot of codings..
may i know how to address you formally?
Test this:

Code: [Select]
;******************************************************************;
; TRIANGULATE - Lisp command to create a TIN from 3D points.       ;
; ===========                                                      ;
;                                                                  ;
; Written by Daniele Piazza, ADN member Mechanical Solution s.r.l. ;
; http://pdcode.com/code.htm                                       ;
;                                                                  ;
; Original C coding "Triangulate"  written by PAUL BOURKE          ;
; http://astronomy.swin.edu.au/~pbourke/modelling/triangulate/     ;
;                                                                  ;
; This program triangulates an irregular set of points.            ;
; You can replace some code (sorting, list manipulation,...) with  ;
; VLisp functions to reduce the execution time.                    ;
;                                                                  ;
; This code is not seriously tested, if you find a bug...sorry!!   ;
; Goodbye, Daniele                                                 ;
;*******************************************************************
;
;;
;;  Changes by CAB 03/13/06
;;  replaced the GETCIRCIRCUMCIRCLE routine
;;
(defun C:TRIANGULATE (/ fuzzy nulllist ss1 ptlst nv supertriangle trianglelst i j k edgelst
                        circle pt flag perc)

(setq OLDCMD (getvar "CMDECHO"))
(setvar "CMDECHO" 0)
(command ".UNDO" "GROUP")
(setq OLDSNAP (getvar "OSMODE"))
(setvar "OSMODE" 0)
(setq fuzzy 1e-8)   ; tolerance in equality test
(setq nulllist nil)
 
(princ "\nSelect points...")
(setq ss1 (ssget '((0 . "POINT"))))
(setq start (getvar "date") THINK-CNT 0)            ; initiate timer & Progress Spinner Counter
(setq ptlst (getptlist ss1))                        ; convert selection set to point list
(setq ptlst (xsort ptlst))                          ; sort point list by X co-ordinate
(setq nv (length ptlst))      ; number of points
(setq supertriangle (findsupertriangle ptlst))      ; find super triangle
(setq ptlst (append ptlst supertriangle))      ; append coordinates to the end of vertex list
(setq trianglelst (list (list supertriangle nil)))  ; add supertriangle to the triangle list

(setq i 0)
(setq cab 0) ; CAB debug
(while (< i nv)
   (THINKING (strcat "Processing TIN - " (itoa (/ (* i 100) nv)) "%    "))  ; update progress spinner
   (setq pt (nth i ptlst))
   (setq edgelst nil)                                ; initialize edge buffer
   (setq j 0)
   (while (and trianglelst (setq triangle (car (nth j trianglelst))))
     (setq flag T)
     (if (not (cadr (nth j trianglelst)))
       (progn
         (setq circle (getcircircumcircle triangle))       ; calculate circumcircle   
(if (< (+ (caar circle) (cadr circle)) (car pt))  ; test point x and (pt) location
   (setq trianglelst (nth_subst j (list (car (nth j trianglelst)) T) trianglelst))
)
(if (isinside pt circle)
   (setq edgelst     (addtriangleedges triangle edgelst)
trianglelst (nth_del j trianglelst)
flag      nil
   )
)
       ) ; end progn
     )   ; end if
     (if flag (setq j (1+ j)) )
   ) ; end while loop
   (setq edgelst (removedoublyedges edgelst fuzzy nulllist))           ; remove all doubly specified edges
   (setq trianglelst (addnewtriangles pt edgelst trianglelst))         ; form new triangles for current point
   (setq i (1+ i))                                                     ; get next vertex
) ; end while loop
(setq trianglelst (purgetrianglelst trianglelst supertriangle fuzzy)) ; remove triangles with supertriangles edges

(foreach triangle (mapcar 'car trianglelst)                           ; draw triangles
   (drawtriangle triangle)
)

(setvar "OSMODE" OLDSNAP)
(setq OLDSNAP nil)
(command ".UNDO" "END")
(setq stop (getvar "date"))
(princ (strcat "\r TIN Complete - Elapsed time: " (rtos (* 86400.0 (- stop start)) 2 2) " secs."))
(setvar "CMDECHO" OLDCMD) 
(princ)
)



; XSORT - Original Shell Sort function replaced with VLISP sort (much quicker :-)  ;
;                                                                                        ;
(defun XSORT ( PTLST /)
  (vl-sort PTLST (function (lambda (e1 e2) (< (car e1) (car e2)) ) ) )
)

; NTH_DEL ;
; ;
; delete the n item in the list (by position, not by value!!) ;
; ;
; Elimina l'oggetto che si trova nella posizione N della lista LST. L'utilizzo di ;
; funzioni ricorsive,oltre a non assicurare maggiore velocità, può creare problemi;
; di overflow dello stack in caso di liste molto lunghe. ;
(defun NTH_DEL (N LST / l)
(repeat n
  (setq l (cons (car lst) l)
lst (cdr lst)
  )
)
(append (reverse l)(cdr lst))
)

; NTH_SUBST ;
; ;
; Replace the index element in the list with new element. This function is ;
; recursive this is not a great solution with a large amount of data. ;
; ;
(defun NTH_SUBST (index new Alist)
(cond
  ((minusp index) Alist)
  ((zerop index)(cons new (cdr Alist)))
  (T (cons (car Alist)(nth_subst (1- index) new (cdr Alist))))
)
)

; GETPTLIST ;
; ;
; sset -> list (p1 p2 p3 ... pn) ;
; ;
(defun GETPTLIST (ss1 / i pt ptlst)
(if (not (zerop (sslength ss1)))
  (progn
   (setq i 0)
   (while
     (setq pt (ssname ss1 i))
     (setq ptlst (cons (cdr (assoc 10 (entget pt))) ptlst))
     (setq i (1+ i))
   )
  )
)
ptlst
)

; FINDSUPERTRIANGLE ;
; ;
; Search the supertriangle that contain all points in the data set ;
; ;
(defun FINDSUPERTRIANGLE (ptlst / xmax xmin ymax ymin dx dy dmax xmid ymid
          trx1 trx2 trx3 try1 try2 try3 trz1 trz2 trz3
)
(setq xmax (apply 'max (mapcar 'car ptlst))
       xmin (apply 'min (mapcar 'car ptlst))
       ymax (apply 'max (mapcar 'cadr ptlst))
       ymin (apply 'min (mapcar 'cadr ptlst))
       dx (- xmax xmin)
       dy (- ymax ymin)
       dmax (max dx dy)
       xmid (* (+ xmax xmin) 0.5)
       ymid (* (+ ymax ymin) 0.5)
       trx1 (- xmid (* dmax 2.0))
       try1 (- ymid dmax)
       trz1 0.0
       trx2 xmid
       try2 (+ ymid dmax)
       trz2 0.0
       trx3 (+ xmid (* dmax 2.0))
       try3 (- ymid dmax)
       trz3 0.0       
)
(list (list trx1 try1 trz1)
       (list trx2 try2 trz2)
       (list trx3 try3 trz3)
)
)




;;=============================================================
;;  Changes by CAB 03/13/06
;;  replaced the GETCIRCIRCUMCIRCLE routine
;;=============================================================

(defun getcircircumcircle (triangle / p1 p2 p3 pr1 pr2 cen rad bisector)
  ;;  return a pt list for a perpendicular bisector 20 units long
  (defun bisector (p1 p2 / perp_ang midpt)
    (setq p1       (list (car p1) (cadr p1)) ; make sure 2d point
          perp_ang (+ (angle p1 p2) (/ pi 2.0))) ; perpendicular angle
    (setq midpt (mapcar '(lambda (pa pb) (+ (/ (- pb pa) 2.0) pa)) p1 p2))
    (list (polar midpt perp_ang 10) (polar midpt (+ pi perp_ang) 10))
  )
  (setq p1  (car triangle)
        p2  (cadr triangle)
        p3  (caddr triangle)
        pr1 (bisector p1 p2)
        pr2 (bisector p1 p3)
        cen (inters (car pr1) (cadr pr1) (car pr2) (cadr pr2) nil)
        rad (distance cen p1)
  )
  (list cen rad)
)
;;=============================================================



; ISINSIDE ;
; ;
; test if pt is inside a circle ;
; ;
(defun ISINSIDE (pt circle)
(setq ctr (car circle)
       rad (cadr circle)
)
(< (distance pt ctr) rad)
)

; ADDTRIANGLEEDGES ;
; ;
; add triangle edges at the edge queue ;
; ;
(defun ADDTRIANGLEEDGES (triangle edgelst)
(append edgelst (list (list (car triangle)  (cadr triangle))
                       (list (cadr triangle) (caddr triangle))
                       (list (caddr triangle)(car triangle))
                 )
)
)

; DRAWTRIANGLE ;
; ;
; the fun side of the algorithm. Draw triangulation. ;
; ;
(defun DRAWTRIANGLE (triangle)
  (entmake (list (cons 0 "3DFACE") (cons 10 (car triangle))  (cons 11 (caddr triangle))
                                   (cons 12 (cadr triangle)) (cons 13 (cadr triangle))))
)

; EQUALMEMBER ;
; ;
; Check if "item" is in "lista" or not by equality test. With real number the ;
; standard fuction "member" not work correctly. ;
; ;
(defun EQUALMEMBER (item lista fuzzy /)
(apply 'or (mapcar '(lambda (x) (equal x item fuzzy)) lista))
)         

; REMOVEDOUBLYEDGES ;
; ;
; Test the edge queue to remove duplicates (warning CW & CCW!) ;
; ;
(defun REMOVEDOUBLYEDGES (edgelst fuzzy nulllist /)
(setq j 0)
(while (< j (length edgelst))
  (setq k (1+ j))
  (while (< k (length edgelst))
   (if
    (or (and (equal (car  (nth j edgelst)) (car  (nth k edgelst)) fuzzy)
             (equal (cadr (nth j edgelst)) (cadr (nth k edgelst)) fuzzy)
        )
        (and (equal (car  (nth j edgelst)) (cadr (nth k edgelst)) fuzzy)
             (equal (cadr (nth j edgelst)) (car  (nth k edgelst)) fuzzy)
        )
    )
    (setq edgelst (nth_subst j nulllist edgelst)
          edgelst (nth_subst k nulllist edgelst)
    )
   )
   (setq k (1+ k))
  )
  (setq j (1+ j))
)
edgelst
)

; ADDNEWTRIANGLES ;
; ;
; Add new triangle generated by pt to triangle list. ;
; ;
(defun ADDNEWTRIANGLES (pt edgelst trianglelst / j triangle )
(setq j 0)
(while (< j (length edgelst))
  (if (nth j edgelst)
   (setq triangle    (cons pt (nth j edgelst))
         trianglelst (cons (list triangle nil) trianglelst)
   )
  )
  (setq j (1+ j))
)
trianglelst
)

; PURGETRIANGLELST ;
; ;
; replace all triangles that share a vertex with supertriangle ;
; ;
(defun PURGETRIANGLELST (trianglelst supertriangle fuzzy /)
(setq j 0)
(while (and trianglelst (setq triangle (car (nth j trianglelst))))
  (if (apply 'or
             (mapcar '(lambda (x) (equalmember x supertriangle fuzzy))
                     triangle
             )
      )
   (setq trianglelst (nth_del j trianglelst))
   (setq j (1+ j))
  )
)
)


;                                       ;
; THINKING - STANDARD PROGRESS SPINNER  ;
;                                       ;
(defun THINKING (prmpt)
  (setq THINK-CNT (1+ THINK-CNT))
  (princ (strcat "\r" (nth (rem THINK-CNT 4) '("\|" "\/" "\-" "\\")) prmpt))
)


; ********************************* END OF CODING *******************************************
(princ "\n'TRIANGULATE' Loaded \n")
(princ)
Title: Re: Triangulation (re-visited)
Post by: CAB on October 17, 2008, 06:15:21 PM
Arthur,
I sent you an email.

Unfortunately I know little about Triangulation but am a very good debugger.  8-)
Title: Re: Triangulation (re-visited)
Post by: XXL66 on January 09, 2010, 08:48:36 AM
@ElpanovEvgeniy : respect...  a triangulation in lisp this fast is amazing ! To bad your site is in russian, seems to be VERY interesting. BTW: you should give it a try in BricsCAD v10, time is reduced 50% compared to ACAD !



Title: Re: Triangulation (re-visited)
Post by: ymg on May 19, 2011, 12:43:13 PM
I've been playing around with the triangulation written by Daniel Piazza and modified by Cab.

Sorry to report I found a few bugs.

Namely in certain case the supertriangle interfere with the triangulation on the convex hull of the points cloud.

Also the PURGETRIANGLELST function sometimes return J instead of trianglelst causing the triangulation to fail.

Find below the revised code:

Code: [Select]
;******************************************************************;
; TRIANGULATE - Lisp command to create a TIN from 3D points.       ;
; ===========                                                      ;
;                                                                  ;
; Written by Daniele Piazza, ADN member Mechanical Solution s.r.l. ;
; http://pdcode.com/code.htm                                       ;
;                                                                  ;
; Original C coding "Triangulate"  written by PAUL BOURKE          ;
; http://astronomy.swin.edu.au/~pbourke/modelling/triangulate/     ;
;                                                                  ;
; This program triangulates an irregular set of points.            ;
; You can replace some code (sorting, list manipulation,...) with  ;
; VLisp functions to reduce the execution time.                    ;
;                                                                  ;
; This code is not seriously tested, if you find a bug...sorry!!   ;
; Goodbye, Daniele                                                 ;
;*******************************************************************
;;
;;
;;  Changes by CAB 03/13/06
;;  replaced the GETCIRCIRCUMCIRCLE routine
;;
;; Change by ymg 05/19/2011
;;Modified FINDSUPERTRIANGLE and PURGETRIANGLELST
;;Remove recursion in NTH_SUBST
(defun C:TRIANGULATE (/ fuzzy   nulllist  ss1      
      nv ptlst     trianglelst    
      i j   k        circle
      pt flag   perc         edgelst
     )

   (setq OLDCMD (getvar "CMDECHO"))
   (setvar "CMDECHO" 0)
   (command ".UNDO" "GROUP")
   (setq OLDSNAP (getvar "OSMODE"))
   (setvar "OSMODE" 0)
   (setq fuzzy 1e-8) ; tolerance in equality test
   (setq nulllist nil)

   (princ "\nSelect points...")
   (setq ss1 (ssget '((0 . "POINT"))))
   (setq start (getvar "date")
THINK-CNT 0
   )                               
   (setq ptlst (getptlist ss1))
   (setq ptlst (xsort ptlst))
   (setq nv (length ptlst))
   
   (setq supertriangle (findsupertriangle ptlst)) ; find super triangle
   (setq ptlst (append ptlst supertriangle))   ; append coordinates to the end of vertex list
 
   (setq trianglelst (list (list supertriangle nil)))  ; add supertriangle to the triangle list
 

   (setq i 0) 
   
   (while (< i nv)
      (THINKING (strcat "Processing TIN - " (itoa (/ (* i 100) nv)) "%    "))
      (setq pt (nth i ptlst))
      (setq edgelst nil) ; initialize edge buffer
      (setq j 0)
      (while
(and trianglelst (setq triangle (car (nth j trianglelst))))
   (setq flag T)
   (if (not (cadr (nth j trianglelst)))
      (progn
(setq circle (getcircircumcircle triangle)) ; calculate circumcircle   
(if (< (+ (caar circle) (cadr circle)) (car pt)) ; test point x and (pt) location
    (setq trianglelst (nth_subst j (list (car (nth j trianglelst)) T) trianglelst))
)
(if (isinside pt circle)
    (setq edgelst     (addtriangleedges triangle edgelst)
  trianglelst (nth_del j trianglelst)
  flag       nil
    )
)
      ) ; end progn
   ) ; end if
   (if flag
      (setq j (1+ j))
   )
      )
      (setq edgelst (removedoublyedges edgelst fuzzy nulllist))
      (setq trianglelst (addnewtriangles pt edgelst trianglelst))
      (setq i (1+ i))
   )
   
   (setq trianglelst (purgetrianglelst trianglelst supertriangle fuzzy)) ; remove triangles with supertriangles edges

   (foreach triangle (mapcar 'car trianglelst)
     (drawtriangle triangle)
   )


   (setvar "OSMODE" OLDSNAP)
   (setq OLDSNAP nil)
   (command ".UNDO" "END")
   (setq stop (getvar "date"))
   (princ (strcat "\r TIN Complete - Elapsed time: "
  (rtos (* 86400.0 (- stop start)) 2 2)
  " secs."
  )
   )
   (setvar "CMDECHO" OLDCMD)
   (princ)
)






; XSORT - Original Shell Sort function replaced with VLISP sort (much quicker :-)  ;
;                                                                                        ;
(defun XSORT ( PTLST /)
  (vl-sort PTLST (function (lambda (a b) (< (car a) (car b)))))
)

; NTH_DEL ;
; ;
; delete the n item in the list (by position, not by value!!) ;
; ;
; Elimina l'oggetto che si trova nella posizione N della lista LST. L'utilizzo di ;
; funzioni ricorsive,oltre a non assicurare maggiore velocità, può creare problemi;
; di overflow dello stack in caso di liste molto lunghe. ;
(defun NTH_DEL (N LST / l)
(repeat n
  (setq l (cons (car lst) l)
lst (cdr lst)
  )
)
(append (reverse l)(cdr lst))
)

; NTH_SUBST ;
; ;
; Replace the index element in the list with new element. This function is ;
; recursive this is not a great solution with a large amount of data. ;
; ;
;(defun NTH_SUBST (index new Alist)
;   (cond
;      ((minusp index) Alist)
;      ((zerop index) (cons new (cdr Alist)))
;      (T
;       (cons (car Alist) (nth_subst (1- index) new (cdr Alist)))
;      )
;   )
;)
;;;Removed the recursion  ymg --------------------------
(defun NTH_SUBST (index new Alist / temp)
   (cond
      ((minusp index) Alist)
      ((zerop index)(cons new (cdr Alist)))
      ((> index 0)  (while (> index 0)
                       (setq temp  (cons (car alist) temp)
                     alist (cdr alist)
                     index (1- index)
                       )
                    )
                    (append (reverse temp) (list new) (cdr alist))
      )
   )
)
     

; GETPTLIST ;
; ;
; sset -> list (p1 p2 p3 ... pn) ;
; ;
(defun GETPTLIST (ss1 / i pt ptlst)
   (if (not (zerop (sslength ss1)))
      (progn
(setq i 0)
(while (setq pt (ssname ss1 i))
     (setq ptlst (cons (cdr (assoc 10 (entget pt))) ptlst))
     (setq i (1+ i))
)
      )
   )
   ptlst
)


; FINDSUPERTRIANGLE ;
; ;
; Search the supertriangle that contain all points in the data set ;
; ;
(defun FINDSUPERTRIANGLE (ptlst / xmax   xmin   ymax   ymin
  dx dy dmax   xmid   ymid   trx1
  trx2 trx3 try1   try2   try3   trz1
  trz2 trz3
)
   (setq xmax (apply 'max (mapcar 'car ptlst))
xmin (apply 'min (mapcar 'car ptlst))
ymax (apply 'max (mapcar 'cadr ptlst))
ymin (apply 'min (mapcar 'cadr ptlst))
dx   (- xmax xmin)
dy   (- ymax ymin)
dmax (max dx dy)
xmid (* (+ xmax xmin) 0.5)
ymid (* (+ ymax ymin) 0.5)
trx1 (- xmid (* dmax 20.0)) ;modified ymg
try1 (- ymid dmax)
trz1 0.0
trx2 xmid
try2 (+ ymid (* dmax 20.0)) ;modified ymg
trz2 0.0
trx3 (+ xmid (* dmax 20.0)) ;modified ymg
try3 (- ymid dmax)
trz3 0.0
   )
   (list (list trx1 try1 trz1)
(list trx2 try2 trz2)
(list trx3 try3 trz3)
   )
)








;;=============================================================
;;  Changes by CAB 03/13/06
;;  replaced the GETCIRCIRCUMCIRCLE routine
;;=============================================================

(defun getcircircumcircle (triangle / p1 p2 p3 pr1 pr2 cen rad bisector)
  ;;  return a pt list for a perpendicular bisector 20 units long
  (defun bisector (p1 p2 / perp_ang midpt)
    (setq p1       (list (car p1) (cadr p1)) ; make sure 2d point
          perp_ang (+ (angle p1 p2) (/ pi 2.0))) ; perpendicular angle
    (setq midpt (mapcar '(lambda (pa pb) (+ (/ (- pb pa) 2.0) pa)) p1 p2))
    (list (polar midpt perp_ang 10) (polar midpt (+ pi perp_ang) 10))
  )
  (setq p1  (car triangle)
        p2  (cadr triangle)
        p3  (caddr triangle)
        pr1 (bisector p1 p2)
        pr2 (bisector p1 p3)
        cen (inters (car pr1) (cadr pr1) (car pr2) (cadr pr2) nil)
        rad (distance cen p1)
  )
  (list cen rad)
)
;;=============================================================



; ISINSIDE ;
; ;
; test if pt is inside a circle ;
; ;
(defun ISINSIDE (pt circle)
(setq ctr (car circle)
       rad (cadr circle)
)
(< (distance pt ctr) rad)
)

; ADDTRIANGLEEDGES ;
; ;
; add triangle edges at the edge queue ;
; ;
(defun ADDTRIANGLEEDGES (triangle edgelst)
   (append edgelst (list (list (car triangle)  (cadr triangle))
                         (list (cadr triangle) (caddr triangle))
                         (list (caddr triangle)(car triangle))
                   )
   )
)

; DRAWTRIANGLE ;
; ;
; the fun side of the algorithm. Draw triangulation. ;
; ;
(defun DRAWTRIANGLE (triangle)
  (entmake (list (cons 0 "3DFACE") (cons 10 (car triangle))  (cons 11 (caddr triangle))
                                   (cons 12 (cadr triangle)) (cons 13 (cadr triangle))
   )
  )
)

; EQUALMEMBER ;
; ;
; Check if "item" is in "lista" or not by equality test. With real number the ;
; standard fuction "member" not work correctly. ;
; ;
(defun EQUALMEMBER (item lista fuzzy /)
(apply 'or (mapcar '(lambda (x) (equal x item fuzzy)) lista))
)         

; REMOVEDOUBLYEDGES ;
; ;
; Test the edge queue to remove duplicates (warning CW & CCW!) ;
; ;
(defun REMOVEDOUBLYEDGES (edgelst fuzzy nulllist /)
(setq j 0)
(while (< j (length edgelst))
  (setq k (1+ j))
  (while (< k (length edgelst))
   (if
    (or (and (equal (car  (nth j edgelst)) (car  (nth k edgelst)) fuzzy)
             (equal (cadr (nth j edgelst)) (cadr (nth k edgelst)) fuzzy)
        )
        (and (equal (car  (nth j edgelst)) (cadr (nth k edgelst)) fuzzy)
             (equal (cadr (nth j edgelst)) (car  (nth k edgelst)) fuzzy)
        )
    )
    (setq edgelst (nth_subst j nulllist edgelst)
          edgelst (nth_subst k nulllist edgelst)
    )
   )
   (setq k (1+ k))
  )
  (setq j (1+ j))
)
edgelst
)

; ADDNEWTRIANGLES ;
; ;
; Add new triangle generated by pt to triangle list. ;
; ;
(defun ADDNEWTRIANGLES (pt edgelst trianglelst / j triangle)
   (setq j 0)
   (while (< j (length edgelst))
      (if (nth j edgelst)
(setq triangle    (cons pt (nth j edgelst))
       trianglelst (cons (list triangle nil) trianglelst)
)
      )
      (setq j (1+ j))
   )
   trianglelst
)


; PURGETRIANGLELST ;
; ;
; replace all triangles that share a vertex with supertriangle ;
; ;
(defun PURGETRIANGLELST (trianglelst supertriangle fuzzy /)
   (setq j 0)
   (while (and trianglelst (setq triangle (car (nth j trianglelst))))
      (if
(apply 'or
(mapcar '(lambda (x) (equalmember x supertriangle fuzzy))
triangle
)
)
   (setq trianglelst (nth_del j trianglelst))
   (setq j (1+ j))
      )
   )
   (setq trianglelst trianglelst); modified to return trianglelst was returning J in certain case ymg
   
)






;                                       ;
; THINKING - STANDARD PROGRESS SPINNER  ;
;                                       ;
(defun THINKING (prmpt)
  (setq THINK-CNT (1+ THINK-CNT))
  (princ (strcat "\r" (nth (rem THINK-CNT 4) '("\|" "\/" "\-" "\\")) prmpt))
)


; ********************************* END OF CODING *******************************************
(princ "\n'TRIANGULATE' Loaded \n")
(princ)

The triangulation still fail on large data set.  I have removed the recursion in the NTH_SUBST as an attempt
to cure this problem.  I'll look at it some more.

Also played with Elpanov triangulation.  It also suffers from problem on the convex hull.
On a small set of 25 points, it missed to triangulate one of the point and 4 triangles on the hull
are missing.

Here is the point set:
     
Code: [Select]
((1652.17 356.759 446.623) (1666.15 431.163 -353.053) (1688.64 379.861 -372.616) (1708.17 888.849 489.959)
 (1763.96 799.643 117.206) (1811.9 678.149 -387.295) (1818.56 140.657 -256.432) (1883.13 226.078 -79.1498)
 (1888.23 124.665 122.761) (1900.26 864.281 -41.0016) (1950.15 730.671 -164.785) (1979.73 671.496 -19.8523)
 (2031.64 260.656 -497.925) (2069.42 69.732 -278.069) (2071.19 123.139 -183.401) (2096.73 383.737 -280.053)
 (2173.55 135.927 283.044) (2241.51 1048.67 47.7767) (2298.4 460.399 211.447) (2304.6 871.301 -156.27)
 (2441.41 517.957 -411.649) (2455.6 695.636 -390.896) (2462.35 249.15 99.3225) (2585.43 387.857 201.498)
 (2591.77 477.032 100.238) (-17456.9 -419.739 0.0) (2121.97 20138.0 0.0) (21700.8 -419.739 0.0))

So far I have made no attempt to find what is wrong in this code.

ymg
Title: Re: Triangulation (re-visited)
Post by: SOFITO_SOFT on May 19, 2011, 03:32:16 PM
Hello:
With the algorithm of P. Bourke, employs a few seconds.
That may solve your problem?
Best Regards

PD:
;;;Credit to Paul Bourke (pbourke@swin.edu.au) for the original Fortran 77 Program :))
;;;Converted to AutoLISP by Pedro Ferreira (pwp.netcabo.pt/pedro_ferreira)
;;;Check out: http://local.wasp.uwa.edu.au/~pbourke/papers/triangulate/
;;;You can use this code however you like providing the above credits remain in tact
Title: Re: Triangulation (re-visited)
Post by: CAB on May 19, 2011, 03:43:17 PM
Thanks

http://paulbourke.net/papers/triangulate/Triangulator.LSP

Oh, I see there are two.
Title: Re: Triangulation (re-visited)
Post by: ymg on May 19, 2011, 06:35:10 PM
I have tried also those two implementations of the Bourke algorithm and can report that they are OK.

Triangulator the one by Ferreira suffers from the fact that It uses global variables all over the place and could
therefore leave you stranded.

The one by Mihai Popescu is a nicer one.  I have not look in it to analyze the data structure.

Triangulate by Daniele Piazza is also nicely written and works provided that we modify it as per above.

Now the Fast one by Elpanov would certainly be interesting as long as we can fix the problem along the
convex hull.   Also I have not looked at the data structure.

All this to say that we have all kind of triangulation.

However Triangulation are created to ease further treatment of the data like contouring and
creating profiles on the TIN.  In other word we need to create more than just the 3dface.

Look at the following paper http://research.engineering.wustl.edu/~pless/506/l5.html (http://research.engineering.wustl.edu/~pless/506/l5.html)
for the kind of data structure we should be creating, namely a DCEL (Short for Doubly Connected Edge List)

With such a structure it becomes easy to walk on the TIN, go to the neighbor of a 3dface , contour etc.

So far none of the triangulation that we  have do it well.

ymg
Title: Re: Triangulation (re-visited)
Post by: ElpanovEvgeniy on May 20, 2011, 07:36:59 AM
Surprisingly, in my program there is a small error - a typo, but for many years, nobody has corrected the ...
It really is such a complicated program?
 :wink:
Title: Re: Triangulation (re-visited)
Post by: ElpanovEvgeniy on May 20, 2011, 08:07:43 AM
Now, especially checked - Playing a random mistake. I accidentally deleted a few lines. The code is similar to the line and the code is understandable, what is missing! If, indeed, no one can understand this program, I promise next week to lay out the full code! But I will be sorry that such a code just copy and do not try to understand...
 :-o
Title: Re: Triangulation (re-visited)
Post by: ElpanovEvgeniy on May 20, 2011, 08:15:37 AM
Corrected code faster!  :-D
Title: Re: Triangulation (re-visited)
Post by: ymg on May 20, 2011, 09:20:59 AM
Hi Elpanov,

The code is understandable.  But the fact is that you write very tight code and consequentlly
It is a little bit hard to follow.

However yours is fast, very fast for something written in Autolisp.  I would not have though that
such speed was attainable.  Therefore Hat's off to you !

What I am really interested in is that the triangulation should create a doubly connected edge list
in order to be ready to contour and or profile afterward. Could even be used to create toolpath
on a surface if we contour along the x or y axis then generate gcode.

Also why autolisp? when there is all kind of C++  and arx solutions.  My reason is that autolisp
can be used on any version of autocad without having to worry about recompilation and all.
I have code wich dates back to be before release 12 that still get some use.

Again congratulations on attaining such speed.

ymg
Title: Re: Triangulation (re-visited)
Post by: SOFITO_SOFT on May 20, 2011, 09:49:48 AM

In other word we need to create more than just the 3dface.

With such a structure it becomes easy to walk on the TIN, go to the neighbor of a 3dface , contour etc.

So far none of the triangulation that we  have do it well.

ymg
Hello :
if you have 3DFACEs you can converted to sliced-3dsolid, to unite all, and you can easily apply Boolean operations or sections. Usually I do and areas of some hectares with resolution of 2 or 5 meters work very well.
Greetings.
PD.: I attached a small example .... final solid (zip) and previous steps (dwg)
Title: Re: Triangulation (re-visited)
Post by: SOFITO_SOFT on May 20, 2011, 09:58:27 AM
oops... :-) a little picture...
(http://img805.imageshack.us/img805/5760/mdtsolido.gif) (http://imageshack.us/photo/my-images/805/mdtsolido.gif/)
Greetings  :-)
Title: Re: Triangulation (re-visited)
Post by: ymg on May 20, 2011, 10:01:30 AM
Here is something I originally posted in general programming on the subject of contouring.
With some corrections...!

If you look at the following link http://paulbourke.net/papers/conrec/ there are some explanation
on what is involved for determining a contour through a single triangle.

Here I have crudely translated the C routine proposed in that page to Autolisp (Tested and No attempt at Optimization)

Code: [Select]
;Create a contour slice through a 3 vertex facet pa, pb, pc
;The contour "level" is a horizontal plane perpendicular to the z axis,
;ie: The equation of the contour plane Ax + By + Cz + D = 0
;has A = 0, B = 0, C = 1, D = -level
;   Return:
;           ((nil nil nil) (nil nil nil)  0)   if the contour plane doesn't cut the facet
;           (  (x y z)       (x y z)      2)   if it does cut the facet
;           ((nil nil nil) (nil nil nil) -1)   for an unexpected occurrence
;If a vertex touches the contour plane nothing need to be drawn

(defun contourfacet (triangle level / pa pb pc sidea sideb sidec p1x p1y p1z p2x p2y p2z)
   (setq pa (car triangle)
         pb (cadr triangle)
         pc (caddr triangle)
   )
   (setq sidea (-(caddr pa)level)
sideb (-(caddr pb)level)
sidec (-(caddr pc)level)
   )
   (cond
      ;---Are all the vertices on one side----------
      ((and (>= sidea 0)  (>= sideb 0) (>= sidec 0))
       (setq ret 0)
      )
      
      ((and (<= sidea 0)  (<= sideb 0) (<= sidec 0))
       (setq ret 0)
      )
      ;---Is pa the only point on a side by itself---
      ((and (/=(sign sidea) (sign sideb))  (/=(sign sidea) (sign sidec)))

          (setq p1x (- (car pa) (* sidea (/ (- (car pc) (car pa)) (- sidec sidea)))))
          (setq p1y (- (cadr pa) (* sidea (/ (- (cadr pc) (cadr pa)) (- sidec sidea)))))
          (setq p1z (- (caddr pa) (* sidea (/ (- (caddr pc) (caddr pa)) (- sidec sidea)))))
          (setq p2x (- (car pa) (* sidea (/ (- (car pb) (car pa)) (- sideb sidea)))))
          (setq p2y (- (cadr pa) (* sidea (/ (- (cadr pb) (cadr pa)) (- sideb sidea)))))
          (setq p2z (- (caddr pa) (* sidea (/ (- (caddr pb) (caddr pa)) (- sideb sidea)))))
          (setq ret 2)
      )
      ;---Is pb the only point on a side by itself---
      ((and (/=(sign sideb) (sign sidea))  (/=(sign sideb) (sign sidec)))

          (setq p1x (- (car pb) (* sideb (/ (- (car pc) (car pb)) (- sidec sideb)))))
          (setq p1y (- (cadr pb) (* sideb (/ (- (cadr pc) (cadr pb)) (- sidec sideb)))))
          (setq p1z (- (caddr pb) (* sideb (/ (- (caddr pc) (caddr pb)) (- sidec sideb)))))
          (setq p2x (- (car pb) (* sideb (/ (- (car pa) (car pb)) (- sidea sideb)))))
          (setq p2y (- (cadr pb) (* sideb (/ (- (cadr pa) (cadr pb)) (- sidea sideb)))))
          (setq p2z (- (caddr pb) (* sideb (/ (- (caddr pa) (caddr pb)) (- sidea sideb)))))
          (setq ret 2)
      )
      ;---Is pc the only point on a side by itself---
      ((and (/=(sign sidec) (sign sidea))  (/=(sign sidec) (sign sideb)))

          (setq p1x (- (car pc) (* sidec (/ (- (car pa) (car pc)) (- sidea sidec)))))
          (setq p1y (- (cadr pc) (* sidec (/ (- (cadr pa) (cadr pc)) (- sidea sidec)))))
          (setq p1z (- (caddr pc) (* sidec (/ (- (caddr pa) (caddr pc)) (- sidea sidec)))))
          (setq p2x (- (car pc) (* sidec (/ (- (car pb) (car pc)) (- sideb sidec)))))
          (setq p2y (- (cadr pc) (* sidec (/ (- (cadr pb) (cadr pc)) (- sideb sidec)))))
          (setq p2z (- (caddr pc) (* sidec (/ (- (caddr pb) (caddr pc)) (- sideb sidec)))))
          (setq ret 2)
      )
      (t (setq ret -1))
   )
   (list (list p1x p1y p1z) (list p2x p2y p2z) ret)
)


;--Define the Signum function-----
(defun sign (x)
   ( cond
      (( minusp x ) -1 )
      (( zerop x)    0 )
      ( t            1 )
   )
)

Now in this next link http://www.originlab.com/www/helponline/Origin/en/UserGuide/Creating_Contour_Graphs.html#Drawing_of_contour_lines
there is a nice explanation on how you should follow a contour on the TIN.

Basically you find a triangle which has a crossing for the level under consideration, calculate the two points p1 and p2 that intersect the triangle
with above routine. The first point is saved as the starting point of a polyline.  This triangle is marked as traversed.

You then move to the neighboring triangle (The one which  has a reversed edge called a twin), calculate the two points again, mark as traversed until you reach the outside of the TIN (You are sitting on  an edge that has no twin) or you reach your starting point.

We  now check if any other triangle still has a crossing for that level, If it is the case we start a new polyline on the same level.


We then repeat the previous steps for the next level.

Now who is up to come up with an efficient way to do this ?
I am quite rusty with my Autolisp and I am just starting with the visual stuff.

Now you know why I am after a DCEL connected structure from the triangulation.

ymg
Title: Re: Triangulation (re-visited)
Post by: ymg on May 20, 2011, 10:06:34 AM
Sofito_Soft,

That's an interesting way to do it.

How fast would it be if we wanted to generate a contour map from it ?

I will look at it.

Thanks,

ymg
Title: Re: Triangulation (re-visited)
Post by: VovKa on May 20, 2011, 12:14:54 PM
Now, especially checked - Playing a random mistake. I accidentally deleted a few lines. The code is similar to the line and the code is understandable, what is missing! If, indeed, no one can understand this program, I promise next week to lay out the full code! But I will be sorry that such a code just copy and do not try to understand...
 :-o
hmmm, your variables naming style scares us off, Evgeniy :)
once i tested your code and i had to change
this
Code: [Select]
(vl-remove-if-not
    (function (lambda (a) (and (< mi (caadr a) ma) (< mi (caaddr a) ma))))
    l2
)
to this
Code: [Select]
(vl-remove-if
    (function
        (lambda (a)
            (or (vl-some (function (lambda (c) (vl-position c s))) a) (null a))
        )
    )
    l2
)
to make it work

by i don't really remember why i've done that...
Title: Re: Triangulation (re-visited)
Post by: SOFITO_SOFT on May 20, 2011, 02:22:40 PM
Sofito_Soft,

That's an interesting way to do it.

How fast would it be if we wanted to generate a contour map from it ?

I will look at it.

Thanks,

ymg
Hello:
with A2008 in a pc portable cpu 2 duo T5750 2gh and 3 gb ram
for calculating 3DFACEs:
1000 points = 45 seg....
5000 points = 1 hour....
Title: Re: Triangulation (re-visited)
Post by: SOFITO_SOFT on May 20, 2011, 03:16:25 PM
Hello swampy people:
A comparison between the solution Eugeni (cyan ) and Bourke (Magenta )
The original 1000  points (yellow) are a real example of a terrain slightly irregular.
(http://img840.imageshack.us/img840/83/eugenivsbourke.gif) (http://imageshack.us/photo/my-images/840/eugenivsbourke.gif/)
Time is infinitely better for Eugeni (1 sec) Bourke (35 sec)
The surface is substantially the same.
The perimeter is also better for Eugeni ...
On the left overlapping the 2 solutions ( 3dfaces ).
I will stop using the Bourke and I will from now fans of Eugene. :-) :-) :-)
Thank you very much for sharing, Eugeni.
Greetings.
Title: Re: Triangulation (re-visited)
Post by: ymg on May 20, 2011, 05:40:20 PM
Sofito_soft,

That is a lot of time in order to unite al those 3dface.

Whereby if we would preserve the data structure of the triangulation in a double edged list it would take very
little time to contour.  Most of the work is already done by the triangulation.

ymg
Title: Re: Triangulation (re-visited)
Post by: SOFITO_SOFT on May 20, 2011, 10:38:20 PM
Sofito_soft,

That is a lot of time in order to unite al those 3dface.

Whereby if we would preserve the data structure of the triangulation in a double edged list it would take very
little time to contour.  Most of the work is already done by the triangulation.

ymg
Hello :
That's true. If you just want to contour, no need to tape "3DFACE" as each 3DFACE have what it takes to calculate its intersection with a plane parallel to XY with Z determined. I think what I have done. I'll look and tell you something.
Greetings.
PS: I will paste a nice slope map calculated only with the information of the triangulation.
(http://img841.imageshack.us/img841/9272/mapadependientes.gif) (http://imageshack.us/photo/my-images/841/mapadependientes.gif/)
Best regards.

 
Title: Re: Triangulation (re-visited)
Post by: ymg on May 20, 2011, 10:49:01 PM
I did a preliminary run through the code of Evgenyi and It seems to me that there is a logic error.

He sets up the first two point of the list and proceed to insert point from this point on.

This would explain why we are missing edges on the convex hull.  Unless he uses an algorithm
that is unknown to me.  The initial triangle has to be carefully selected in order to insure a
complete Delaunay triangulation.

Most everybody uses the midpoint of the bounding box and build a triangle (supertriangle) from
this point.  Piazza's had problem because that triangle was not big enough even though
it did contain all the points.

It you look at the example by Bourke in C, he actually offset that midpoint by (* 20 dmax),
dmax being the biggest of (- ymax ymin) or (- xmax xmin).  That first triangle can be as big as we like
but can be too small and interfere with some point on the convex hull, even if the condition that it should
enclosed all the points is met.  Some authors advocate going to infinity.  Obviously we cannot meet
this condition, therefore the (* dmax 20) is reasonable and should be applied to all three points.

Anyway Evgenyi promised us a correction to his code we will see.  If I am right about this conjecture
addind the supertriangle would not slow his code in any significant way since it  only add one more triangle.

Preserving the data structure Vertex, Edges and Faces might be another story.  As far as I can tell we are
left with only L2 which contains the list of faces.

ymg
Title: Re: Triangulation (re-visited)
Post by: ymg on May 20, 2011, 11:05:07 PM
Sofito_Soft,

Quote
Hello :
That's true. If you just want to contour, no need to tape "3DFACE" as each 3DFACE have what it takes to calculate its intersection with a plane parallel to XY with Z determined. I think what I have done. I'll look and tell you something.

Indeed the 3dface has all the information necessary to find if any contour goes through it.
Look at the little routine that I have attached in previous post called Contourfacet.

What is more difficult is to trace that contour from face to face.  We do not want to go by brute force
because It's gonna take way too long.

Look  at this link that I posted before http://www.originlab.com/www/helponline/Origin/en/UserGuide/Creating_Contour_Graphs.html#Drawing_of_contour_lines (http://www.originlab.com/www/helponline/Origin/en/UserGuide/Creating_Contour_Graphs.html#Drawing_of_contour_lines)

Our triangulation could preserve all that is necessary to go from face to face rendering the process efficient.

We don't need to re-invent the wheel, very smart people have come up with way to accomplish it efficiently.
All we need is to do it in Autolisp.

ymg
Title: Re: Triangulation (re-visited)
Post by: SOFITO_SOFT on May 21, 2011, 01:34:53 AM
Sofito_Soft,

Quote
Hello :
That's true. If you just want to contour, no need to tape "3DFACE" as each 3DFACE have what it takes to calculate its intersection with a plane parallel to XY with Z determined. I think what I have done. I'll look and tell you something.

What is more difficult is to trace that contour from face to face.  We do not want to go by brute force
because It's gonna take way too long.

With my prehistoric face to face LSP:

Command: 3DF->CURVA_NIVEL
Selecciona las 3DFACE
Select objects: Specify opposite corner: 3073 found
Select objects:
Cronometro a 00:00
Tiempo para la funcion "c:3df->curva_nivel" : 20.985 seg.

With a intervale of 0.25 m in Z.-> 33000 contour level lines (separates )
Greetings.
Title: Re: Triangulation (re-visited)
Post by: dgorsman on May 21, 2011, 03:21:18 AM
Tracing contours between triangles may be an inefficient process, since triangles that span multiple elevation levels will have to be processed multiple times.  It may be more efficient to process all the contour segments for each triangle, then process those segments into buckets (for lack of a better term) for later processing.  Optimization would likely involve a pre-sort of the triangles based on the lowest (bottom to top) or highest (top to bottom).  Or, for even more optimization creation of the contour segments as each triangle is created.
Title: Re: Triangulation (re-visited)
Post by: ymg on May 21, 2011, 09:14:25 AM
Quote
Tracing contours between triangles may be an inefficient process, since triangles that span multiple elevation levels will have to be processed multiple times.  It may be more efficient to process all the contour segments for each triangle, then process those segments into buckets (for lack of a better term) for later processing.  Optimization would likely involve a pre-sort of the triangles based on the lowest (bottom to top) or highest (top to bottom).  Or, for even more optimization creation of the contour segments as each triangle is created.

Conrec by Bourke again http://paulbourke.net/papers/conrec/ (http://paulbourke.net/papers/conrec/) which dates back to 1987 advocates such a way. Once your done you still
need to unite all those line segment into polylines.  It is certainly feasible, but again in view of futher processing I strongly believe that we should
setup the triangulation in a way that permits us to traverse the TIN efficiently, be it for contour profile or anything else.

Whether we use a DCEL, a Winged Edge or a Quad edge (See Wikipedia for all these), the reason we triangulate is to organize the Data that is the point list in a way that we'll make it easy to find neighbor and to find in which face any point belongs to.

The way we are doing it we are keeping coordinates for points, coordinates again for 3dface and we are destructing the most important which is the
edges list.  The smart way is you keep your point with a pointer to the edge list.  The edge list is only pointer to the point list. The triangle is only pointer to the edge list.

ymg

Title: Re: Triangulation (re-visited)
Post by: ymg on May 21, 2011, 09:25:55 AM
Quote
What is more difficult is to trace that contour from face to face.  We do not want to go by brute force
because It's gonna take way too long.

With my prehistoric face to face LSP:

Your prehistoric lisp is actually doing the right thing, and probably follows what dgorsman is talking about and what Conrec
advocates.  But you still need to join all these line segments into polylines  and label them.

Now, If we want to do something else after contouring we are back to square one.  We need to find intersection to all the polylines which are already an interpolation.  However If we have  a good TIN you profile from the triangle.

Post your routine if you please. 

ymg
Title: Re: Triangulation (re-visited)
Post by: SOFITO_SOFT on May 21, 2011, 04:36:39 PM
Hello
If you put the polilines in Z, then you can filter to select all under a certain height. It is easy then weld all.

In my LSP

( defun c:3df->SEG_curva_nivel ( / )   : 3dfaces a segment of polilines in deteminate Z

( defun c:seg_lwpoly->LWPL_curva_nivel ( / ) : Weld segments in the same Z

Greetings. :-)
Title: Re: Triangulation (re-visited)
Post by: ymg on May 21, 2011, 09:11:31 PM
Quote
If you put the polilines in Z, then you can filter to select all under a certain height. It is easy then weld all.

In my LSP

( defun c:3df->SEG_curva_nivel ( / )   : 3dfaces a segment of polilines in deteminate Z

Muy muchas gracias, Sofito.

I will look at it tomorrow, I am traveling at the moment.

ymg
Title: Re: Triangulation (re-visited)
Post by: SOFITO_SOFT on May 22, 2011, 03:57:23 PM
Hello:
A friend from another forum CAD, sent me this picture. And indeed, proving Evgeniy Elpanov triangulation, has discovered 2 errors.
A vertex is unbound and 2 triangles overlap.
I have reviewed a bit the code. With the changes I've made ​​and works well is the case of conflict. If another user wants to try, please let us know if the correction is adequate.
Thanks ... Greetings from Madrid.
Partial initial code:
Code: [Select]
(defun c:test (/ I L S tmp a b )
 (princ (strcat "\n select points"))
 (if (setq i 0
           s (ssget '((0 . "POINT")))
     ) ;_  setq
  (progn (repeat (sslength s)
          ( setq tmp (cdr (assoc 10 (entget (ssname s i)))))
          ( setq l (cons (list (/ (fix (* (car tmp ) 1000))  1000. )
                               (/ (fix (* (cadr tmp) 1000))  1000. )
                               (caddr tmp)
                         )
                    l)
                i (1+ i)
          ) ;_  setq
         ) ;_  repeat
         ( setq l ( remove_doubles l ) )
         ( setq  l  (vl-sort              
               l                         
               (function (lambda (a b) (>= (car a) (car b))))                            
                    ) ;_  vl-sort
         )
         ( eea-delone-triangulate  l )

  ) ;_  progn
 ) ;_  if
) ;_  defun
(defun eea-delone-triangulate (  L   /   A   A1  A2  A3
                               I   I2  L1  L2  L3  LP  MA
                               MI  P   S   TI  TR  X1  X2
                               Y1  Y2
                              )
 ;;*********************************************************
 ;;
 ;; Written by  ElpanovEvgeniy
 ;; 17.10.2008
 ;; Program triangulate an irregular set of 3d points.     
 ;;
 ;;*********************************************************
 (if l
  (progn
   (setq ti (car (_VL-TIMES))
         i1 ( length l )
         i  1
         i1 (/ i1 100.)
         i2 0         
         x2 (caar l)
         y1 (cadar l)
         y2 y1
   ) ;_  setq   
   (while l
    (setq a  (fix (caar l))
          a1 (list (car l))         
      ;    l  (cdr l) ; <<<<<<<<<<<<<<<<<<<<<<< !!!!
    ) ;_  setq
.......
Title: Re: Triangulation (re-visited)
Post by: ElpanovEvgeniy on May 22, 2011, 04:03:56 PM
Unfortunately, your changes do not affect the algorithm. You try not to understand the algorithm, but only to correct the error.

ps. On Friday, I come from business trips and show you my code and change ...
Title: Re: Triangulation (re-visited)
Post by: ElpanovEvgeniy on May 27, 2011, 04:28:44 PM
program with the corrections:

Code: [Select]
(defun c:test (/ I L S)
 (princ (strcat "\n select points"))
 (if (setq i 0
           s (ssget '((0 . "POINT")))
     ) ;_  setq
  (progn (repeat (sslength s)
          (setq l (cons (cdr (assoc 10 (entget (ssname s i)))) l)
                i (1+ i)
          ) ;_  setq
         ) ;_  repeat
         (eea-delone-triangulate i l)
  ) ;_  progn
 ) ;_  if
) ;_  defun
(defun eea-delone-triangulate
       (i1 L / A A1 A2 A3 I I2 L1 L2 L3 LP MA MI P S TI TR X1 X2 Y1 Y2)
 ;;*********************************************************
 ;;
 ;; Written by  ElpanovEvgeniy
 ;; 17.10.2008
 ;; edit 20.05.2011
 ;; Program triangulate an irregular set of 3d points.    
 ;;
 ;;*********************************************************
 (if l
  (progn
   (setq ti (car (_VL-TIMES))
         i  1
         i1 (/ i1 100.)
         i2 0
         l  (vl-sort (mapcar (function (lambda (p)
                                        (list (/ (fix (* (car p) 1000)) 1000.)
                                              (/ (fix (* (cadr p) 1000)) 1000.)
                                              (caddr p)
                                        ) ;_  list
                                       ) ;_  lambda
                             ) ;_  function
                             l
                     ) ;_  mapcar
                     (function (lambda (a b) (>= (car a) (car b))))
            ) ;_  vl-sort
         x2 (caar l)
         y1 (cadar l)
         y2 y1
   ) ;_  setq
   (while l
    (setq a2 (car l))
    (if (<= (cadr a2) y1)
     (setq y1 (cadr a2))
     (if (> (cadr a2) y2)
      (setq y2 (cadr a2))
     )
    )
    (setq a  (fix (caar l))
          a1 (list (car l))
          l  (cdr l)
    ) ;_  setq
    (while (and l (= (fix (caar l)) a))
     (setq a2 (car l))
     (if (<= (cadr a2) y1)
      (setq y1 (cadr a2))
      (if (> (cadr a2) y2)
       (setq y2 (cadr a2))
      ) ;_  if
     ) ;_  if
     (setq a1 (cons (car l) (vl-remove a2 a1))
           l  (cdr l)
     ) ;_  setq
    ) ;_  while
    (foreach a a1 (setq lp (cons a lp)))
   ) ;_  while
   (setq x1 (caar lp)
         a  (list (/ (+ x1 x2) 2) (/ (+ y1 y2) 2))
         a1 (distance a (list x1 y1))
         ma (+ (car a) a1 a1)
         mi (- (car a) a1)
         s  (list (list ma (cadr a) 0)
                  (list mi (+ (cadr a) a1 a1) 0)
                  (list (- (car a) a1) (- (cadr a) a1 a1) 0)
            ) ;_  list
         l  (list (cons x2 (cons a (cons (+ a1 a1) s))))
         ma (1- ma)
         mi (1+ mi)
   ) ;_  setq
   (while lp
    (setq p  (car lp)
          lp (cdr lp)
          l1 nil
    ) ;_  setq
    (while l
     (setq tr (car l)
           l  (cdr l)
     ) ;_  setq
     (cond ((< (car tr) (car p)) (setq l2 (cons (cdddr tr) l2)))
           ((< (distance p (cadr tr)) (caddr tr))
            (setq tr (cdddr tr)
                  a1 (car tr)
                  a2 (cadr tr)
                  a3 (caddr tr)
                  l1 (cons (list (+ (car a1) (car a2)) (+ (cadr a1) (cadr a2)) a1 a2)
                           (cons (list (+ (car a2) (car a3)) (+ (cadr a2) (cadr a3)) a2 a3)
                                 (cons (list (+ (car a3) (car a1)) (+ (cadr a3) (cadr a1)) a3 a1) l1)
                           ) ;_  cons
                     ) ;_  cons
            ) ;_  setq
           )
           (t (setq l3 (cons tr l3)))
     ) ;_  cond
    ) ;_  while
    (setq l  l3
          l3 nil
          l1 (vl-sort l1
                      (function (lambda (a b)
                                 (if (= (car a) (car b))
                                  (<= (cadr a) (cadr b))
                                  (< (car a) (car b))
                                 ) ;_  if
                                ) ;_  lambda
                      ) ;_  function
             ) ;_  vl-sort
    ) ;_  setq
    (while l1
     (if (and (= (caar l1) (caadr l1)) (= (cadar l1) (cadadr l1)))
      (setq l1 (cddr l1))
      (setq l  (cons (eea-data-triangle p (cddar l1)) l)
            l1 (cdr l1)
      ) ;_  setq
     ) ;_  if
    ) ;_  while
    (if (and (< (setq i (1- i)) 1) (< i2 100))
     (progn
      (setvar
       "MODEMACRO"
       (strcat
        "     "
        (itoa (setq i2 (1+ i2)))
        " %    "
        (substr
         "||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||"
         1
         i2
        ) ;_  substr
        (substr "..." 1 (- 100 i2))
       ) ;_  strcat
      ) ;_  setvar
      (setq i i1)
     ) ;_  progn
    ) ;_  if
   ) ;_  while
   (foreach a l (setq l2 (cons (cdddr a) l2)))
   (setq l2 (vl-remove-if-not
             (function (lambda (a) (and (< mi (caadr a) ma) (< mi (caaddr a) ma))))
             l2
            ) ;_  vl-remove-if
   ) ;_  setq
   (foreach a l2
    (entmake (list (cons 0 "3DFACE")
                   (cons 10 (car a))
                   (cons 11 (car a))
                   (cons 12 (cadr a))
                   (cons 13 (caddr a))
             ) ;_  list
    ) ;_  entmake
   ) ;_  foreach
  ) ;_  progn
 ) ;_  if
 (setvar "MODEMACRO" "")
 (princ (strcat "\n " (rtos (/ (- (car (_VL-TIMES)) ti) 1000.) 2 4) " secs."))
 (princ)
) ;_  defun
(defun eea-data-triangle (P1 l / A A1 P2 P3 P4 S)
 ;;*********************************************************
 ;;
 ;; Written by  ElpanovEvgeniy
 ;; 17.10.2008
 ;; Calculation of the centre of a circle and circle radius
 ;; for program triangulate
 ;;
 ;; (eea-data-triangle (getpoint)(list(getpoint)(getpoint)))
 ;;*********************************************************
 (setq p2 (car l)
       p3 (cadr l)
       p4 (list (car p3) (cadr p3))
 ) ;_  setq
 (if (not (zerop (setq s (sin (setq a (- (angle p2 p4) (angle p2 p1)))))))
  (progn (setq a  (polar p4
                         (+ -1.570796326794896 (angle p4 p1) a)
                         (setq a1 (/ (distance p1 p4) s 2.))
                  ) ;_  polar
               a1 (abs a1)
         ) ;_  setq
         (list (+ (car a) a1) a a1 p1 p2 p3)
  ) ;_  progn
 ) ;_  if
) ;_  defun


look at the video, all my edits:
Title: Re: Triangulation (re-visited)
Post by: yarik on May 27, 2011, 04:44:11 PM
Thanks Elpanov, works great
Title: Re: Triangulation (re-visited)
Post by: ymg on May 28, 2011, 01:59:52 PM
Quote
program with the corrections:

You are still missing triangles on the convex hull Evgenyi.

ymg
Title: Re: Triangulation (re-visited)
Post by: ElpanovEvgeniy on May 28, 2011, 03:04:57 PM
You are still missing triangles on the convex hull Evgenyi.

ymg

show the test point cloud
Title: Re: Triangulation (re-visited)
Post by: ymg on May 28, 2011, 04:42:13 PM
Code: [Select]
((1652.17 356.759 446.623) (1666.15 431.163 -353.053) (1688.64 379.861 -372.616) (1708.17 888.849 489.959)
 (1763.96 799.643 117.206) (1811.9 678.149 -387.295) (1818.56 140.657 -256.432) (1883.13 226.078 -79.1498)
 (1888.23 124.665 122.761) (1900.26 864.281 -41.0016) (1950.15 730.671 -164.785) (1979.73 671.496 -19.8523)
 (2031.64 260.656 -497.925) (2069.42 69.732 -278.069) (2071.19 123.139 -183.401) (2096.73 383.737 -280.053)
 (2173.55 135.927 283.044) (2241.51 1048.67 47.7767) (2298.4 460.399 211.447) (2304.6 871.301 -156.27)
 (2441.41 517.957 -411.649) (2455.6 695.636 -390.896) (2462.35 249.15 99.3225) (2585.43 387.857 201.498)
 (2591.77 477.032 100.238) (-17456.9 -419.739 0.0) (2121.97 20138.0 0.0) (21700.8 -419.739 0.0))

Same point cloud as on reply #16 in this thread, Evgenyi

You still miss two small triangle on the outside


ymg
Title: Re: Triangulation (re-visited)
Post by: VovKa on May 28, 2011, 07:06:52 PM
program with the corrections:
can you provide a test points list which will show the difference between old and new versions?
Title: Re: Triangulation (re-visited)
Post by: ElpanovEvgeniy on May 29, 2011, 01:18:57 AM
can you provide a test points list which will show the difference between old and new versions?

Code: [Select]
(foreach p '((2516.06 458.26 0.0)
             (2520.33 508.832 0.0)
             (2563.56 516.802 0.0)
             (2562.18 470.832 0.0)
             (2594.14 435.458 0.0)
             (2614.14 445.705 0.0)
             (2611.41 488.645 0.0)
            )
 (entmakex (list '(0 . "point") (cons 10 p)))
)
Title: Re: Triangulation (re-visited)
Post by: VovKa on May 29, 2011, 04:19:20 AM
now i see, thanx
Title: Re: Triangulation (re-visited)
Post by: ymg on May 29, 2011, 10:29:26 PM
In order  to generate contours, I have modified Piazza's Triangulate to work with pointers into ptlst instead of coordinates.

That is the trianglelst is now stored as '(((4 0 2) nil) ((4 2 3) nil) ((3 2 1) T) ((2 0 1) T)) where (nth 4 ptlst) are the coordinates of the first vertex of
the first  triangle.

From trianglelst I now generates an edges list edgelst of the form:
     '((4 0) (0 2) (2 4) (4 2) (2 3) (3 4) (3 2) (2 1) (1 3) (2 0) (0 1) (1 2))

Again we have pointers into ptlst.

With this I can follow triangle from one to the other by finding the reverse of an edge.
That is edge (0 2) is neighbor with edge (2 0).  If there is no reverse it means that we are on
the outside (convex hull) of the triangulation.

We also know that a contour crosses a triangle on two edges except in the case where one
or both points defining an edge are exactly on the level of the contour.

Anyway, here is the modified routine :
Code: [Select]
;*****************************************************************************;
; TRIANGULATE - Lisp command to create a TIN from 3D points.                  ;
; ===========                                                            ;
;                                                                        ;
; Written by Daniele Piazza, ADN member Mechanical Solution s.r.l.       ;
; http://pdcode.com/code.htm                                              ;
;                                                                        ;
; Original C coding "Triangulate"  written by PAUL BOURKE                ;
; http://astronomy.swin.edu.au/~pbourke/modelling/triangulate/            ;
;                                                                        ;
; This program triangulates an irregular set of points.                       ;
; You can replace some code (sorting, list manipulation,...) with        ;
; VLisp functions to reduce the execution time.                          ;
;                                                                        ;
; This code is not seriously tested, if you find a bug...sorry!!          ;
; Goodbye, Daniele                                                        ;
;*****************************************************************************;
;;                                                                        ;
;;                                                                        ;
;;  Changes by CAB 03/13/06                                              ;
;;  Replaced the GETCIRCIRCUMCIRCLE routine                              ;
;;                                                                        ;
;; Changes by ymg :                                                      ;
;;                                                                        ;
;;Modified FINDSUPERTRIANGLE      19/05/2011                              ;
;;and PURGETRIANGLELST            19/05/2011                              ;
;;                                                                        ;
;;Removed recursion in NTH_SUBST  19/05/2011                              ;
;;                                                                        ;
;;Reverted to original GETCIRCIRCUMCIRCLE routine and changed it's       ;
;;name to GETCIRCUMCIRCLE         22/05/2011                              ;
;;                                                                        ;
;;Modified so that trianglelst and edgelst are now list of                ;
;;indices into ptlst.             25/05/2011                              ;
;;                                                                        ;
;;Removed EQUALMEMBER             25/05/2011                              ;
;;                                                                        ;
;;For Contour generation:                                                ;
;;                                                                        ;
;;Added GETEDGELST                28/05/2011                              ;
;;Added GETCROSSEDEGDGE   28/05/2011                              ;
;;Added MAKE_CONTOUR              28/05/2011                              ;
;;       ;

(defun C:TRIANGULATE (/ ss1   nv      
      i j   k
      circle    pt   flag
      ptlst     edgelst   trianglelst
      oldcmd    oldsnap   supertriangle
      triangle  start     think-cnt
      intv      zmax      zmin
     )

   (setq OLDCMD (getvar "CMDECHO"))
   (setvar "CMDECHO" 0)
   (command ".UNDO" "GROUP")
   (setq OLDSNAP (getvar "OSMODE"))
   (setvar "OSMODE" 0)
   
   (princ "\nSelect points...")
   (setq ss1 (ssget '((0 . "POINT"))))
   (setq start (car (_VL-TIMES))
THINK-CNT 0
   )                               
   (setq ptlst (getptlist ss1))
   (setq ptlst (xsort ptlst))
   (setq nv (length ptlst))
   
   (setq supertriangle (findsupertriangle ptlst))     
   (setq ptlst (append ptlst supertriangle))         
   (setq supertriangle (list nv (1+ nv) (+ 2 nv)))   
 
   (setq trianglelst (list(list supertriangle nil))) 
 
   (setq i 0) 
   
   (while (< i nv)
      (THINKING (strcat "Processing TIN - " (itoa (/ (* i 100) nv)) "%    ") think-cnt)
      (setq pt (nth i ptlst))
      (setq edgelst nil)
      (setq j 0)
      (while  (and trianglelst (setq triangle (car(nth j trianglelst))))
   (setq flag T)
   (if (not (cadr (nth j trianglelst)))
      (progn
(setq circle (GETCIRCUMCIRCLE triangle ptlst))         
(cond
   ((< (+ (caar circle) (cadr circle)) (car pt)) 
       (setq trianglelst (nth_subst j (list (car (nth j trianglelst)) T) trianglelst))
       
   )
   ((isinside pt circle)
       (setq edgelst (addtriangleedges triangle edgelst)
     trianglelst (nth_del j trianglelst)
     flag nil
       )
   )

      )
   )
   (if flag (setq j (1+ j)))
      )
     
      (setq edgelst (removedoublyedges edgelst))
      (setq trianglelst (addnewtriangles i edgelst trianglelst))
      (setq i (1+ i))
   )
   
   (setq trianglelst (purgetrianglelst trianglelst supertriangle))
   (repeat 3
      (setq ptlst (vl-remove (last ptlst) ptlst))
   )
   (foreach triangle (mapcar 'car trianglelst)
      (drawtriangle triangle ptlst)
   )
   
   ;; Now we set-up to trace the contour                                      ;
   
   (setq edgelst (GETEDGELST trianglelst)
            zmax (apply 'max (mapcar 'caddr ptlst))
    zmin (apply 'min (mapcar 'caddr ptlst))
    intv 1
    zmin (+ (fix zmin) intv)
    zmax (fix zmax)
   )
   
   (MAKE_CONTOUR zmin zmax intv edgelst ptlst)

   (setvar "OSMODE" OLDSNAP)
   (setq OLDSNAP nil)
   (command ".UNDO" "END")
   
   (princ (strcat "\r TIN Complete - Elapsed time: " (rtos (/ (- (car (_VL-TIMES)) start) 1000.) 2 4) " secs."))
   (princ)
   
   (setvar "CMDECHO" OLDCMD)
   (princ)
)






;; XSORT       ;
;;       ;
;;  Original Shell Sort function replaced with VLISP sort (much quicker :-)   ;
;;                                                                            ;

(defun XSORT ( PTLST /)
  (vl-sort PTLST (function (lambda (a b) (< (car a) (car b)))))
)

; NTH_DEL       ;
;       ;
; delete the n item in the list (by position, not by value!!)       ;
;       ;

(defun NTH_DEL (N LST / l)
   (repeat n
      (setq l (cons (car lst) l)
    lst (cdr lst)
      )
   )
   (append (reverse l) (cdr lst))
)

;(defun NTH_DEL (index lista)
; (setq i -1)
; (apply 'append (mapcar '(lambda (x)
;                                (if (= (setq i (+ 1 i)) index)
;                                    nil
;                                    (list x)
;                                )
;                         )
;                lista
;               )
; )
;)


; NTH_SUBST       ;
;       ;
; Replace the index element in the list with new element.       ;
;                       ;
;       ;

(defun NTH_SUBST (n new lst / l)
   (cond
      ((minusp n) lst)
      ((zerop n)(cons new (cdr lst)))
      (t  (repeat n
             (setq l   (cons (car lst) l)
           lst (cdr lst)
     )
          )
          (append (reverse l) (list new) (cdr lst))
      )
   )
)
;Need to check that one for speed
;(defun NTH_SUBST (n new lst / i)
; (setq i -1)
; (mapcar '(lambda (x)
;           (if (= (setq i (+ 1 i)) n)
;            new
;            x
;           )
;          )
;  lst
; )
;)
     

; GETPTLIST       ;
;       ;
; sset -> list (p1 p2 p3 ... pn)       ;
;       ;

(defun GETPTLIST (ss1 / i pt ptlst)
   (setq i 0)
   (if (not (zerop (sslength ss1)))
      (progn
(repeat (sslength ss1)
     (setq ptlst (cons (cdr (assoc 10 (entget (ssname ss1 i)))) ptlst)
               i (1+ i)
     )
)
      )
   )
   ptlst
)


; FINDSUPERTRIANGLE       ;
;       ;
; Search the supertriangle that contain all points in the data set      ;
;       ;
(defun FINDSUPERTRIANGLE (ptlst / xmax   xmin   ymax   ymin
  dmax   xmid   ymid   x1     x2     x3
  y1     y2     y3   
)
   (setq xmax (apply 'max (mapcar 'car ptlst))
xmin (apply 'min (mapcar 'car ptlst))
ymax (apply 'max (mapcar 'cadr ptlst))
ymin (apply 'min (mapcar 'cadr ptlst))
dmax (max (- xmax xmin) (- ymax ymin))
xmid (* (+ xmax xmin) 0.5)
ymid (* (+ ymax ymin) 0.5)
   x1 (- xmid (* dmax 20.0)) ;modified ymg
   y1 (- ymid dmax)

   x2 xmid
   y2 (+ ymid (* dmax 20.0)) ;modified ymg

   x3 (+ xmid (* dmax 20.0)) ;modified ymg
   y3 (- ymid dmax)

   )
   (list (list x1 y1 0.0) (list x2 y2 0.0) (list x3 y3 0.0))
)



;;          GETCIRCUMCIRCLE                                                   ;
;;       ;
;;    Find circle passing through three points                                ;
;;       ;

(defun GETCIRCUMCIRCLE (triangle ptlst / p1 p2 p3 p1x p2x p3x
                 p1y p2y p3y d xc yc rad)
 (setq p1 (nth (car triangle) ptlst)
       p2 (nth (cadr triangle) ptlst)
       p3 (nth (caddr triangle) ptlst)
       p1x (car p1) p1y (cadr p1)
       p2x (car p2) p2y (cadr p2)
       p3x (car p3) p3y (cadr p3)
       d (* 2.0 (+ (* p1y p3x)
                   (* p2y p1x)
                   (- (* p2y p3x))
                   (- (* p1y p2x))
                   (- (* p3y p1x))
                   (* p3y p2x)
                )
         )
       xc (/ (+ (* p2y p1x p1x )
                (- (* p3y p1x p1x))
                (- (* p2y p2y p1y))
                (* p3y p3y p1y)
                (* p2x p2x p3y)
                (* p1y p1y p2y)
                (* p3x p3x p1y)
                (- (* p3y p3y p2y))
                (- (* p3x p3x p2y))
                (- (* p2x p2x p1y))
                (* p2y p2y p3y)
                (- (* p1y p1y p3y))
             )
             d
          )
       yc (/ (+ (* p1x p1x p3x)
                (* p1y p1y p3x)
                (* p2x p2x p1x)
                (- (* p2x p2x p3x))
                (* p2y p2y p1x)
                (- (* p2y p2y p3x))
                (- (* p1x p1x p2x))
                (- (* p1y p1y p2x))
                (- (* p3x p3x p1x))
                (* p3x p3x p2x)
                (- (* p3y p3y p1x))
                (* p3y p3y p2x)
             )
             d
          )
       rad (sqrt (+ (* (- p1x xc)(- p1x xc))
                    (* (- p1y yc)(- p1y yc))
                 )
           )
 )
 (list (list xc yc) rad)
)


; ISINSIDE       ;
;       ;
; test if pt is inside a circle       ;
;       ;
(defun ISINSIDE (pt circle)
  (< (distance pt (car circle)) (cadr circle))
)

; ADDTRIANGLEEDGES               ;
;       ;
; add triangle edges at the edge queue       ;
;       ;
(defun ADDTRIANGLEEDGES (triangle edgelst)
   (append edgelst (list (list (car triangle)  (cadr triangle))
                         (list (cadr triangle) (caddr triangle))
                         (list (caddr triangle) (car triangle))
                   )
   )
)

; DRAWTRIANGLE       ;
;       ;
; the fun side of the algorithm. Draw triangulation.       ;
;       ;
(defun DRAWTRIANGLE (triangle ptlst /)
  (entmake (list (cons 0 "3DFACE")
(cons 8 "TIN")
(cons 10 (nth (car triangle)   ptlst))
(cons 11 (nth (caddr triangle) ptlst))
                 (cons 12 (nth (cadr triangle)  ptlst))
(cons 13 (nth (cadr triangle)  ptlst))
   )
  )
)

; REMOVEDOUBLYEDGES       ;
;       ;
; Test the edge queue to remove duplicates (warning CW & CCW!)       ;
;       ;

(defun REMOVEDOUBLYEDGES (edgelst / j k)

   (setq j 0)
   (while (< j (length edgelst))
      (setq k (1+ j))
      (while (< k (length edgelst))
(if
    (or (and (= (car (nth j edgelst)) (car (nth k edgelst)))
     (= (cadr (nth j edgelst)) (cadr (nth k edgelst)))
)
(and (= (car (nth j edgelst)) (cadr (nth k edgelst)))
     (= (cadr (nth j edgelst)) (car (nth k edgelst)))
)
    )
      (setq edgelst (nth_subst j nil edgelst)
    edgelst (nth_subst k nil edgelst)
      )
)
(setq k (1+ k))
      )
      (setq j (1+ j))
   )

   edgelst
)


; ADDNEWTRIANGLES       ;
;       ;
; Add new triangle generated by pt to triangle list.       ;
;       ;

(defun ADDNEWTRIANGLES (pt edgelst trianglelst / j triangle)
   (setq j 0)
   
   (repeat (length edgelst)
      (if (nth j edgelst)
  (setq triangle    (append (cons pt (nth j edgelst)))
        trianglelst (cons (list triangle nil) trianglelst)
  )
      )
      (setq j (1+ j))
   )
   trianglelst
)


; PURGETRIANGLELST       ;
;       ;
; replace all triangles that share a vertex with supertriangle       ;
;       ;

(defun PURGETRIANGLELST (trianglelst supertriangle / a b j triangle)
   (setq j 0)
   (repeat (length trianglelst)
      (setq triangle (car (nth j trianglelst)))
      (if
         (apply 'or (mapcar '(lambda (a) (apply 'or (mapcar '(lambda (b) (= b a )) supertriangle)))
triangle
)
)


   (setq trianglelst (nth_del j trianglelst))
   (setq j (1+ j))
      )
   )
   trianglelst
   
)

;;           GETEDGELST       ;
;;       ;
;;   Create list of EDGES of all triangles in trianglelst.       ;
;;       ;

(defun GETEDGELST (trianglelst / edgelst neighlst)
   (setq edgelst nil)
   (foreach tr trianglelst
      (setq edgelst (cons (list (caar tr)(cadar tr)) edgelst)
    edgelst (cons (list (cadar tr)(caddar tr)) edgelst)
    edgelst (cons (list (caddar tr)(caar tr)) edgelst)
      )
   )   
)


;;      GETCROSSEDEGDGE       ;
;;       ;
;;Traverses the edges list and creates a list of edges that are crossed by a  ;
;;contour level.  It then follows contlst from neigbour to neighbor until it  ;
;;reaches the exterior of the TIN or the starting point.       ;
;;       ;
;;Returns crossedlst which contains list of edges.       ;
;;       ;

(defun GETCROSSEDEDGE (lev edgelst ptlst / e pos nxt contlst lwplst
        z1 z2 crossedlst)
   
   (setq contlst nil)
   
   (foreach e edgelst
      (setq z1 (caddr (nth (car e) ptlst))
    z2 (caddr (nth (cadr e) ptlst))
      )
      (if (= z1 lev) (setq z1 (+ z1 1e-8)))
      (if (= z2 lev) (setq z2 (+ z2 1e-8)))
     
      (if (or (< z1 lev z2)(> z1 lev z2))   
          (setq contlst (cons e contlst))
      )
     
   )
   (setq crossedlst nil)     
   (while contlst
      (setq pos 0)
      ;;Find an edge on the convex hull and start from it if none start at last pos in contlst
      (while (and (member (reverse (nth pos contlst)) contlst) (< pos (1- (length contlst))))
(setq pos (1+ pos))
      )
     
      (setq  lwplst (list (nth pos contlst))
    contlst (nth_del pos contlst)
                pos (- pos (rem pos 2))
             lwplst (cons (nth pos contlst) lwplst)
        nxt (reverse (car lwplst))
    contlst (nth_del pos contlst)
      )
   
      (while (and (setq pos (vl-position nxt contlst)) (not (member nxt lwplst)))
(cond
    ((> (length contlst) 1)
            (setq contlst (nth_del pos contlst)
                  pos (- pos (rem pos 2))
                         lwplst (cons (nth pos contlst) lwplst)
      nxt (reverse (car lwplst))
      contlst (nth_del pos contlst)
            )
    )
    (t (setq lwplst  (cons (nth pos contlst) lwplst)
     contlst (nth_del pos contlst)
       )
    )
)   
      )
      (setq crossedlst (cons lwplst crossedlst))
    )
    crossedlst
 ) 

;;              MAKE_CONTOUR               ;
;;       ;
;; Creates LWPolylines from the edgelst         ;
;;       ;

(defun MAKE_CONTOUR (zmin zmax intv edgelst ptlst /
     lwplst lev edge p1 p2 d pt tmp)

   (setq lev zmin)
   
   (repeat (fix (/ (- zmax zmin) intv))
   
   (setq lwplst (GETCROSSEDEDGE lev edgelst ptlst))
   
   (foreach pline lwplst
      (setq tmp nil)
      (foreach edge pline
(setq   p1 (nth (car  edge) ptlst)
           p2 (nth (cadr edge) ptlst)
                            r (/ (- l (caddr p1)) (- (caddr p2) (caddr p1)));Modified june 2013
                         p1 (list (car p1)(cadr p1))                                 ; Calculation of contour was incorrect
           p2 (list (car p2)(cadr p2))                   
          d (* (distance p1 p2) r)
         pt (polar p1 (angle p1 p2) d)
pt (list (car pt)(cadr pt))
        tmp (cons (cons 10 pt) tmp)
)
      )
      (setq tmp (cons (cons 38 lev) tmp)
    tmp (cons (cons 43 0.0) tmp)
    tmp (cons (cons 70 0) tmp)
    tmp (cons (cons 90 (length pline)) tmp)
    tmp (cons (cons 100 "AcDbPolyline") tmp)
    tmp (cons (cons 100 "AcDbEntity") tmp)
    tmp (cons (cons 8 "Contour") tmp)
    tmp (cons (cons 0 "LWPOLYLINE") tmp)
      )            
             
   (entmake tmp)      
   )
   (setq lev (+ lev intv))
   )   
)   
   


     
;;       THINKING       ;
;;       ;
;;     Standard progress spinner       ;
;;       ;

(defun THINKING (prmpt think-cnt)
   (setq think-cnt (1+ think-cnt))
   (princ (strcat "\r" (nth (rem think-cnt 4) '("\|" "\/" "\-" "\\")) prmpt))
)


; ********************************* END OF CODING *****************************
(princ "\n'TRIANGULATE' Loaded \n")
(princ)
 


It now need to be optimized, probably sorting the edges would help.

Here is the point cloud :

Code: [Select]
(  (1652.17 356.759 16.4)
   (1666.15 431.163 16.1)
   (1688.64 379.861 16.2)
   (1708.17 888.849 13.8)
   (1763.96 799.643 14.1)
   (1818.56 140.657 18.3)
   (1883.13 226.078 18.1)
   (1888.23 124.665 18.8)
   (1900.26 864.281 12.8)
   (1950.15 730.671 12.5)
   (1979.73 671.496 12.1)
   (2031.64 260.656 15.8)
   (2069.42 69.732 22.2)
   (2071.19 123.139 19.8)
   (2096.73 383.737 15.4)
   (2173.55 135.927 20.7)
   (2241.51 1048.67 15.1)
   (2298.4 460.399 12.3)
   (2304.6 871.301 12.0)
   (2441.41 517.957 11.5)
   (2455.6 695.636 10.0)
   (2462.35 249.15 18.3)
   (2585.43 387.857 9.8)
   (2591.77 477.032 9.5)
)

I have attached an image of the results, not too sure if it will work.  :?

ymg
Title: Re: Triangulation (re-visited)
Post by: SOFITO_SOFT on May 30, 2011, 12:48:29 AM
Holas:
Very small differences, but actually looks better. :-)
The best test is made ​​with points that are in one of the sought contour. So, if the new curve (polyline) boundary passes over the points, is that the process can be taken for good.
Greetings  :-)
PS. In the dwg , old solution on color 21, new en cyan / blue
Title: Re: Triangulation (re-visited)
Post by: SOFITO_SOFT on May 30, 2011, 02:27:20 AM
Hello all:
The slopes plan also improves, the changes are more evenly distributed.
Thanks Eugeny. :-)
(http://img42.imageshack.us/img42/4808/slopeplane.gif) (http://imageshack.us/photo/my-images/42/slopeplane.gif/)

Greetings.
Title: Re: Triangulation (re-visited)
Post by: ymg on May 30, 2011, 11:19:15 AM
Quote
Holas:
Very small differences, but actually looks better.
The best test is made ​​with points that are in one of the sought contour. So, if the new curve (polyline) boundary passes over the points, is that the process can be taken for good.

Holas, Sofito

I did contour your drawing to get an idea of speed. On a 1m. interval took about 15 sec. on my laptop.

However you end up with joined plines at the proper level.  Also I am sure that this could be optimized
and accelerated quite a bit.  Also the triangle list could be destroyed once the edges list is created.

What I did to make the contour pass over the point is to disturb the elevation of the point(s)
by 1e -8 so that the edge is included in the contlst.

I notice on your revised drawing that some of the color 21 contour turn on themselves which is a
big No...No

Will look at it some more.

ymg
Title: Re: Triangulation (re-visited)
Post by: SOFITO_SOFT on May 30, 2011, 01:30:17 PM
Hello:

I did contour your drawing to get an idea of speed. On a 1m. interval took about 15 sec. on my laptop.<<<< 6 seg in my PC....is reasonable , for me.

Also I am sure that this could be optimized <<<< There are 3 or 4 methods ( p.e.geometric general calculation ) that are not highly purified. If you have any interest in something really fast ( productive? ), please write me to e-mail private.

I notice on your revised drawing that some of the color 21 contour turn on themselves which is a
big
<<<< is a problem that I could not solve. It occurs when there is a flat surface. The contour, effectively, turns on itself. She surrounds the flat area is closed, leaving some segment no possibility of being soldiers. Any idea to resolve it?

Will look at it some more.<<<< It is a fascinating subject
Greetings.
Title: Re: Triangulation (re-visited)
Post by: SOFITO_SOFT on May 30, 2011, 03:28:47 PM
Hello again:
Eugeny: another "extravaganza" of your algorithm ... please watch the yellow circle in extreme of wellow arrow......

(http://img851.imageshack.us/img851/9218/eugenybugtriangulating.gif) (http://imageshack.us/photo/my-images/851/eugenybugtriangulating.gif/)
 
Best regards..
Title: Re: Triangulation (re-visited)
Post by: ElpanovEvgeniy on May 30, 2011, 04:45:18 PM
Eugeny: another "extravaganza" of your algorithm ... please watch the yellow circle in extreme of wellow arrow......

I confirm that the program does not give the best result. But I have no need to continue in the near future to work on this program. The program was created for the contest on this site. Problem solver, I have used in the abridged version. All necessary for me, the decisions necessary for me, I already have. I give permission to fully use its program to your goals, including changes to its complement and so on. I ask only to maintain the link in the code for me.

PS. If you need to modify this program, or you want to order from me, a new program for your internal purposes only - please contact me directly offline. I am always ready to consider any offers.

Best Regards, ElpanovEvgeniy
Title: Re: Triangulation (re-visited)
Post by: SOFITO_SOFT on May 30, 2011, 05:11:14 PM
Hello again:
Evgeny: thanks for the information and the special program.
Greetings.
Title: Re: Triangulation (re-visited)
Post by: ElpanovEvgeniy on May 30, 2011, 05:19:51 PM
I hope my words do not destroy the great atmosphere of communication and mutual learning on the forum!  :?
Title: Re: Triangulation (re-visited)
Post by: pkohut on May 30, 2011, 05:27:44 PM
I hope my words do not destroy the great atmosphere of communication and mutual learning on the forum!  :?


You've contributed a great piece of code ElpanovEvgeniy, Спасибо.
Title: Re: Triangulation (re-visited)
Post by: ElpanovEvgeniy on May 30, 2011, 05:31:12 PM
You've contributed a great piece of code ElpanovEvgeniy, Спасибо.

You wrote this code in another language and your code is much faster...
Title: Re: Triangulation (re-visited)
Post by: pkohut on May 30, 2011, 05:57:19 PM
You've contributed a great piece of code ElpanovEvgeniy, Спасибо.

You wrote this code in another language and your code is much faster...


It uses a different algorithm than Paul Bourke's to crank the speed way up, being written in C++ just pushes it over the top more.  :-) With the internal data structures (http://www.theswamp.org/index.php?topic=15784.msg310523#msg310523), support for contouring and break lines would just need a little code.

Like you, it was done for personal interest at the time and achieved its primary goal
Title: Re: Triangulation (re-visited)
Post by: VovKa on May 30, 2011, 06:22:29 PM
another one
http://dwg.ru/dnl/?id=1766
Title: Re: Triangulation (re-visited)
Post by: SOFITO_SOFT on May 30, 2011, 08:02:13 PM
Hello again:
Evgeny: the one that says what is right, there is no threat to destroy anything.
In Spanish  is said : it that telling the truth, nor commit sin, nor lying.
I attached a dwg that I think will help you test the algorithm, for the day you get back the program.
Greetings from Madrid.
Title: Re: Triangulation (re-visited)
Post by: SOFITO_SOFT on May 30, 2011, 08:18:23 PM
Adorning with colors the triangulations, the 3DFACE and contours with color by slope (3dfaces ) or level ( polylines) .
Endless possibilities.
Greetings.

(http://img38.imageshack.us/img38/4733/coloreandolastriangulac.gif) (http://imageshack.us/photo/my-images/38/coloreandolastriangulac.gif/)

 
Title: Re: Triangulation (re-visited)
Post by: ymg on May 30, 2011, 08:56:31 PM
Evgenyi,

Too bad you let it go.

The speed of that piece of code is incredible!

However as I told you earlier it is written very tightly which makes it a little difficult to follow.

You are and remain a great contributor.

ymg
Title: Re: Triangulation (re-visited)
Post by: ymg on May 30, 2011, 09:46:45 PM
Quote
Also I am sure that this could be optimized <<<< There are 3 or 4 methods ( p.e.geometric general calculation ) that are not highly purified. If you have any interest in something really fast ( productive? ), please write me to e-mail private.

I only do it for the fun of it.

My days as a surveyor are done.  With the speed that are obtainable these days and a GPS we could probably keep a dynamic update of a site as it is being graded. For example red zone you need to cut, blue you need to fill, green you are on grade. 

All this while sitting in the bulldozer or the grader.  I know such system do exist but are very pricey.

It is now within our capacity to actually do it.

Fascinating subject as you said.

Hasta Luego,

ymg
Title: Re: Triangulation (re-visited)
Post by: SOFITO_SOFT on May 31, 2011, 03:18:30 AM
Hello:
YMG: For example red zone you need to cut, blue you need to fill, green you are on grade.  <<<< fascinating and suggestive idea ...
Especially for large supericies / volumes with large cuts and fills thick ...
Will always be an approximation work ... the landfill is compressed ... the GPS has a tolerance ... the virgin land is washed by the rain ... but it can save many hours of expensive machinery ...
Very good idea! Bravo.
Title: Re: Triangulation (re-visited)
Post by: ElpanovEvgeniy on May 31, 2011, 03:27:38 AM
I think that the game of chess or the development of algorithms (programs) with a strong opponent (friend), it is a great honor! This session, the fastest way to perfection! Therefore, I always try to participate in the topics "-= {Challenge} =- ***".

My code, simple! Use gradual debugging - drawing lines after each piece of code, the example of five points in one hour, you can see and understand the entire algorithm. To do this, do not need to understand the code, draw the visualization of each segment code in the drawing.
I have heard many times that my code difficult to read. Maybe so, but it just and effective. For example in this problem ...

Each time, laying "a strong -  strong  code", I do contribute to the training of successors. I try to give food to those who seek to overtake me! I'm not interested to give the code for easy copying and use. I earn my bread by writing programs and algorithms. I am manage a process of comprehensive automation of CAD, CAM and CAE.
Title: Re: Triangulation (re-visited)
Post by: ymg on May 31, 2011, 07:50:24 PM
Quote
Very good idea! Bravo.

Well, the idea did not originate with me.

But I know it beats the hell out of driving stakes in the ground to mark cut&fill  :-D

ymg
Title: Re: Triangulation (re-visited)
Post by: SOFITO_SOFT on May 31, 2011, 07:52:02 PM
Holas
YMG: Another approach on the navigation above / below a MDT:
Using the contour levels like LWPOLYLINES...  can take advantage using the functions VLAX-CURVE-GETxxxxx. They are native Autocad code and therefore very very fast ...
A progressive sophistication might be, calculate the Z of a point (obtained from a GPS) on the original model and model desirable.
Comparison of Z, the current (real) with the original and desirable, can give much information on the debris (filled) to move and where.
I have done some testing ...with one MDT based on LWPOLYLINE. I post a micro-video... I fail to generate animated GIF, so herewith a AVI  :lol:
Greetings  :-)
Title: Re: Triangulation (re-visited)
Post by: ymg on May 31, 2011, 07:56:49 PM
Quote
I am manage a process of comprehensive automation of CAD, CAM and CAE.

Evgenyi,

I got back into triangulation and contouring as part of a hobby of mine which is writing GCode
for router machine.

There exist very good program like Vectric Aspire but they are so pricey!!

If you want to do 3d routing, thr problem is essantially contouring.

Cheers!

ymg
Title: Re: Triangulation (re-visited)
Post by: ymg on May 31, 2011, 09:02:33 PM
Quote
I have done some testing ...with one MDT based on LWPOLYLINE. I post a micro-video... I fail to generate animated GIF, so herewith a AVI 
Greetings 

Unfortunately, Sofito, the video did not show anything.

But don't be discouraged I am also video challenged.  :-D

ymg
Title: Re: Triangulation (re-visited)
Post by: SOFITO_SOFT on May 31, 2011, 09:21:02 PM
Hello:
In my pc, I can see. Sorry.
Moving the cursor over the LWPOLYLINES, clicking a point, it is estimated the 2 polylines closest point is interpolated and the original. It displays the Z. .. Now I can do with 2 sets of polylines in the layer "original" and "futuro".  The lsp displays the Z and differences and time calculation
I attached a static image of the video. and a dwg with the new method of double layer/mdt.
Greetings.
(http://img546.imageshack.us/img546/7660/surfincontours.gif) (http://imageshack.us/photo/my-images/546/surfincontours.gif/)
Title: Re: Triangulation (re-visited)
Post by: ElpanovEvgeniy on June 01, 2011, 05:32:10 AM
Quote
I am manage a process of comprehensive automation of CAD, CAM and CAE.

Evgenyi,

I got back into triangulation and contouring as part of a hobby of mine which is writing GCode
for router machine.

There exist very good program like Vectric Aspire but they are so pricey!!

If you want to do 3d routing, thr problem is essantially contouring.

Cheers!

ymg

A very strange sentence!
Individually written program, will always be significantly more expensive than to sell in large quantities. Free software has its price.

I sometimes are participating in such projects if the projects are necessary to me as well. Now I write 3D kernel for the direct management of vertices, edges and faces 3dsolid. All this is necessary in a project of precast ferroconcrete. The project is done under a separate technology, which is uncommon and can not be maintained well-known programs. The problem of triangulation, very far from me...
Title: Re: Triangulation (re-visited)
Post by: SOFITO_SOFT on June 01, 2011, 06:10:09 AM
  Now I write 3D kernel for the direct management of vertices, edges and faces 3dsolid. All this is necessary in a project of precast ferroconcrete. 
 
You've worked with solids "ACIS"? They are solid autocad. Are well documented.
very very interesting.
Greetings
Title: Re: Triangulation (re-visited)
Post by: ElpanovEvgeniy on June 01, 2011, 07:22:19 AM
 
You've worked with solids "ACIS"? They are solid autocad. Are well documented.
very very interesting.
Greetings

Yes, I use a simple command entmakex, entmode, entupd...
Title: Re: Triangulation (re-visited)
Post by: SOFITO_SOFT on June 01, 2011, 01:22:18 PM
Eugeny:
I thought rather  directly access to 3DSOLID with the  "SAT" files .
Giles opened the door, with a wonderful ACISDECODE subfunction.
From there, you can get the points, edges, vertices, faces, normal, holes, etc, of the ACIS solids.
I have read that it is developed also for NET.
It is always a good thing that new developments are compatible with something already established.
I do not know if your head warm.
A greeting.  :-)
Title: Re: Triangulation (re-visited)
Post by: ElpanovEvgeniy on June 01, 2011, 02:15:12 PM
Eugeny:
I thought rather  directly access to 3DSOLID with the  "SAT" files .
Giles opened the door, with a wonderful ACISDECODE subfunction.
From there, you can get the points, edges, vertices, faces, normal, holes, etc, of the ACIS solids.
I have read that it is developed also for NET.
It is always a good thing that new developments are compatible with something already established.
I do not know if your head warm.
A greeting.  :-)

All this is not the decoding and modeling - Change, for example, add or remove a port complex shape, or simply add / remove a point on one edge. This is the easiest level, and then - the cross section, sections, species in its representation of geometry. The problem of automatically creating species and the cross section with a complete adaptability - changed item, change views, changed views, changed body.

ps. arx not give full access to the geometry. Using arx, you can not add or delete a single point in the body ...
Title: Re: Triangulation (re-visited)
Post by: ymg on June 01, 2011, 04:17:09 PM
Quote
A very strange sentence!
Individually written program, will always be significantly more expensive than to sell in large quantities. Free software has its price.

Of course developing custom solutions is always more expensive.

However If you are doing it as a hobby, buying every nice program out there can break the bank.

Plus programming is another hobby.

ymg
Title: Re: Triangulation (re-visited)
Post by: ElpanovEvgeniy on June 01, 2011, 05:42:42 PM
Of course developing custom solutions is always more expensive.

However If you are doing it as a hobby, buying every nice program out there can break the bank.

Plus programming is another hobby.

ymg

I think you will release the project documentation.
I manage the release of automation software.

If you need to develop small programs or large system, you can contact me with offers. Until now, I work only in the domestic market, but is willing to work with other countries...
Title: Re: Triangulation (re-visited)
Post by: ymg on June 02, 2011, 09:39:27 PM
Evgenyi,

To go back to your triangulation, I did follow part of the code.

When you setup your first triangle in list s it is too small.

The vertex of that triangle are inside the circumcircle of other points on the outside.
In the litterature some authors advocate infinity for the so called supertriangle.

I have attached a picture showing the interference of your s triangle with some
of the points in the cloud.

If you fix that, I believe we have a Delaunay triangulator. 

ymg
Title: Re: Triangulation (re-visited)
Post by: ymg on June 02, 2011, 11:58:54 PM
Here I have revised your code:

Code: [Select]
(defun c:test (/ I L S)
 (princ (strcat "\n select points"))
 (if (setq i 0
           s (ssget '((0 . "POINT")))
     ) ;_  setq
  (progn (repeat (sslength s)
          (setq l (cons (cdr (assoc 10 (entget (ssname s i)))) l)
                i (1+ i)
          ) ;_  setq
         ) ;_  repeat
         (eea-delone-triangulate i l)
  ) ;_  progn
 ) ;_  if
) ;_  defun
(defun eea-delone-triangulate
      (i1  L   /   A   A1  A2  A3  I   I2  L1
       L2 L3  LP  MA MI  P  S    TI  TR  X1
       X2  Y1  Y2
      )
   ;;*********************************************************
   ;;
   ;; Written by  ElpanovEvgeniy
   ;; 17.10.2008
   ;; edit 20.05.2011
   ;; Program triangulate an irregular set of 3d points.     
   ;;
   ;;*********************************************************
   (if l
      (progn
(setq ti (car (_VL-TIMES))
       i  1
       i1 (/ i1 100.)
       i2 0
       l  (vl-sort
     (mapcar
(function (lambda (p)
     (list (/ (fix (* (car p) 1000)) 1000.)
   (/ (fix (* (cadr p) 1000)) 1000.)
   (caddr p)
     ) ;_  list
  ) ;_  lambda
) ;_  function
l
     ) ;_  mapcar
     (function (lambda (a b) (>= (car a) (car b))))
  ) ;_  vl-sort
       x2 (caar l)
       y1 (cadar l)
       y2 y1
) ;_  setq
(while l
    (setq a2 (car l))
    (if (<= (cadr a2) y1)
       (setq y1 (cadr a2))
       (if (> (cadr a2) y2)
  (setq y2 (cadr a2))
       )
    )
    (setq a  (fix (caar l))
  a1 (list (car l))
  l  (cdr l)
    ) ;_  setq
    (while (and l (= (fix (caar l)) a))
       (setq a2 (car l))
       (if (<= (cadr a2) y1)
  (setq y1 (cadr a2))
  (if (> (cadr a2) y2)
     (setq y2 (cadr a2))
  ) ;_  if
       ) ;_  if
       (setq a1 (cons (car l) (vl-remove a2 a1))
     l (cdr l)
       ) ;_  setq
    ) ;_  while
    (foreach a a1 (setq lp (cons a lp)))
) ;_  while
(setq x1 (caar lp)
       a  (list (/ (+ x1 x2) 2) (/ (+ y1 y2) 2))
       a1 (distance a (list x1 y1))
       ma (+ (car a)(* 20 a1));changed ymg
       mi (- (car a)(* 20 a1));changed ymg
       s  (list (list ma (cadr a) 0)
(list mi (+ (cadr a)(* 20 a1)) 0);changed ymg
(list mi (- (cadr a)(* 20 a1)) 0);changed ymg
  ) ;_ supertriangle
       l  (list (cons x2 (cons a (cons (+ a1 a1) s))))
       ;mi (- (car a)(* 20 a1));added ymg
       ma (1- ma)
       mi (1+ mi)
) ;_  setq

(while lp
    (setq p  (car lp)
  lp (cdr lp)
  l1 nil
    ) ;_  setq
    (while l
       (setq tr (car l)
     l (cdr l)
       ) ;_  setq
       (cond
  ((< (car tr) (car p)) (setq l2 (cons (cdddr tr) l2)))
  ((< (distance p (cadr tr)) (caddr tr))
   (setq tr (cdddr tr)
a1 (car tr)
a2 (cadr tr)
a3 (caddr tr)
l1 (cons (list (+ (car a1) (car a2))
(+ (cadr a1) (cadr a2))
a1
a2
  )
  (cons (list (+ (car a2) (car a3))
      (+ (cadr a2) (cadr a3))
      a2
      a3
)
(cons (list (+ (car a3) (car a1))
    (+ (cadr a3) (cadr a1))
    a3
    a1
      )
      l1
)
  ) ;_  cons
    ) ;_  cons
   ) ;_  setq
  )
  (t (setq l3 (cons tr l3)))
       ) ;_  cond
    ) ;_  while
    (setq l  l3
  l3 nil
  l1 (vl-sort l1
      (function (lambda (a b)
   (if (= (car a) (car b))
      (<= (cadr a) (cadr b))
      (< (car a) (car b))
   ) ;_  if
) ;_  lambda
      ) ;_  function
     ) ;_  vl-sort
    ) ;_  setq
    (while l1
       (if (and (= (caar l1) (caadr l1))
(= (cadar l1) (cadadr l1))
   )
  (setq l1 (cddr l1))
  (setq l  (cons (eea-data-triangle p (cddar l1)) l)
l1 (cdr l1)
  ) ;_  setq
       ) ;_  if
    ) ;_  while
    (if (and (< (setq i (1- i)) 1) (< i2 100))
       (progn
  (setvar
     "MODEMACRO"
     (strcat
"     "
(itoa (setq i2 (1+ i2)))
" %    "
(substr
   "||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||"
   1
   i2
) ;_  substr
(substr "..." 1 (- 100 i2))
     ) ;_  strcat
  ) ;_  setvar
  (setq i i1)
       ) ;_  progn
    ) ;_  if
) ;_  while
(foreach a l (setq l2 (cons (cdddr a) l2)))

;purge triangle list
(setq
    l2 (vl-remove-if-not
  (function
     (lambda (a)
(and (< mi (caadr a) ma) (< mi (caaddr a) ma))
     )
  )
  l2
       ) ;_  vl-remove-if
) ;_  setq
(foreach a l2
    (entmake (list (cons 0 "3DFACE")
   (cons 10 (car a))
   (cons 11 (car a))
   (cons 12 (cadr a))
   (cons 13 (caddr a))
     ) ;_  list
    ) ;_  entmake
) ;_  foreach
      ) ;_  progn
   ) ;_  if
   (setvar "MODEMACRO" "")
   (princ (strcat "\n "
  (rtos (/ (- (car (_VL-TIMES)) ti) 1000.) 2 4)
  " secs."
  )
   )
   (princ)
) ;_  defun
(defun eea-data-triangle (P1 l / A A1 P2 P3 P4 S)
   ;;*********************************************************
   ;;
   ;; Written by  ElpanovEvgeniy
   ;; 17.10.2008
   ;; Calculation of the centre of a circle and circle radius
   ;; for program triangulate
   ;;
   ;; (eea-data-triangle (getpoint)(list(getpoint)(getpoint)))
   ;;*********************************************************
   (setq p2 (car l)
p3 (cadr l)
p4 (list (car p3) (cadr p3))
   ) ;_  setq
   (if (not
  (zerop
     (setq s (sin (setq a (- (angle p2 p4) (angle p2 p1)))))
  )
       )
      (progn (setq a  (polar p4
     (+ -1.570796326794896 (angle p4 p1) a)
     (setq a1 (/ (distance p1 p4) s 2.))
      ) ;_  polar
   a1 (abs a1)
     ) ;_  setq
     (list (+ (car a) a1) a a1 p1 p2 p3)
      ) ;_  progn
   ) ;_  if
) ;_  defun

I don't think anything I did will affect the speed.

Attached a gif of the result.

ymg

Title: Re: Triangulation (re-visited)
Post by: SOFITO_SOFT on June 03, 2011, 04:39:20 AM
Hello:
ymg :
Another way of navigating in 3d over a MDT ... for a XY point which are the points that cut the 3dsolids generates by 3DFACEs.
In this case, draw lines between points found in the vertical of 3 3dsolid.

Time for the example: 0.374973 seg. for 6 points founds....To improve... :-(

(http://img600.imageshack.us/img600/4368/sandwichentretableroyte.gif) (http://imageshack.us/photo/my-images/600/sandwichentretableroyte.gif/)
Greetings. :-)
Title: Re: Triangulation (re-visited)
Post by: SOFITO_SOFT on June 03, 2011, 07:35:36 AM
Oops...
after some small problems with sub-functions releases  :lol: :lol:....the LSP for navigating in 3d over a MDT ( several 3dsolids )
( c:ll ) ...for initialize and...
( c:pto_en_Z_solid ) for run...
Greetings  :-)


Title: Re: Triangulation (re-visited)
Post by: ymg on June 14, 2011, 07:40:16 PM
Here is Evgeniy's triangulation commented for analysis.

The problem with first triangle is corrected, but note that in certain case it could be too small.

I have renamed most variables and commented.

Code: [Select]
(defun c:test (/ i pl s)
   (princ (strcat "\n select points"))
   (if (setq i 0
     s (ssget '((0 . "POINT")))
       )
      (progn (repeat (sslength s)
(setq pl (cons (cdr (assoc 10 (entget (ssname s i)))) pl)
      i (1+ i)
)
     )
     (triangulate pl)
      )
   )
)


;;********************************************************;
;;                                                        ;
;; Written by  ElpanovEvgeniy                             ;
;; 17.10.2008                                             ;
;; edit 20.05.2011                                        ;
;; Program triangulate an irregular set of 3d points.     ;
;; Modified by ymg June 2011                              ;
;;********************************************************;

(defun triangulate (pl  /  a   b   c   i   i1   i2
    bb  sl al  el  tl  l   ma  mi     
    ti  tr x1  x2  y1  y2  p    r  cp
   )
   
   (if pl
      (progn
(setq ti (car (_VL-TIMES))
       i  1
       i1 (/ (length pl) 100.)
       i2 0
       pl (vl-sort pl
     (function (lambda (a b) (< (car a) (car b))))
  )
       bb (list (apply 'mapcar (cons 'min pl))
                (apply 'mapcar (cons 'max pl))
                  )
               ;Replaced code to get minY and maxY with 3d Bounding Box Routine;
       ;A bit slower but clearer. minZ and maxZ kept for contouring    ;
       
       x1 (caar bb)   ;minX
       x2 (caadr bb)  ;maxX
       y1 (cadar bb)  ;minY
       y2 (cadadr bb) ;maxY
       
       
)
(setq cp (list (/ (+ x1 x2) 2.0) (/ (+ y1 y2) 2.0)); Midpoint of points cloud and center point of circumcircle through supertriangle.
        r (* (distance cp (list x1 y1)) 20) ;This could still be too small in certain case. No harm if we make it bigger.
       ma (+ (car cp) r);ma is maxX of supertriangle
       mi (- (car cp) r);mi is minX of supertriangle
       sl (list (list ma (cadr cp) 0);list of 3 points defining the supertriangle
(list mi (+ (cadr cp) r) 0)
(list mi (- (cadr cp) r) 0)
  )
 
       al  (list (cons x2 (cons cp (cons (* 20 r) sl))))
      ;al is a work list that contains active triangles each item is a list that contains:      ;
      ;     item 0: Xmax of points in triangle.                         ;
      ;     item 1: List 2d coordinates of center of circle circumscribing triangle.  ;
      ;     item 2: Radius of above circle.                     ;
      ;     item 3: List of 3 points defining the triangle                          ;

       ma (1- ma);Reducing ma to prepare for removal of triangles having a vertex
       mi (1+ mi);common with supertriangle. Done once triangulation is completed.
)               ;Increasing mi for same reason.


;Begin insertion of points

(repeat (length pl)
   
    (setq  p (car pl);Get one point from point list
  pl (cdr pl);Remove point from point list
  el nil     ;Initialize edge list
    )
    (while al ;Active triangle list
       (setq tr (car al);Get one triangle from active triangle list.
     al (cdr al);Remove the triangle from the active list.
       )
       (cond
  ((< (car tr) (car p)) (setq tl (cons (cdddr tr) tl)));This triangle inactive. We store it's 3 vertex in tl (Final triangle list).
  ((< (distance p (cadr tr)) (caddr tr));p is inside the triangle.
   (setq tr (cdddr tr) ;Trim tr to vertex of triangle only.
  a (car tr)   ;  First point.
  b (cadr tr)  ;  Second point.
  c (caddr tr) ;  Third point.
         el (cons (list (+ (car a) (car b))   ;We create 3 new edges ab, bc and ca,
        (+ (cadr a) (cadr b)) ;and store them in edge list.
a
b
  )
  (cons (list (+ (car b) (car c))
      (+ (cadr b) (cadr c))
      b
      c
)
(cons (list (+ (car c) (car a))
    (+ (cadr c) (cadr a))
    c
    a
      )
      el
)
  )
    )
   
   )
  )
  (t (setq l (cons tr l)))   ;tr did not meet any cond so it is still active.
       )      ;we store it a temporary list.
    );Go to next triangle of active list.
   
    (setq al l    ;Restore active triangle list from the temporary list.
   l nil  ;Re-initialize the temporary list to prepare for next insertion.
 
  el (vl-sort el ;Sort the edges list on X and Y
        (function (lambda (a b)
     (if (= (car a) (car b))
        (<= (cadr a) (cadr b))
        (< (car a) (car b))
     )
  )
        )
     )
    )

    ;Removes doubled edges, form new triangles, calculates circumcircles and add them to active list.
    (while el
       (if (and (= (caar el) (caadr el))
(= (cadar el) (cadadr el))
   )
  (setq el (cddr el))
  (setq al (cons (getcircumcircle p (cddar el)) al)
el (cdr el)
  )
       )
    )
    ;Spinner to show progress
    (if (and (< (setq i (1- i)) 1) (< i2 100))
       (progn
  (setvar
     "MODEMACRO"
     (strcat
"     "
(itoa (setq i2 (1+ i2)))
" %    "
(substr
   "||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||"
   1
   i2
)
(substr "..." 1 (- 100 i2))
     )
  )
  (setq i i1)
       )
    )
) ;Go to insert next point.
;We are done with the triangulation

(foreach tr al (setq tl (cons (cdddr tr) tl)));What's left in active list is added to triangle list

;Purge triangle list of any triangle that has a common vertex with supertriangle.
(setq
    tl (vl-remove-if-not
  (function
     (lambda (a)
(and (< mi (caadr a) ma) (< mi (caaddr a) ma))
     )
  )
  tl
       )
)


;Create a layer and Draw the triangulation
(or (tblsearch "LAYER" "TIN")
    (entmake (list
'(0 . "LAYER")
                '(100 . "AcDbSymbolTableRecord")
        '(100 . "AcDbLayerTableRecord")
        '(2 . "TIN")
        '(70 . 0)
        '(62 . 8)
        '(6 . "Continuous")
                        '(290 . 1)
        '(370 . -3)
                     )
             )
)

(setvar "CLAYER" "TIN")

(foreach tr tl
    (entmake (list (cons 0 "3DFACE")
   (cons 10 (car tr))
   (cons 11 (car tr))
   (cons 12 (cadr tr))
   (cons 13 (caddr tr))
     )
    )
)
      )
   )
   (setvar "MODEMACRO" "")
   (princ (strcat "\n "
  (rtos (/ (- (car (_VL-TIMES)) ti) 1000.) 2 4)
  " secs."
  )
   )
   (princ)
)


;;*********************************************************;
;;    ;
;; Written by  ElpanovEvgeniy    ;
;; 17.10.2008    ;
;; Calculation of the centre of a circle and circle radius ;
;; for program triangulate    ;
;;    ;
;; Modified ymg june 2011 (renamed variables)    ;
;;*********************************************************;

(defun getcircumcircle (a el /  b c c2 cp r ang)
     
   (setq b (car el)
c (cadr el)
c2 (list (car c) (cadr c)) ;c2 is point c but in 2d
   )
   (if (not
  (zerop
     (setq ang (- (angle b c) (angle b a)))
  )
       )
      (progn (setq cp (polar c2
  (+ -1.570796326794896 (angle c a) ang)
  (setq r (/ (distance a c2) (sin ang) 2.0))
      )
    r (abs r)
     )
     (list (+ (car cp) r) cp r a b c)
      )
   )
)



ymg
Title: Re: Triangulation (re-visited)
Post by: ElpanovEvgeniy on June 15, 2011, 01:44:27 AM
Hi ymg! :)

Now, the program still seems complicated?
Title: Re: Triangulation (re-visited)
Post by: ymg on June 15, 2011, 12:11:56 PM
Quote
Now, the program still seems complicated?

No, since it is basically the same algoritmn as Piazza's program.

However I have to agree with Vovka's comment about your variable naming style  :-D

The Divide and conquer algorithm could be faster than this one if written properly.

ymg
Title: Re: Triangulation (re-visited)
Post by: ElpanovEvgeniy on June 15, 2011, 12:30:00 PM
No, since it is basically the same algoritmn as Piazza's program.

Can be a little more detail?
I first heard about this algorithm ...
For this program, I developed an algorithm by yourself!
Title: Re: Triangulation (re-visited)
Post by: chlh_jd on June 15, 2011, 02:00:57 PM
Evgeniy is always Wonderful !!!
This is I learn your Excellent Programe twice , The first is GA for TSP .
Saw the scriptures , rise the praise .

Thanks ymg , Thanks Evgeniy .


Title: Re: Triangulation (re-visited)
Post by: ElpanovEvgeniy on June 15, 2011, 02:14:33 PM
The first is GA for TSP .

I'm sorry, I do not remember what this program. 
Title: Re: Triangulation (re-visited)
Post by: ElpanovEvgeniy on June 15, 2011, 02:16:26 PM
TSP = Travelling salesman problem
and
GA  = genetic algorithm
??
Title: Re: Triangulation (re-visited)
Post by: chlh_jd on June 16, 2011, 07:07:58 AM
You're right . I'm sorry for excessive omitted .
Title: Re: Triangulation (re-visited)
Post by: ymg on June 16, 2011, 01:08:41 PM
Quote
Can be a little more detail?
I first heard about this algorithm ...
For this program, I developed an algorithm by yourself!]

For a good explanation of the various way to triangulate go to this link http://www.cs.cmu.edu/~quake/tripaper/triangle2.html (http://www.cs.cmu.edu/~quake/tripaper/triangle2.html)

Divide and conquer algorithm is conceptually the same as a Merge Sort.

ymg
Title: Re: Triangulation (re-visited)
Post by: ElpanovEvgeniy on June 16, 2011, 05:53:05 PM
The Divide and conquer algorithm could be faster than this one if written properly.

do you propose to continue the contest in Lisp?
It is a challenge?
Title: Re: Triangulation (re-visited)
Post by: ymg on June 17, 2011, 07:11:15 AM
Quote
do you propose to continue the contest in Lisp?
It is a challenge?

Not really a challenge, like I told you I am very rusted in Lisp and computer programming in general.

Besides the divide and conquer force you to retriangulate everything when you want to add points.

Whereby  with Lawson's insertions you simply added them to what is there.

More useful would be to devise a scheme to add constrain to what we got.

ymg
Title: Re: Triangulation (re-visited)
Post by: TopoWAR on July 24, 2011, 11:37:49 AM
ymg , hello teacher, I found a small problem in your code of triangulation, the matter is repeated points, the question is which is the most accurate and quick delete repeated elements in a list? Thank you.
Title: Re: Triangulation (re-visited)
Post by: ymg on July 26, 2011, 08:06:12 PM
Hi,

Don't know if I understand your question correctly.  But all algorithm for Delaunay triangulation do not allow duplicate point.

Our implementation in Lisp does not check for the presence of duplicate as it is.  The dataset is supposed to have been filtered before and any duplicate removed or slightly perturbed so as not to cause havoc.

Hopes this covers it, and sorry about the late answer.

ymg
Title: Re: Triangulation (re-visited)
Post by: ElpanovEvgeniy on July 27, 2011, 01:58:44 AM
We can calculate the convex hull for the remaining points, you can create the opposite direction. Need to reflect on the algorithms...
Title: Re: Triangulation (re-visited)
Post by: ymg on July 02, 2013, 01:31:39 PM
I know the thread is getting older but....

I've modified Evgeniy triangulation to operate on index instead of coordinates.
Speed penalty is minor as far as I can tell.

With the list of index created, I calculate contours.  However speed is not that
great.  I believe the bottleneck to be in all those vl-remove.

Would appreciate any pointers as  to how to accelerate.

There is a lot of comments explaining the way I go about it.

There is a small routine gen which create a bunch of points for testing,


Code - Auto/Visual Lisp: [Select]
  1. (defun c:tin (/ i s)
  2.    (princ (strcat "\n select points"))
  3.    (if (setq i 0
  4.              pl nil
  5.              s (ssget '((0 . "POINT")))
  6.        )
  7.       (progn
  8.         (repeat (sslength s)
  9.              (setq pl   (cons (cdr (assoc 10 (entget (ssname s i)))) pl)
  10.                     i   (1+ i)
  11.              )
  12.         )
  13.         (triangulate pl)
  14.      )
  15.    )
  16. )
  17.  
  18.  
  19. ;;*****************************************************************************;
  20. ;;                                                                                                                                             ;
  21. ;; Structure of Program by  ElpanovEvgeniy                                                                                ;
  22. ;; 17.10.2008                                                                                                                            ;
  23. ;; edit 20.05.2011                                                                                                                     ;
  24. ;; Program triangulate an irregular set of 3d points.                                                                    ;
  25. ;; Modified and Commented by ymg June 2011.                                                                          ;
  26. ;; Modified to operate on index by ymg in June 2013.                                                                 ;
  27. ;; Contour Generation added by ymg in June 2013.                                                                     ;
  28. ;;*****************************************************************************;
  29.  
  30. (defun triangulate (pl  /   a   b   c   i   i1   i2  xmin ymin zmin
  31.                     bb  sl  pl  el  l   zm  z1   z2  xmax ymax zmax                
  32.                     ti  tr  np  n   j   r   cp   sl  pl   al   intv
  33.                     p   tl  vc  pc  e   cl  xl   pol ent  nxt
  34.                    )
  35.    
  36.    (if pl
  37.       (progn
  38.          (setq ti (car (_VL-TIMES));Initialize timer for Triangulation                            ;
  39.                 i  1
  40.                i1 (/ (length pl) 100.)
  41.                i2 0
  42.                ; Variables and Constant to Control Progress Spinner                               ;
  43.                tl nil
  44.                
  45.                pl (vl-sort pl
  46.                      (function (lambda (a b) (< (car a) (car b))))
  47.                   )
  48.                ; Sort points list on x coordinates                                                ;
  49.                
  50.                bb (list (apply 'mapcar (cons 'min pl))
  51.                         (apply 'mapcar (cons 'max pl))
  52.                   )
  53.                ;Replaced code to get the min and max with 3d Bounding Box Routine                 ;
  54.                ;A bit slower but clearer. zmin and zmax kept for contouring                       ;
  55.                
  56.                xmin (caar bb)      
  57.                xmax (caadr bb)      
  58.                ymin (cadar bb)      
  59.                ymax (cadadr bb)      
  60.                zmin (caddar bb)    
  61.                zmax (caddr(cadr bb))
  62.                
  63.                np (length pl) ;Number of points to insert                                         ;
  64.                
  65.                cp (list (/ (+ xmin xmax) 2.0) (/ (+ ymin ymax) 2.0))
  66.                ; Midpoint of points cloud and center point of circumcircle through supertriangle. ;
  67.                 r (* (distance cp (list xmin ymin)) 20)
  68.                ; This could still be too small in certain case. No harm if we make it bigger.     ;
  69.                
  70.                sl (list (list (+ (car cp) r) (cadr cp) 0)          
  71.                         (list (- (car cp) r) (+ (cadr cp) r) 0)    
  72.                         (list (- (car cp) r) (- (cadr cp) r) 0)
  73.                   )
  74.                ; sl list of 3 points defining the Supertriangle,                                  ;
  75.                ; I have tried initializing to an infinite triangle but it slows down calculation  ;
  76.                pl (append pl sl)
  77.                ;Vertex of Supertriangle are appended to the Point list                            ;
  78.                sl (list np (+ np 1)(+ np 2))
  79.                ;sl now is a list of index into point list defining the supertriangle              ;
  80.                
  81.                al  (list(list xmax cp r sl))
  82.               ;Initialize the Active Triangle list                                                ;
  83.               ; al is a  list that contains active triangles defined by 4 items:                  ;
  84.               ;     item 0: Xmax of points in triangle.                                           ;
  85.               ;     item 1: List 2d coordinates of center of circle circumscribing triangle.      ;
  86.               ;     item 2: Radius of above circle.                                               ;
  87.               ;     item 3: List of 3 indexes to vertices defining the triangle                   ;
  88.                
  89.                n -1
  90.               ; n is a counting index into Point List                                             ;
  91.          )              
  92.  
  93.          
  94.          ;Begin insertion of points
  95.          
  96.          (repeat np
  97.            
  98.             (setq  n (1+ n)     ; Increment Index into Point List                                 ;
  99.                    p (nth n pl) ; Get one point from point list                                   ;
  100.                   el nil        ; el list of triangles edges                                      ;
  101.             )                   ;                                                                 ;
  102.             (repeat (length al) ; Loop to go through Active triangle list                         ;
  103.                (setq tr (car al); Get one triangle from active triangle list.                     ;
  104.                      al (cdr al); Remove the triangle from the active list.                       ;
  105.                )
  106.                (cond
  107.                   ((< (car tr) (car p)) (setq tl (cons (cadddr tr) tl)))
  108.                   ;This triangle inactive. We store it's 3 vertex in tl (Final triangle list).    ;
  109.                  
  110.                   ((< (distance p (cadr tr)) (caddr tr)) ; p is inside the triangle.                  ;
  111.                    (setq tr (cadddr tr)          ; Trim tr to vertex of triangle only.   ;
  112.                           a (car tr)                             ;  Index of First point.                    ;
  113.                           b (cadr tr)                           ;  Index of Second point.                ;
  114.                           c (caddr tr)                         ;  Index of Third point.                   ;
  115.                          el (cons (list a                            ; ((a b)(b c)(c a) (. .)(. .).....)      ;
  116.                                         b
  117.                                   )
  118.                                   (cons (list b
  119.                                               c
  120.                                         )
  121.                                         (cons (list c
  122.                                                     a
  123.                                               )
  124.                                               el
  125.                                         )
  126.                                   )
  127.                             )
  128.                            
  129.                    )
  130.                   )
  131.                   (t (setq l (cons tr l)))
  132.                   ;tr did not meet any cond so it remain active. We store it in the swap list     ;
  133.                );End cond
  134.              
  135.             );End repeat, go to next triangle of active list.
  136.            
  137.            
  138.             (setq al l    ;Restore active triangle list from the temporary list.                  ;
  139.                    l nil  ;Clear the swap list to prepare for next insertion.                     ;
  140.             )
  141.            
  142.             ;Removes doubled edges, calculates circumcircles and add them to al                   ;
  143.             (while el
  144.                (if (or (member (reverse (car el)) el)
  145.                        (member (car el) (cdr el))
  146.                    )
  147.                    (setq el (vl-remove (reverse (car el)) el)
  148.                          el (vl-remove (car el) el)
  149.                    )
  150.                    (setq al (cons (getcircumcircle n (car el)) al)
  151.                          el (cdr el)
  152.                   )
  153.                )
  154.             )
  155.            
  156.             ; Neat Spinner to show progress does not work too good with Window7                   ;
  157.             (if (and (< (setq i (1- i)) 1) (< i2 100))
  158.                (progn
  159.                   (setvar
  160.                      "MODEMACRO"
  161.                      (strcat
  162.                         "     "
  163.                         (itoa (setq i2 (1+ i2)))
  164.                         " %    "
  165.                         (substr
  166.                            "||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||"
  167.                            1
  168.                            i2
  169.                         )
  170.                         (substr "..." 1 (- 100 i2))
  171.                      )
  172.                   )
  173.                   (setq i i1)
  174.                )
  175.             )
  176.            
  177.          ) ;End repeat np, Go to insert next point
  178.          
  179.        
  180.          ;We are done with points insertion. Any triangle left in al is added to tl               ;
  181.          
  182.          (foreach tr al (setq tl (cons (cadddr tr) tl)))
  183.          
  184.          ;Purge triangle list of any triangle that has a common vertex with supertriangle.        ;
  185.          (setq
  186.             tl (vl-remove-if-not
  187.                   (function
  188.                      (lambda (a)
  189.                         (and (< (car a) np)(< (cadr a) np)(< (caddr a) np))
  190.                      )
  191.                   )
  192.                   tl
  193.                )
  194.          )
  195.  
  196.  
  197.          ;Create a layer and Draw the triangulation                                               ;
  198.          (or (tblsearch "LAYER" "TIN")
  199.             (entmake (list
  200.                         '(0 . "LAYER")
  201.                         '(100 . "AcDbSymbolTableRecord")
  202.                         '(100 . "AcDbLayerTableRecord")
  203.                         '(2 . "TIN")
  204.                         '(70 . 0)
  205.                         '(62 . 8)
  206.                         '(6 . "Continuous")
  207.                         '(290 . 1)
  208.                         '(370 . -3)
  209.                      )
  210.              )
  211.          )
  212.          
  213.          (setvar "CLAYER" "TIN")
  214.          
  215.          (foreach tr tl
  216.             (entmake (list (cons 0 "3DFACE")
  217.                            (cons 10 (nth (car tr)   pl))
  218.                            (cons 11 (nth (car tr)   pl))
  219.                            (cons 12 (nth (cadr tr)  pl))
  220.                            (cons 13 (nth (caddr tr) pl))
  221.                      )
  222.             )
  223.          )
  224.       )
  225.    )
  226.    (setvar "MODEMACRO" "")
  227.    
  228.    (princ (strcat "\n     TIN Completed - Elapsed time: " (rtos (/ (- (car (_VL-TIMES)) ti) 1000.) 2 4) " secs."))
  229.    (princ (strcat "\n         Generated   " (itoa (length tl)) " 3DFACES"))
  230.    (princ "\n")
  231.  
  232.  
  233.    ; Begin Calculation of Contour line                                                            ;
  234.    ;                                                                                              ;
  235.    ; The routine follows each contour from edge to edge resulting in Connected LWPOLYLINE.        ;
  236.    ;                                                                                              ;
  237.    ; 1. Sort triangle list tl on the maximum z value of vertices of each triangles.               ;
  238.    ; 2. Create el, a list containing all edges of all triangles. ((a b)(b c) (c a).......)        ;
  239.    ; 3. For each desired contour level l, we traverse el and  create list cl containing all       ;
  240.    ;    edges crossed by level l. At this point cl contains 2 edges per triangle.                 ;
  241.    ;    As we go through el, we can destroy any triplets of edges whose max z value is  below     ;
  242.    ;    the current contour level, thus limiting traversal for next level.                        ;
  243.    ; 4. We now process cl, first locating an edge with no neighbour if any and follow from edge   ;
  244.    ;    to edge until either we've closed the polyline or reached the convex hull.                ;
  245.    ;    As we complete each polyline list xl is formed.                                           ;
  246.    ; 5. We entmake each element of list xl thus completing.                                       ;
  247.    ;    Step 4 and 5 could be combined but it is easier to follow contour in index form           ;
  248.    ;                                                                                              ;
  249.    ;                                                                                              ;
  250.    ; An alternate way to do this would be compute all al segment between two edges joining with   ;
  251.    ; with a line for all contour level and at end Join everything together.                       ;
  252.    ;                                                                                              ;
  253.    
  254.    (setq tl (vl-sort tl
  255.                 (function
  256.                     (lambda (a b)
  257.                         (< (max (caddr (nth (car a) pl))
  258.                                 (caddr (nth (cadr a) pl))   ;Gotta be a more concise way         ;
  259.                                 (caddr (nth (caddr a) pl))  ;to write this probably with apply.  ;
  260.                            )
  261.                            (max (caddr (nth (car b) pl))
  262.                                 (caddr (nth (cadr b) pl))
  263.                                 (caddr (nth (caddr b) pl))
  264.                            )
  265.                         )
  266.                     )
  267.                 )
  268.             )
  269.    )
  270.  
  271.    ; Setup for Contouring                                                                         ;
  272.    (setq   ti (car (_VL-TIMES))   ; Re-initialize timer for Contouring                            ;
  273.          intv 1                   ; Interval between contour                                      ;
  274.          zmin (+ (fix zmin) intv) ; zmin was calculated during triangulation                      ;
  275.          zmax (fix zmax)          ; z2 also calculated at beginning                               ;
  276.             l zmin                ; Initialize Contour level                                      ;
  277.            el nil                 ; el will be list of all edges                                  ;
  278.            vc 0                   ; Vertices Count                                                ;
  279.            pc 0                   ; LWPOLYLINE Count                                              ;
  280.    )
  281.  
  282.    ; Extract all triangle edges from tl and form list el                                          ;
  283.    (foreach tr tl
  284.      (setq el (cons (list (car tr)(cadr tr)) el)
  285.            el (cons (list (cadr tr)(caddr tr)) el)
  286.            el (cons (list (caddr tr)(car tr)) el)
  287.      )
  288.    )
  289.                  
  290.    
  291.    (repeat (+(fix (/ (- zmax zmin) intv)) 1) ;Main Loop through each contour level                ;
  292.      
  293.      (setq cl nil   ; cl will be list of all edges crossed at current level l                     ;
  294.             j 0     ; Index into edge list el                                                     ;
  295.            zm 1e-8  ; zmax value for a given triplets of edges                                    ;
  296.      )
  297.      (repeat (length el)
  298.        (setq  e (nth j el)
  299.              z1 (caddr (nth (car e) pl))  ; Get elevation of edges from the point list.           ;
  300.              z2 (caddr (nth (cadr e) pl))
  301.              zm (max zm z1 z2)  
  302.               j (1+ j)
  303.        )
  304.        
  305.        (if (and (= (rem j 3) 0) (< zm (+ l intv))) ; Reduce size of el on zmax criteria.          ;
  306.              (setq  j (- j 3)
  307.                    el (vl-remove (nth j el) el)
  308.                    el (vl-remove (nth j el) el)
  309.                    el (vl-remove (nth j el) el)
  310.                    zm 1e-8
  311.              )
  312.        )
  313.              
  314.        (if (= z1 l) (setq z1 (- z1 1e-8))); If vertex is equal to l we disturb                    ;
  315.        (if (= z2 l) (setq z2 (- z2 1e-8))); the z value a little.                                 ;
  316.          
  317.        (if (or (< z1 l z2)(> z1 l z2))    
  318.           (setq cl (cons e cl))           ; Edge is added to Crossed List                         ;
  319.        )
  320.      );end foreach e
  321.      
  322.      ; cl now contains all edges where all contours at level l passes.                            ;
  323.  
  324.      (setq xl nil)      
  325.  
  326.      (while cl
  327.         (setq n 0)
  328.         ;;Find in cl an edge that has no reverse hence on the convex hull and start from it       ;
  329.         ;;if none is found we start with the last edge in cl                                      ;
  330.         (while (and (member (reverse (nth n cl)) cl) (< n (1- (length cl))))
  331.            (setq n (1+ n))
  332.         )
  333.      
  334.         (setq pol (list (nth n cl))
  335.                cl (vl-remove (nth n cl) cl)
  336.                 n (- n (rem n 2))
  337.               pol (cons (nth n cl) pol)
  338.               nxt (reverse (nth n cl))
  339.                cl (vl-remove (nth n cl) cl)
  340.                pc (1+ pc)
  341.                vc (+ 2 vc)
  342.         )
  343.        
  344.        (while (and (setq n (vl-position nxt cl)) (not (member nxt pol)))
  345.          
  346.            (setq  cl (vl-remove (nth n cl) cl)
  347.                    n (- n (rem n 2))
  348.                  pol (cons (nth n cl) pol)
  349.                  nxt (reverse (car pol))
  350.                   cl (vl-remove (nth n cl) cl)
  351.                   vc (1+ vc)
  352.            )
  353.          
  354.        );end while
  355.        
  356.        (setq xl (cons pol xl))
  357.        
  358.      );end while cl
  359.      
  360.      (foreach p xl
  361.            (setq ent nil)
  362.            (foreach e p
  363.               (setq p1 (nth (car e) pl)
  364.                     p2 (nth (cadr e) pl)
  365.                      r (/ (- l (caddr p1)) (- (caddr p2) (caddr p1)))
  366.                     p1 (list (car p1)(cadr p1))
  367.                     p2 (list (car p2)(cadr p2))
  368.                      d (* (distance p1 p2) r)
  369.                     pt (polar p1 (angle p1 p2) d)
  370.                    ent (cons (cons 10 pt) ent)
  371.               )
  372.            )
  373.            (setq ent (cons (cons 38 l) ent)
  374.                  ent (cons (cons 43 0.0) ent)
  375.                  ent (cons (cons 70 0) ent)
  376.                  ent (cons (cons 90 (length p)) ent)
  377.                  ent (cons (cons 100 "AcDbPolyline") ent)
  378.                  ent (cons (cons 100 "AcDbEntity") ent)
  379.                  ent (cons (cons 8 "Contour") ent)
  380.                  ent (cons (cons 0 "LWPOLYLINE") ent)
  381.  
  382.                  
  383.            )
  384.  
  385.            (entmake ent)
  386.      );end foreach p
  387.      
  388.      (setq l (+ l intv))
  389.      
  390.    );end repeat
  391.  
  392.    (princ (strcat "\n CONTOUR Completed - Elapsed time: " (rtos (/ (- (car (_VL-TIMES)) ti) 1000.) 2 4) " secs."))
  393.    (princ (strcat "\n         Generated   " (itoa pc) " LWPOLYLINE."))
  394.    (princ (strcat "\n             Total   " (itoa vc) " Vertices."))     
  395.    (princ)
  396.  
  397. );end defun triangulate
  398.  
  399.  
  400. ;;*****************************************************************************;
  401. ;;                                                                             ;
  402. ;; Written by  ElpanovEvgeniy                                                  ;
  403. ;; 17.10.2008                                                                  ;
  404. ;; Calculation of the centre of a circle and circle radius                     ;
  405. ;; for program triangulate                                                     ;
  406. ;;                                                                             ;
  407. ;; Modified ymg june 2011 (renamed variables)                                  ;
  408. ;; Modified ymg June 2013 to operate on Index                                  ;
  409. ;;*****************************************************************************;
  410.  
  411. (defun getcircumcircle (a el /  b c c2 cp r ang vl)
  412.      
  413.    (setq p (nth a pl)
  414.          b (nth(car el) pl)
  415.          c (nth(cadr el) pl)
  416.         c2 (list (car c) (cadr c)) ;c2 is point c but in 2d                    :
  417.         vl (list a (car el) (cadr el))
  418.    )
  419.    (if (not
  420.           (zerop
  421.              (setq ang (- (angle b c) (angle b p)))
  422.           )
  423.        )
  424.       (progn (setq cp (polar c2
  425.                           (+ -1.570796326794896 (angle c p) ang)
  426.                           (setq r (/ (distance p c2) (sin ang) 2.0))
  427.                       )
  428.                     r (abs r)
  429.              )
  430.              (list (+ (car cp) r) cp r vl)
  431.       )
  432.    )
  433. )
  434.  
  435. ;Generate a bunch of points for testing on layer named points.                 ;
  436. (defun c:gen ( / n)
  437.        
  438.         (setq n (getint "\nNumber of points: "))
  439.         (while (> n 0)
  440.                 (entmake
  441.                     (list
  442.                        '(0 . "POINT")
  443.                        '(8 . "Points")
  444.                         (cons 10 (list (* 1000 (ran)) (* 750 (ran)) (* 10 (ran))))
  445.                     )
  446.                 )
  447.                 (setq n (1- n))
  448.         )
  449. )
  450. ; Random number generator                                                      ;
  451. (defun ran ()
  452.     (setq seed (if seed (rem (+ (* seed 15625.7) 0.21137152) 1) 0.3171943))
  453. )
  454.  
  455.  
  456.  
Title: Re: Triangulation (re-visited)
Post by: ymg on July 02, 2013, 05:37:44 PM
I am replying to myself here.

Upon close examination the biggest speed penalty is on the search for edges on the convex hull.
The list cl is scanned until the end at every edges.

I will modify the routine.

ymg
Title: Re: Triangulation (re-visited)
Post by: ymg on July 03, 2013, 10:03:57 PM
I've modified the routine and am getting much better speed now.

Also modified the entmake part and insure that closed polylines are built accordingly.

Would still appreciate any speed tips or better ways to write some of the segment.

Next revision will implement smoothing of contour.  As you know simply splining
the polylines leads to contour crossing each other.

There is a way that was patented back in 1992 by IBM, I guess the patent has ran out now.
The method was developped by a fellow name Albert H. J.  Christensen and involves
inserting parabola at vertices of the polylines when a chosen angular threshold is reached.

If you do a search on "Contour Smoothing by an Eclectic Procedure" you will find the document.

Another thing we would need is a way to insert constraints (Breaklines) into the triangulation.

Meanwhile find below the revised code for contouring as well as the full lisp including
the triangulation as an attachment.

ymg

Code: [Select]
(grread t); Dummy just to force a screen update and avoid that Autocad hangs while calculating
 
   (princ (strcat "\n     TIN Completed - Elapsed time: " (rtos (/ (- (car (_VL-TIMES)) ti) 1000.) 2 4) " secs."))
 
   (princ (strcat "\n         Generated   " (itoa (length tl)) " 3DFACES"))
   (princ "\n")


   ; Begin Calculation of Contour line                                                             
   ;                                                                                               
   ; The routine follows each contour from edge to edge resulting in Connected LWPOLYLINE.         
   ;                                                                                               
   ; 1. Sort triangle list tl on the maximum z value of vertices of each triangles.               
   ; 2. Create el, a list containing all edges of all triangles. ((a b)(b c) (c a).......)         
   ; 3. For each desired contour level l, we traverse el and  create list cl containing all       
   ;    edges crossed by level l. At this point cl contains 2 edges per triangle.                 
   ;    As we go through el, we can destroy any triplets of edges whose max z value is  below     
   ;    the current contour level, thus limiting traversal for next level.                         
   ; 4. We now process cl, following from edge to edge until either we've closed the polyline     
   ;    or reached the convex hull. If we reached the convex hull, we insure  that the beginning 
   ;    of the polyline is also on the convex hull.  Otherwise we reverse the polyline and         
   ;    continue processing.  Process continues until cl is empty.                           
   ;    As we complete each polyline list xl is formed.                                           
   ; 5. We entmake each element of list xl.
   ; 6. We go back to step 3 until all levels are completed and el is empty.
   ;                                       
   ;    Step 4 and 5 could be combined but it is easier to follow contour in index form           
   ;                                                                                               
   ;                                                                                               
   ; An alternate way to do this would be compute all al segment between two edges joining with   
   ; with a line for all contour level and at end Join everything together.                       
   ;                                                                                               


   ; Setup for Contouring                                                                         
   (setq   ti (car (_VL-TIMES))   ; Re-initialize timer for Contouring                             
     i  1
    i1 (/ (length pl) 100.)
    i2 0
         intv 1                   ; Interval between contour                                       
zmin (+ (fix zmin) intv) ; zmin was calculated during triangulation                       
zmax (fix zmax)          ; z2 also calculated at beginning                               
            l zmin                ; Initialize Contour level                                       
   el nil                 ; el will be list of all edges                                   
   vc 0                   ; Vertices Count                                                 
   pc 0                   ; LWPOLYLINE Count                                               
   )
 
   (setq tl (vl-sort tl
(function
    (lambda (a b)
        (< (max (caddr (nth (car a) pl))
(caddr (nth (cadr a) pl))   ;Gotta be a more concise way           
(caddr (nth (caddr a) pl))  ;to write this probably with apply.   
   )                                ;Help!!!                               
   (max (caddr (nth (car b) pl))
(caddr (nth (cadr b) pl))
(caddr (nth (caddr b) pl))
   )
)
    )
        )
            )
   )
 
 
   
   ; Extract all triangle edges from tl and form list el                                           
   (foreach tr tl
     (setq el (cons (list (car tr)(cadr tr)) el)
   el (cons (list (cadr tr)(caddr tr)) el)
   el (cons (list (caddr tr)(car tr)) el)
     )
   )

   
   
   (repeat (+(fix (/ (- zmax zmin) intv)) 1) ;Main Loop through each contour level                 
     
     (setq cl nil   ; cl will be list of all edges crossed at current level l                     
            j 0     ; Index into edge list el                                                     
           zm 1e-8  ; zmax value for a given triplets of edges                                     
     )
     (repeat (length el)
       (setq  e (nth j el)
     z1 (caddr (nth (car e) pl))  ; Get elevation of edges from the point list.           
     z2 (caddr (nth (cadr e) pl))
     zm (max zm z1 z2) 
      j (1+ j)
       )
       
       (if (and (= (rem j 3) 0) (< zm (+ l intv))) ; Reduce size of el on zmax criteria.           
             (setq  j (- j 3)
                   el (vl-remove (nth j el) el)
                   el (vl-remove (nth j el) el)
                   el (vl-remove (nth j el) el)
           zm 1e-8
             )
       )
             
       (if (= z1 l) (setq z1 (- z1 1e-8))); If vertex is equal to l we disturb                     
       (if (= z2 l) (setq z2 (- z2 1e-8))); the z value a little.                                 
       
       (if (or (< z1 l z2)(> z1 l z2))   
          (setq cl (cons e cl))           ; Edge is added to Crossed List                         
       )
     );end foreach e
     
     ; cl now contains all edges where all contours at level l passes.                             

     (setq xl nil)     

     (while cl
       ;We Initialize a Polyline                                                             
       (setq pol (list (cadr cl)(car cl)) ; We go reverse as we will cons the polyline             
             nxt (reverse (car pol))      ; nxt will be our next edge                             
      cl (cddr cl)                ; Remove first two edges from cl                         
       )
       (if (not (member nxt cl))          ;The previous edge was on convex hull                   
    (setq pol (reverse pol)       ;We reverse our Polyline                                 
  nxt (reverse(car pol))  ;and adjust our next edge                               
            )
       )
       
       (while (setq n (vl-position nxt cl))

           (setq  cl (vl-remove (nth n cl) cl)
                   n (- n (rem n 2))
                 pol (cons (nth n cl) pol)
  cl (vl-remove (nth n cl) cl)
   )
   (if (member nxt pol)
      (setq nxt nil)
      (setq nxt (reverse (car pol)))
   )

   (if (not (vl-position nxt cl))
      (setq pol (reverse pol)
            nxt (reverse (car pol))
      )
   ) 
       );end while
       
       (setq xl (cons pol xl))
       
     );end while cl
     
     (setq pc (+ pc (length xl)))
     (foreach p xl
           (setq ent nil
                  vc (+ vc (length p))
           )
           (if (equal (car p) (reverse (last p)))
         (setq isclosed 1
              p (cddr p)
)     
         (setq isclosed 0)
   )
           (foreach e p
(setq p1 (nth (car e) pl)
       p2 (nth (cadr e) pl)
        r (/ (- l (caddr p1)) (- (caddr p2) (caddr p1)))
       p1 (list (car p1)(cadr p1))
       p2 (list (car p2)(cadr p2))
                d (* (distance p1 p2) r)
       pt (polar p1 (angle p1 p2) d)
              ent (cons (cons 10 pt) ent)
       
                )
           )
           (setq ent (cons (cons 38 l) ent)
         ent (cons (cons 43 0.0) ent)
         ent (cons (cons 70 isclosed) ent)
         ent (cons (cons 90 (length p)) ent)
         ent (cons (cons 100 "AcDbPolyline") ent)
         ent (cons (cons 100 "AcDbEntity") ent)
         ent (cons (cons 8 "Contour") ent)
         ent (cons (cons 0 "LWPOLYLINE") ent)


           )

           (entmake ent)
           
     );end foreach p
     
     (setq l (+ l intv))
     
   );end repeat

   (setvar "MODEMACRO" "")
 
   (princ (strcat "\n CONTOUR Completed - Elapsed time: " (rtos (/ (- (car (_VL-TIMES)) ti) 1000.) 2 4) " secs."))
   (princ (strcat "\n         Generated   " (itoa pc) " LWPOLYLINE."))
   (princ (strcat "\n             Total   " (itoa vc) " Vertices."))  
   (princ)
 
);end defun triangulate



Title: Re: Triangulation (re-visited)
Post by: ElpanovEvgeniy on July 04, 2013, 04:51:32 AM
Hello ymg!
See my version of the smoothing algorithm (http://www.theswamp.org/index.php?topic=42846.0;all)
Title: Re: Triangulation (re-visited)
Post by: ymg on July 04, 2013, 10:59:36 AM
Hello Evgeniy,

I've look into your algorythm.  Sure did appreciate the subject of the study.
Gives a whole new meaning to Model Space  :-)

Your process as far as I can tell is patch based (As opposed to line smoothing)
and applicable to matrix. 

If you look into Christensen's paper,

   http://www.asprs.org/a/publications/pers/2001journal/april/2001_apr_511-517.pdf (http://www.asprs.org/a/publications/pers/2001journal/april/2001_apr_511-517.pdf)

you will get some of the pluses and minuses of this method.

He then goes on proposing a so called eclectic method which actually is kind of an hybrid (line and patch)
solutions.

This is what I propose to implement.

Hope everything is well with you.


ymg

Title: Re: Triangulation (re-visited)
Post by: ymg on July 04, 2013, 12:54:10 PM
I inadvertently introduce a bug in the last posting of tin.lsp,    :ugly:
as I checked for isclosed polyline the list should be reduced by one element
instead of two.

Apologies !!

ymg

Code: [Select]
(foreach p xl
           (setq ent nil
                  vc (+ vc (length p))
           )
           (if (equal (car p) (reverse (last p)))
         (setq isclosed 1
              p (cdr p) ;Was wrong (cddr p)
)     
         (setq isclosed 0)
   )
Title: Re: Triangulation (re-visited)
Post by: MP on July 04, 2013, 12:57:46 PM
I inadvertently introduce a bug in the last posting of tin.lsp,    :ugly:

Unacceptable, 3 lashes with a wet hypotenuse.
Title: Re: Triangulation (re-visited)
Post by: ymg on July 20, 2013, 07:07:31 PM
Here is Contour with Christensen's Eclectic Method for smoothing implemented.

I still have not implemented the variable smoothing that he describe in his paper.

Would appreciate comments, bug(s) report and suggestion for speeding up.

Code: [Select]
; Contour by ymg   (July 2013)                                                                     
;                                                                                                 
; The routine follows each contour from edge to edge resulting in Connected LWPOLYLINE.           
; Basic method is per:                                                                             
;      http://www.originlab.com/www/helponline/Origin/en/UserGuide/Creating_Contour_Graphs.html   
;                                                                                                 
; Contours are then smoothed using Christensen's Eclectic Method.                                 
; For details see:                                                                                 
;      http://www.asprs.org/a/publications/pers/2001journal/april/2001_apr_511-517.pdf             
;      http://www.google.com.mx/patents/US5333248                                                 
;                                                                                                 
; General Flow:                                                                                   
;                                                                                                 
; 1. Sort triangle list tl on the maximum z value of vertices of each triangles.                   
;                                                                                                 
; 2. Create el, a list containing all edges of all triangles. ((a b)(b c) (c a).......)           
;                                                                                                 
; 3. For each desired contour level l, we traverse el and  create list cl containing all           
;    edges crossed by level l. At this point cl contains 2 edges per triangle.                     
;    As we go through el, we can destroy any triplets of edges whose max z value is  below         
;    the current contour level, thus limiting traversal for next level.                           
;                                                                                                 
; 4. We now process cl, following from edge to edge until either, we've closed the polyline       
;    or reached the convex hull. If we reached the convex hull, we insure  that the beginning     
;    of the polyline is also on the convex hull.  Otherwise we reverse the polyline and           
;    continue processing until cl is empty.                                         
;    As we complete each polyline list xl is formed and contains a series of list tracing all the 
;    polylines for a given level.                                                                 
;                                                                                                 
; 5. We entmake each element of list xl, smoothing vertices of polylines when conditions are right.
;    Variable mang controls if an edge can be smoothed or not preventing crossing of contours.     
;    Smoothing is controlled by two variables lang and lres which limits the number of segments   
;    tracing the parabolas of an edge.                                                             
;                                                                                                 
; 6. We go back to step 3 until all levels are completed and el is empty.                         
;                                                                                                 
;                                                                                                 
;                                                                                                 

 
(defun contour (tl pl / a a1 a2 a3 b bb c cl cn1 cn2 e el ent hfac i i1 i2 intv isclosed
        j l lang lres mang n nxt p1 p2 p3 p4 pc pl pol prv seg sm ti
        v1 v2 v3 vcr vcs xl z1 z2 zm zmax zmin
       )
 
   ; Setup for Contouring                                                                         
   (setq    ti (car (_VL-TIMES))   ; Re-initialize timer for Contouring                           
     i  1
    i1 (/ (length pl) 100.)
    i2 0
    bb (list
                             (apply 'mapcar (cons 'min pl))
                (apply 'mapcar (cons 'max pl))
                         )                           ; bb, bounding box of Point List.                               
  zmin (caddar bb)            ;  zmin, minimum z of Point List.                               
  zmax (caddr(cadr bb))    ; zmax, maximum z of Point List.                               
  intv 1                             ; Interval between contour.                                     
                zmin (+ (fix zmin) intv)  ; zmin, first level for contour.                               
  zmax (fix zmax)             ; zmax; last level for contour.                                 
        l zmin                      ; Initialize Current Contour level.                             
   intv 1                            ; Interval between contour.                                     
     el nil                           ; el, will be list of all edges in triangle list.               
   vcr 0                             ; Vertices Count for Raw Contours.                             
   vcs 0                             ; Vertices Count for Smoothed Contours.                         
    pc 0                              ;  LWPOLYLINE Count.                                             
  lres 5                              ; Linear resolution for smoothing.                             
  lang (dtr 5)                      ; Angular resolution for smoothing.                             
  mang (* lang 1.5)           ; Min angle controls if an edge is suitable for smoothing.     
  hfac 0.5                         ; Degree of smoothing, Max is 0.5, Min would be 1.             
   )
 
   (setq tl (vl-sort tl
(function
    (lambda (a b)
        (< (max (caddr (nth (car a) pl))
(caddr (nth (cadr a) pl))   ;Gotta be a more concise way           
(caddr (nth (caddr a) pl))  ;to write this probably with apply.   
   )                                ;Help!!!                               
   (max (caddr (nth (car b) pl))
(caddr (nth (cadr b) pl))
(caddr (nth (caddr b) pl))
   )
)
    )
        )
            )
   )
 
 
   
   ; Extract all triangle edges from tl and form edges list el                                     
   (foreach tr tl
     (setq el (cons (list (car tr)(cadr tr)) el)
   el (cons (list (cadr tr)(caddr tr)) el)
   el (cons (list (caddr tr)(car tr)) el)
     )
   )

   
   
   (repeat (+(fix (/ (- zmax zmin) intv)) 1) ;Main Loop through each contour level                 
     
     (setq cl nil   ; cl will be list of all edges crossed at current level l                     
            j 0     ; Index into edge list el                                                     
           zm 1e-8  ; zmax value for a given triplets of edges                                     
     )
     (repeat (length el)
       (setq  e (nth j el)
     z1 (caddr (nth (car e) pl))  ; Get elevation of edges from the point list.           
     z2 (caddr (nth (cadr e) pl))
     zm (max zm z1 z2) 
      j (1+ j)
       )
       
       (if (and (= (rem j 3) 0) (< zm (+ l intv))) ; Reduce size of el on zmax criteria.           
             (setq  j (- j 3)
                   el (vl-remove (nth j el) el)
                   el (vl-remove (nth j el) el)
                   el (vl-remove (nth j el) el)
           zm 1e-8
             )
       )
             
       (if (= z1 l) (setq z1 (- z1 1e-8))); If vertex is equal to l we disturb                     
       (if (= z2 l) (setq z2 (- z2 1e-8))); the z value a little.                                 
       
       (if (or (< z1 l z2)(> z1 l z2))   
          (setq cl (cons e cl))           ; Edge is added to Crossed List                         
       )
     );end foreach e
     
     ; cl now contains all edges where all contours at level l passes.                             

     (setq xl nil)     

     (while cl
       ;We Initialize a Polyline                                                             
       (setq pol (list (cadr cl)(car cl)) ; We go reverse as we will cons the polyline             
             nxt (reverse (car pol))      ; nxt will be our next edge                             
      cl (cddr cl)                ; Remove first two edges from cl                         
       )
       (if (not (member nxt cl))          ;The previous edge was on convex hull                   
    (setq pol (reverse pol)       ;We reverse our Polyline                                 
  nxt (reverse(car pol))  ;and adjust our next edge                               
            )
       )
       
       (while (setq n (vl-position nxt cl))

           (setq  cl (vl-remove (nth n cl) cl)
                   n (- n (rem n 2))
                 pol (cons (nth n cl) pol)
  cl (vl-remove (nth n cl) cl)
   )
   (if (member nxt pol)
      (setq nxt nil)
      (setq nxt (reverse (car pol)))
   )

   (if (not (vl-position nxt cl))
      (setq pol (reverse pol)
            nxt (reverse (car pol))
      )
   ) 
       );end while
       
       (setq xl (cons pol xl))
       
     );end while cl
     
     (setq pc (+ pc (length xl)))
     
     (foreach p xl
        (setq ent nil)
        (if (equal (car p) (reverse (last p)))
         (setq isclosed 1
              p (append p (list(cadr p)))
)
(setq isclosed 0
                            ent (list (cons 10 (clv l (car p) pl)))
)
        )
        (while (> (length p) 2)
           
   (setq  v1 (clv l (car p) pl)
          v2 (clv l (cadr p) pl)
   )
     
   (setq  v3 (clv l (caddr p) pl)
prv (car p)
nxt (caddr p)
           p (cdr p)
          p1 (nth (caar p) pl)
          p3 (nth (cadar p) pl)
  p2 (nth (car prv) pl)
  p4 (nth (car nxt) pl)
   )
           (if (or (equal p2 p1) (equal p2 p3))
         (setq p2 (nth (cadr prv) pl))
   )
   (if (or (equal p4 p1) (equal p4 p3))
         (setq p4 (nth (cadr nxt) pl))
   )

   ; Need to test here if edge p1 p3 is suitable for smoothing                             
   ; Unclear to me, what mang should if I set it to same value as lang, we still have     
           ; Contours crossing each other.  With (* lang 1.5) no crossing!!                       
   (cond
     ((and (or (< (defl p1 p2 p3) mang) (< (defl p1 p4 p3) mang))
           (> (/ (abs (- (caddr p1) (caddr p3))) intv) 1)
      )
                   (setq sm (list v2 )); Unsuitable we set v2 as the vertices on this edge.       
     )
     (t (setq cn1 (mapcar '(lambda (a b c) (/ (+ a b c) 3.0)) p1 p2 p3)
      cn2 (mapcar '(lambda (a b c) (/ (+ a b c) 3.0)) p1 p3 p4)
       a1 (cond
     ((inters cn1 p1 v1 v2))
     ((inters cn1 p3 v1 v2))
    ;((inters cn1 p2 v1 v2))
  )

       a2 v2
                       a3 (cond
     ((inters cn2 p1 v2 v3))
     ((inters cn2 p3 v2 v3))
    ;((inters cn2 p4 v2 v3))
  )
       sm (smooth a1 a2 a3); Probably would be better not to call a function here 
       ); end setq
     ); end t   
   ); end cond
 
   (foreach e sm
      (setq ent (cons (cons 10 e) ent))
   )
       
        ); end while p
       
        (if (= isclosed 0) (setq ent (cons(cons 10 v3) ent)))

        (setq seg (length ent)
      vcs (+ vcs seg)
      ent (cons (cons 38 l) ent)
      ent (cons (cons 43 0.0) ent)
      ent (cons (cons 70 isclosed) ent)
      ent (cons (cons 90 seg) ent)
      ent (cons (cons 100 "AcDbPolyline") ent)
      ent (cons (cons 100 "AcDbEntity") ent)
      ent (cons (cons 8 "Contour") ent)
      ent (cons (cons 0 "LWPOLYLINE") ent)


        )

        (entmake ent)
         
     );end foreach p
     
     (setq l (+ l intv))
     
   );end repeat

   (setvar "MODEMACRO" "")
   
   (princ (strcat "\n CONTOUR - Elapsed time: " (rtos (/ (- (car (_VL-TIMES)) ti) 1000.) 2 4) " secs, "
                   (itoa pc) " LWPOLYLINES, "
                   (itoa vcs) " Vertices."
          )
   )
   (princ)
 
);end defun contour



; Degree to Radian Conversion                                                                     
(defun dtr (a) (* pi (/ a 180.0)))


; Given:   lev, (level of contour being traced).                                                   
;           ed, (edge defined by a list of two index into the point list.,                         
;           pl, Point List                                                                         
;                                                                                                 
; Returns: Point where contour cross the edge.                                                     

(defun clv (lev ed pl /  r d p1 p2)
(setq p1 (nth (car ed) pl)
       p2 (nth (cadr ed) pl)
        r (/ (- lev (caddr p1))
             (- (caddr p2) (caddr p1))
  )
       p1 (list (car p1)(cadr p1))
       p2 (list (car p2)(cadr p2))
        d (* (distance p1 p2) r)
)
(polar p1 (angle p1 p2) d)
)



; Smooth an edge defined by 3 points                                                               
; Returns a list of points starting at a1 and ending at a3                                         
; which traces two parabolas joining a1 to a3                                                     
; Global variables lang and lres limits number of segments on parabolas.                           
; Global variable hfac controls how much smoothing we apply  (Not implemented yet)                 

(defun smooth (a1 a2 a3 / cp f ps tmp)
   (setq ps (subdiv a1 a2 a3)
          f nil
   )
(while ps
     (setq cp (car ps)
   ps (cdr ps)
     )
    (while (and (> (min (distance (car cp) (cadr cp))
                (distance (cadr cp) (caddr cp))
   )
   lres
                        )
(< (defl (car cp) (cadr cp) (caddr cp))
                           (- pi lang)
                        )
                   )
   
   (setq tmp (subdiv (caddr cp)(cadr cp)(car cp))
cp (car tmp)
ps (cons (cadr tmp) ps)
                   )
     
            ) ; end while lres lang
   
    (setq f (cons (car cp) f))
 
) ; end while ps

        (cons a1 f)
)

; Subdivide a pair defined by 3 points  (a1 b1 c1)                                                 
; Return a list of 6 points    (a1 d1 e1 e1 d2 c1)                                                 

(defun subdiv (a1 b1 c1 / m1 m2 m3)
     (setq m1 (mid a1 b1)
   m3 (mid b1 c1)
   m2 (mid m1 m3)
     )
     (list (list c1 m3 m2)(list m2 m1 a1))
)


; Midpoint of two points                                                                           
(defun mid (a b)
     (mapcar '(lambda (a b) (/ (+ a b) 2.0)) a b)
)

; Given 3 points, return the angle smaller than pi between a b and c b                             
(defun defl (a b c / d)
 (abs (- (setq d (- (angle b a)(angle b c))) (* (fix (/ d pi)) (+ pi pi))))
)

;Generate a bunch of points for testing on layer named points.                                     
(defun c:gen ( / n rangex rangey rangez)

(setq n (getint "\nNumber of points: ")
      rangex 5000          ; Extent in X for the points                                   
      rangey (/ rangex 1.6); Extent in Y * Golden Ratio                                   
      rangez 10            ; Extent in Z                                                   
)     
(while (> n 0)
        (entmake
                    (list
                       '(0 . "POINT")
                       '(8 . "Points")
                        (cons 10 (list (* rangex (ran)) (* rangey (ran)) (* rangez (ran))))
                    )
                )
(setq n (1- n))
)
)
; Random number generator                                                                         
(defun ran ()
    (setq seed (if seed (rem (+ (* seed 15625.7) 0.21137152) 1) 0.3171943))
)




Still to do:


To test, downlad tins.lsp attached to this post.
Appload it to Autocad.
Issue command gen and creates a bunch of point.
Issue command tin and select all points created on previous step.

Triangulation and Smoothed Contours will be created,
on layer "TIN" and layer "Contour".

ymg
Title: Re: Triangulation (re-visited)
Post by: snownut2 on July 21, 2013, 03:42:20 PM

Added Dialog Interface for Selecting Major & Minor Colors, Major & Minor Contour Intervals & Smoothing Factor
(all contained within LISP so there is only one file)

This also works in Bricscad 13......

See attached file for code.

I have also found a bug, the contour iteration is not completing all contours.  I have attached a dwg file that will not complete all contours.


Title: Re: Triangulation (re-visited)
Post by: ymg on July 22, 2013, 02:12:12 PM
Snowmut,

Thanks for the dcl for contour.

Quote
I have also found a bug, the contour iteration is not completing all contours

Bug is confirmed, need to do a test or disturb position of point when a point is exactly on Contour level.
In your example be bug at point # 3 which is exactly at elevation 100.

I'll add the necessary and repost.

Thanks for the testing.

ymg
Title: Re: Triangulation (re-visited)
Post by: snownut2 on July 22, 2013, 05:34:14 PM
Found another bug of sorts, the contours where not starting out at an elevation that was a multiple of the interval.  I have fixed that along with the contour layer placement (related) that added yesterday. 

See attached file (seems the entire code is to long to place in this box)

Revised code, added some error trapping in DCL and activated smoothing in DCL, also added some layer control to make sure appropriate layers are on.

Revised to;
       Accept either Blocks or Points
       Added TIN Name option to Dialog

Updated Dialog Interface to;
      Selection for Blocks or Point Objects to Contour (radio buttons)
      Added Error checking to ensure all required items have been done
     
I have also incorporated all the latest updates from ymg's latest file.
     

Title: Re: Triangulation (re-visited)
Post by: ymg on July 23, 2013, 03:57:42 PM
Find attached tinsd.lsp which fixes the bugs found so far.

Also implemented variable smoothing as per Christensen's

A dialogue box compliment of Snownut2 is included for setting
various parameters for contouring.  Some of this seems to be
from LeeMac.

I need to get going on adding constraints to the triangulation.

Again would appreciate suggestion for speeding up, bug report
as well as better way to write some section.

ymg

P.S. Take the latest file below
Title: Re: Triangulation (re-visited)
Post by: snownut2 on July 23, 2013, 04:06:10 PM
Indeed the LM:Popup function is included in the code, it has not been modified from Lee's code.

Bruce
Title: Re: Triangulation (re-visited)
Post by: ymg on July 23, 2013, 11:04:13 PM
Here is two images of the output from tinsd.

Only a 100 points and 20 contours.

On these images I have superimposed output with max smoothing,
min smoothing and no smoothing.

Not sure the variable smoothing is worth the trouble.

ymg

(http://contour.png)

(http://contour no tin.png)
Title: Re: Triangulation (re-visited)
Post by: snownut2 on July 24, 2013, 12:27:37 AM
I am not surprised at what you are calling minor differences, if the lines where shifted/relocated much more then the contour accuracy would suffer.  Typically as a rule in the civil world you cannot be more then 1/2 the contour interval off at any location in the contoured area.  That is on the outside you would like to see the contours closer than that, if the lines where adjusted anymore with the smoothing then you could be outside of that accuracy range.

Just as a thought, if you where to adjust the lres variable (line resolution) at the same time the smoothing factor is adjusted, making the resolution smaller as the smoothing factor is increased, the results are definitely more noticeable.

Regarding triangulation constraints, it appears that the very large angle >160deg triangles lay at the outer edges of the TIN.  These triangles cause the contour lines to take a sharp turn and head off into an un-natural direction.  How about not allowing triangles with any angle greater than 160deg. (or some other limit that makes sense)
Title: Re: Triangulation (re-visited)
Post by: ymg on July 24, 2013, 01:05:59 PM
Quote
Just as a thought, if you where to adjust the lres variable (line resolution) at the same time the smoothing factor is

That suggestion makes perfect sense.

The second one about triangle could prove to be more involved.
However if we implement constraints with an outer boundary
that problem would go away.

ymg
Title: Re: Triangulation (re-visited)
Post by: ymg on July 24, 2013, 02:40:13 PM

Here is a case that tinsd does nor handle properly.

Has to do when a contour has only one edge.

Quote
Unacceptable, 3 lashes with a wet hypotenuse.

Will test and correct.  By now the wet hypotenuse
of MP is used up. So I will use the opposite side.   :pissed:

ymg

Title: Re: Triangulation (re-visited)
Post by: ymg on July 24, 2013, 04:22:53 PM
Bug is corrected.

Find below revised file.


Code - Auto/Visual Lisp: [Select]
  1. (foreach p xl
  2.         (setq ent nil)
  3.         (if (equal (car p) (reverse (last p)))
  4.                  (setq isclosed 1
  5.                               p (append p (list(cadr p)))
  6.                  )
  7.                  (setq isclosed 0
  8.                             ent (list (cons 10 (clv l (car p) pl)))
  9.                  )
  10.         )
  11.        
  12.        (if (< (length p) 3); Added to handle the case where polyline is of lenght 2.              
  13.            (setq  v3 (clv l (cadr p) pl))
  14.         )
  15.         (while (> (length p) 2)
  16.                
  17.            (setq  v1 (clv l (car p) pl)
  18.                   v2 (clv l (cadr p) pl)
  19.                   v3 (clv l (caddr p) pl)
  20.                  prv (car p)
  21.  
  22. etc. etc.
  23.  

(http://bug2.png)
Title: Re: Triangulation (re-visited)
Post by: ymg on August 30, 2013, 06:37:31 PM
I have updated the triangulation so that an adjacency list or neighbour list of triangle is generated.

Also modified so that we generate Voronoi Diagram plus the Delaunay triangulation.

The neigbour list now permits us to locate ourself efficiently in the tin via a new routine called Triloc.
This is actually Lawson's walk who invented the procedure.  Since then many different scheme have been devised
to accelerate it when you have huge triangulation.

Here's a paper showing some of them:  Walking Location Algorithms (http://graphics.zcu.cz/Download-document/165-Walking-Location-Algorithms)  by Roman Soukal.

Another paper Walking in a triangulation  (http://ftp://ftp-sop.inria.fr/geometrica/pion/publis/Walking_in_a_triangulation_socg_2001.pdf) by Olivier Devillers analyzes the speed of the  various schemes.

Here are the added function to the triangulation:

Code - Auto/Visual Lisp: [Select]
  1. ;;****************************************************************************;
  2. ;; (getneighbour pl tl)                                                                                                                   ;
  3. ;;                                                                                                                                                 ;
  4. ;; Parameters: pl, Points List                                                                                                        ;
  5. ;;             tl, Triangle List (index into pl)                                                                                       ;
  6. ;;    Returns: nl, List of neigbours for each edges of each triangles.                                               ;
  7. ;;                                                                                                                                                 ;
  8. ;; Should be done by the triangulation.                                                                                         ;
  9. ;;****************************************************************************;
  10.  
  11. (defun getneighbour (pl tl / nl pos tmp)
  12.  
  13.              (setq el nil)
  14.              (foreach tr tl
  15.                 (setq el (cons (list (car tr)(cadr tr)) el)
  16.                       el (cons (list (cadr tr)(caddr tr)) el)
  17.                       el (cons (list (caddr tr)(car tr)) el)
  18.                 )
  19.              )
  20.              (setq el (reverse el))
  21.  
  22.             (setq tmp nil)
  23.             (foreach e el
  24.                 (setq pos (vl-position (reverse e) el))
  25.                 (if pos
  26.                    (setq tmp (cons (/ pos 3) tmp)); Integer Division          ;
  27.                    (setq tmp (cons nil tmp))
  28.                 )
  29.             )
  30.            
  31.             (setq nl nil)
  32.             (while tmp
  33.                 (setq nl (cons (list (caddr tmp)(cadr tmp)(car tmp)) nl)
  34.                      tmp (cdddr tmp)
  35.                 )
  36.             )
  37.             nl
  38. )
  39.  
  40.  
  41. ;;****************************************************************************;
  42. ;; (triloc p)                                                                                                                                   ;
  43. ;;                                                                                                                                                ;
  44. ;; Locates triangle which encloses point p using Lawson's Walk.                                                    ;
  45. ;;                                                                                                                                                ;
  46. ;; Given p a point, Returns Index in tl of triangle containing the point.                                          ;
  47. ;; If outside the triangulation Return is nil.                                                                                   ;
  48. ;;                                                                                                                                                ;
  49. ;; Point List pl and Neigbour List nl are defined outside this routine.                                              ;
  50. ;; by ymg  August 2013                                                                                                               ;
  51. ;;****************************************************************************;
  52.  
  53. (defun triloc (p / v v1 v2 v3)
  54.  
  55.     ; Negative return, point is on right of v1->v2                                                                            ;
  56.     ; Positive return, point is on left of v1->v2                                                                                ;
  57.     ; 0 return, point is smack on the vector.                                                                                    ;
  58.     (defun onside (p v1 v2 /)
  59.         (setq v1 (list (car v1)(cadr v1))); We want 2d points                                                             ;
  60.         (apply '- (mapcar '* (mapcar '- v2 v1) (reverse (mapcar '-  p v1))))
  61.     )
  62.  
  63.     (setq found nil)
  64.     (if (not tn) (setq tn (/ (length tl) 2)))
  65.     (while (and (not found) tl)
  66.         (setq  v (nth tn tl)
  67.               v1 (nth (car v) pl)
  68.               v2 (nth (cadr v) pl)
  69.               v3 (nth (caddr v) pl)
  70.         )      
  71.         (cond
  72.            ((minusp (onside p v1 v2))(setq tn (car (nth tn nl))))
  73.            ((minusp (onside p v2 v3))(setq tn (cadr (nth tn nl))))
  74.            ((minusp (onside p v3 v1))(setq tn (caddr (nth tn nl))))
  75.            (t (setq found t))      ; We are inside triangle tn                ;
  76.         )
  77.         (if (not tn)(setq found t)); We are outside the triangulation         ;
  78.     )
  79.     tn ;
  80. )
  81.  
  82.  

The body of the triangulation has been modified to make use of the getneighbour function.
Note that contour has been removed from the attachment as I am currently doing a major
rewrite to make use of the neighbour list and hopefully gain some speed.

I have also put together a demoz routine to demonstrate what can be done with triloc and the neighbour list.
It is heavily inspired (leeched  :?)  by LeeMac's grtext.lsp  (http://www.lee-mac.com/grtext.html)

Here is the code to that one followed by an animated gif showing it in action.

Code - Auto/Visual Lisp: [Select]
  1. ;;****************************************************************************;
  2. ;; Demoz                                                                                                                                     ;
  3. ;; Demonstrate Lawson's Walk, to locate a triangle in a triangulation                                             ;
  4. ;; As you hover around the screen, the triangle under the screen is                                               ;
  5. ;; highlighted and the coordinates of the cursor position including Z, plus                                      ;
  6. ;; the triangle number are written to the screen.                                                                           ;
  7. ;;                                                                                                                                                 ;
  8. ;; Inspired by LeeMac's Grtext.lsp                                                                                                 ;
  9. ;;                                                                                                                                                 ;
  10. ;; by ymg        August 2013                                                                                                          ;
  11. ;;****************************************************************************;
  12.  
  13. (defun c:demoZ ( / *error* pnt str col ent etxt p prevtxt prevhatch
  14.                    prevtn scl t1 t2 t3 tr txt txtp xof yof)
  15.  
  16.     (defun *error* ( m ) (princ m) (redraw) (princ))
  17.  
  18.     (toglay '("Points" "Voronoi"))
  19.      
  20.     (while (= 5 (car (setq pnt (grread nil 13 0))))
  21.         (redraw)
  22.         (setq p (cadr pnt))
  23.         (setq tn (triloc p))
  24.         (if tn
  25.           (progn
  26.             (setq tr (nth tn tl)
  27.                   t1 (nth (car tr) pl)
  28.                   t2 (nth (cadr tr) pl)
  29.                   t3 (nth (caddr tr) pl)
  30.                    p (getz p t1 t2 t3)
  31.             )    
  32.             (if (not (= tn prevtn))
  33.                (progn
  34.                   ; Built with MakeEntmake.lsp by Cab at TheSwamp             ;
  35.                   (setq ent (list (cons 0 "HATCH")
  36.                                   (cons 100 "AcDbEntity")  
  37.                                   (cons 8 "Tin")
  38.                                   (cons 62 1)
  39.                                   (cons 440 33554534)
  40.                                   (cons 100 "AcDbHatch")
  41.                                   (cons 10 (list 0.0 0.0 0.0))
  42.                                   (cons 210 (list 0.0 0.0 1.0))      
  43.                                   (cons 2 "SOLID")
  44.                                   (cons 70 1)
  45.                                   (cons 71 0)
  46.                                   (cons 91 1)
  47.                                   (cons 92 1)
  48.                                   (cons 93 3)
  49.                                   (cons 72 1)
  50.                                   (cons 10 (list (car t1)(cadr t1) 0.0))
  51.                                   (cons 11 (list (car t2)(cadr t2) 0.0))
  52.                                   (cons 72 1)
  53.                                   (cons 10 (list (car t2)(cadr t2) 0.0))
  54.                                   (cons 11 (list (car t3)(cadr t3) 0.0))
  55.                                   (cons 72 1)
  56.                                   (cons 10 (list (car t3)(cadr t3) 0.0))
  57.                                   (cons 11 (list (car t1)(cadr t1) 0.0))
  58.                                   (cons 97 0)  
  59.                                   (cons 75 1)
  60.                                   (cons 76 1)
  61.                                   (cons 98 1)
  62.                                   (cons 10 (list 0.0 0.0 0.0))
  63.                                   (cons 450 0)
  64.                                   (cons 451 1)
  65.                                   (cons 460 0.0)
  66.                                   (cons 461 0.0)
  67.                                   (cons 452 0)
  68.                                   (cons 462 1.0)
  69.                                   (cons 453 2)
  70.                                   (cons 463 0.0)
  71.                                   (cons 63 5)
  72.                                   (cons 421 255)
  73.                                   (cons 463 1.0)
  74.                                   (cons 63 2)
  75.                                   (cons 421 16776960)
  76.                                   (cons 470 "LINEAR")    
  77.                             )
  78.                   )
  79.                   (if prevhatch (entdel prevhatch))
  80.                   (entmake ent)
  81.                   (setq prevhatch (entlast)
  82.                         prevtn tn
  83.                   )
  84.                   (redraw)
  85.                )
  86.             )
  87.           )
  88.           (if prevhatch (progn (entdel prevhatch)(setq prevhatch nil)))
  89.         )
  90.         ; Leeched from LeeMac (LM:GrText)                                     ;
  91.         ; http://www.lee-mac.com/lisp/html/GrTextDemo.html                    ;
  92.         (setq  col 2
  93.                xof 30
  94.                yof -30
  95.                scl (/ (getvar 'viewsize) (cadr (getvar 'screensize)))
  96.                  p (trans p 1 2)
  97.                str (mapcar 'rtos (trans p 1 0))
  98.               txtp (list (+ (car  p) (* xof scl)) (+ (cadr p) (* yof scl)))
  99.                txt (strcat  "T#: " (if tn (itoa tn) "Outside") "\\PX= " (car str) "\\PY= " (cadr str) "\\PZ= " (caddr str))
  100.         )
  101.         (setq etxt (list (cons 0 "MTEXT")
  102.                          (cons 100 "AcDbEntity")
  103.                          (cons 67 0)
  104.                          (cons 8 "Tin")
  105.                          (cons 62 col)
  106.                          (cons 100 "AcDbMText")
  107.                          (cons 10 txtp)
  108.                          (cons 40 30)
  109.                          (cons 41 360.0)
  110.                          (cons 46 0.0)
  111.                          (cons 72 5)
  112.                          (cons 1 txt)
  113.                          (cons 7 "Standard")
  114.                          (cons 11 '(1.0 0.0 0.0))
  115.                          (cons 42 237.0122)
  116.                          (cons 43 181.39154)
  117.                          (cons 50 0)
  118.                          (cons 73 1)
  119.                          (cons 44 1.0)
  120.                   )
  121.         )
  122.         (if prevtxt (entdel prevtxt))
  123.         (entmake etxt)
  124.         (setq prevtxt (entlast))
  125.     )
  126.     (if prevtxt (entdel prevtxt))
  127.     (if prevhatch (progn (entdel prevhatch)(setq prevhatch nil)))
  128.     (toglay '("Points" "Voronoi"))
  129.     (redraw)
  130.    
  131.    
  132.   (princ)
  133. )
  134.  
  135.  
  136.  
  137.  
  138. ;;****************************************************************************;
  139. ;; (getz p t1 t2 t3)                                                                                                                        ;
  140. ;; Given point p and triangle defined by points t1, t2, t3                                                                ;
  141. ;; Returns: (x y z) where z is on face of triangle.                                                                           ;
  142. ;;                                                                                                                                                  ;
  143. ;; By ymg  August 2013                                                                                                                ;
  144. ;;****************************************************************************;
  145.  
  146. (defun getz (p t1 t2 t3 /  v1 v2)
  147.      
  148.    ; Calculating a normal vector with gile's functions in line.               ;
  149.    ; Note that I do not calculate the unit vector for the normal n.           ;
  150.    (setq v1 (mapcar '- t2 t1)
  151.          v2 (mapcar '- t3 t1)
  152.           n (list (- (* (cadr v1) (caddr v2)) (* (caddr v1) (cadr v2)))
  153.                   (- (* (caddr v1) (car v2)) (* (car v1) (caddr v2)))  
  154.                   (- (* (car v1) (cadr v2)) (* (cadr v1) (car v2)))    
  155.             )
  156.    )
  157.    (list (car p)(cadr p)(/ (apply '+ (mapcar '* n (mapcar '- t1 p)))(caddr n)))
  158.  )
  159.  
  160. ;; (toglay lst)                                                                                               ;
  161. ;; Toggles (on/off) a list of Layer names.                                                      ;
  162. ;; From a Fishing Story by Cab at TheSwamp >-=((((°>                              ;
  163. ;;                                                                                                                ;
  164. ;; by ymg               August 2013                                                                 ;
  165.  
  166. (defun toglay (lst / entlist l)
  167.     (foreach l lst
  168.          (and (setq entlist (tblobjname "LAYER" l))
  169.               (setq entlist  (entget entlist))
  170.               (entmod (subst (cons 62 (- (cdr (assoc 62 entlist))))
  171.                              (assoc 62 entlist)
  172.                              entlist
  173.                       )
  174.               )
  175.          )
  176.     )
  177. )
  178.  
  179.  
  180.  
  181.  

To run the demo, load the attachment demoz.lsp, Issue command GEN and enter number of points desired
in the triangulation.

Isue command VOR, the Voronoi Diagram and the Delaunay Triangulation will generate.

Issue command DEMOZ, as you hover in the drawing, the triangle number plus coordinates X,Y and Z of point under cursor
is displayed and the currently occupied triangle is hatched in solid Red.

Sorry!, about the long post.

ymg

(http://demoz.gif)

 
Title: Re: Triangulation (re-visited)
Post by: pedroantonio on November 26, 2013, 05:08:41 PM
hi Ymg ,I have a question.I am typing Tin and the lisp run and makes tins
when i write contours the lisp not working.Which command should write to make contours ?
Title: Re: Triangulation (re-visited)
Post by: ymg on November 26, 2013, 10:54:17 PM
pedroantonio,

The version you have has a bug whereby the majcont variable is not initialized.

Make sure you change the setting for major contour in the dialog boxe
before running then it should work.

There will be a revised version very soon with many improvements.


ymg

You can also add in the code the following line majcnt 5.0:

Code - Auto/Visual Lisp: [Select]
  1. (setq dcl_id(load_dialog dclfiletemp)
  2.         intvL   '("  1" "  2" "  5" " 10")
  3.         majcntL '("  5" " 10" " 50" "100")
  4.         hfacL   '("  Max" "  -20%" "  -40%" "  -60%" "  -80%" " Min" "None")
  5.         hfacTL  '(0.5 0.6 0.7 0.8 0.9 1.0 5)   
  6.         majcolor 10
  7.         mincolor 14
  8.         intv 1
  9.         majcnt 5.0 ;add this line
  10.         hfac 0.5
  11.   )
  12.  
Title: Re: Triangulation (re-visited)
Post by: pedroantonio on November 27, 2013, 04:21:13 AM
Thank you ymg . Where i can find the new version ?
Title: Re: Triangulation (re-visited)
Post by: ymg on November 27, 2013, 05:52:19 AM
pedroantonio,

Quote
Thank you ymg . Where i can find the new version ?

The new version will be available here when I publish it.

Meanwhile just add the majcont line.

ymg
Title: Re: Triangulation (re-visited)
Post by: pedroantonio on November 29, 2013, 02:27:33 AM
Ymg i try to do this change in the code

Code: [Select]
intvL   '(" 0.02" " 0.1" " 0.2" "  1" "  2" "  5" " 10")
majcntL '(" 0.1" " 0.5" " 1" "  5" " 10" " 50" "100")
hfacL   '("  Max" "  -20%" "  -40%" "  -60%" "  -80%" " Min" "None")

but the code didn't work for this value !!

Code: [Select]
intvL   '(" 0.02" " 0.1" " 0.2"......................)
majcntL '(" 0.1" " 0.5" " 1" ..........................")
hfacL   '("  Max" "  -20%" "  -40%" "  -60%" "  -80%" " Min" "None")"

Sometimes is important if you  have the ability to give values ​​ smaller than 1m for (MNR)

can you tell me why ?
Title: Re: Triangulation (re-visited)
Post by: ymg on November 29, 2013, 04:05:39 AM
pedroantonio,

The next version does fractionnal contour.

You need to change more than just the list for this to happen.

If you have an immediate need I can send you an advanced copy.

However there are still quite a few things to change before issuing it at large.

ymg
Title: Re: Triangulation (re-visited)
Post by: pedroantonio on November 29, 2013, 05:44:36 AM
yes if you can ...

Thanks
Title: Re: Triangulation (re-visited)
Post by: ymg on February 09, 2014, 04:39:14 AM
Here is an update to the TIN program.

It is still very much a work in progress, so I would appreciate
bug reports and enhancement  suggestion.

The Contouring part has been accelerated a little, and now work with
fractionnal contours.

You can also call CONT to do contours on a Selection of existing 3DFACE.

Express Tools is required, as I make use of the Progress Bar.

Still missing Breaklines handling for the triangulation,
and Highlighting of Depression Contours for the contouring section.


ymg
Title: Re: Triangulation (re-visited)
Post by: chlh_jd on February 22, 2014, 11:02:07 PM
Here is an update to the TIN program.

It is still very much a work in progress, so I would appreciate
bug reports and enhancement  suggestion.

The Contouring part has been accelerated a little, and now work with
fractionnal contours.

You can also call CONT to do contours on a Selection of existing 3DFACE.

Express Tools is required, as I make use of the Progress Bar.

Still missing Breaklines handling for the triangulation,
and Highlighting of Depression Contours for the contouring section.
ymg
Great Program , Yang !
The last version is higher effect .
I has some suggest :
1. Just your description , "You can also call CONT to do contours on a Selection of existing 3DFACE." , I hope It can .
2. Smoothing effect may also need to improve some , just like the pic. I post .
Title: Re: Triangulation (re-visited)
Post by: ymg on February 22, 2014, 11:28:17 PM
chlh_jd,

Quote
"You can also call CONT to do contours on a Selection of existing 3DFACE." , I hope It can

Thanks for the feedback.

Agree that my wording is not too clear.  What was meant by that is in the case where you already have
a selection of 3dfaces created by another program, you can use command "CONT" and do the contouring.

Normal way would be a set of points that you triangulate and then contours.

I do not understand exactly what you mean from the attached image.  Could you clarify?

I've been playing around a bit with it and manage to accelerate it some. Shall post it soon.
We still need to handle the marking of "Depression Contour" currently not available.

I highly recommend Christensen's paper, it is well worth the reading.

ymg
Title: Re: Triangulation (re-visited)
Post by: chlh_jd on February 23, 2014, 09:17:39 AM
chlh_jd,

Quote
"You can also call CONT to do contours on a Selection of existing 3DFACE." , I hope It can

Thanks for the feedback.

Agree that my wording is not too clear.  What was meant by that is in the case where you already have
a selection of 3dfaces created by another program, you can use command "CONT" and do the contouring.
I'm sorry for Just finished reading your code in *gress5.lsp and foud add cont command .
Quote
Normal way would be a set of points that you triangulate and then contours.

I do not understand exactly what you mean from the attached image.  Could you clarify?
Sorry for my poor English ,  I mean that , the zone I mark , smoothed contours less than ideal .
I've seen Christensen's paper , perhaps no suit for the case I tesed .

Quote
I've been playing around a bit with it and manage to accelerate it some. Shall post it soon.
We still need to handle the marking of "Depression Contour" currently not available.

I highly recommend Christensen's paper, it is well worth the reading.

ymg
Not long ago, I also wrote a contour program is based on existing 3DFACES, and not for smoothing; and I'v lost in smooth annoying.
Looking forward to your masterpiece .  :-)

Title: Re: Triangulation (re-visited)
Post by: ymg on February 23, 2014, 10:38:13 AM
I believe that this zone would get crossing contours unless you do it this way.

In other word this is inherent to the method.

ymg
Title: Re: Triangulation (re-visited)
Post by: chlh_jd on March 05, 2014, 12:20:36 AM
I believe that this zone would get crossing contours unless you do it this way.

In other word this is inherent to the method.

ymg

Maybe this zone must add point .

I agree you just I can't found better .  :-)

In THis true case , it take some wrong .
Title: Re: Triangulation (re-visited)
Post by: ymg on March 05, 2014, 05:56:15 AM
chlh_jd,

Yes this is a bug introduced in the latest round of optimization.

Trying to locate the culprit and will post a revision.

ymg
Title: Re: Triangulation (re-visited)
Post by: ymg on March 06, 2014, 12:28:37 AM
chlh_jd,

Here is a revision with the bugs in contour generation removed.

Bear in mind, that this is still a work in progress, so the routine does  not clean themselves nicely on completion.

ymg
Title: Re: Triangulation (re-visited)
Post by: pedroantonio on March 07, 2014, 10:38:39 AM
Hello ymg nice job but , I find a bug in your code and i dont know why.

I write TIN ---> make TINS
I write CONT ----> open the contour window and gives me this error

Code - Auto/Visual Lisp: [Select]
  1. Select objects: Specify opposite corner: 71 found
  2. Select objects:
  3. Error: bad argument type: fixnump: nil

here is my dwg file ... Any options ?

Thanks
Title: Re: Triangulation (re-visited)
Post by: pedroantonio on March 07, 2014, 04:40:42 PM
with the  ContourTest.dwg  the lisp working fine but with my dwg is not working .Can you tell me what i am doing wrong ?
Thanks
Title: Re: Triangulation (re-visited)
Post by: CAB on March 07, 2014, 05:21:28 PM
I think he may be on the other side of the world so you may need to give some time for a response.  8)
Title: Re: Triangulation (re-visited)
Post by: chlh_jd on March 08, 2014, 01:43:20 AM
chlh_jd,

Here is a revision with the bugs in contour generation removed.

Bear in mind, that this is still a work in progress, so the routine does  not clean themselves nicely on completion.

ymg
Thanks Ymg , it did fix the bug in the case "intv=0.25 majcnt=1.0"; but error in the case  "intv=0.1 majcnt=0.5".

And some suggestion in 'contour function:
1. defined lambda function will short codes
Code - Auto/Visual Lisp: [Select]
  1. (defun f1  ()
  2.     (setq  z1  (caddr p1)
  3.            z2  (caddr p2)
  4.            z1 (if (= z1 z) (setq z1 (- z1 1e-08)) z1)
  5.            z2 (if (= z2 z) (setq z2 (- z2 1e-08)) z2)
  6.            p1  (list (car p1) (cadr p1)))
  7.       (polar p1
  8.              (angle p1 p2)
  9.              (* (distance p1 p2) (/ (- z z1) (- z2 z1)))))
  10.  
to
Code - Auto/Visual Lisp: [Select]
  1. (if (equal (car p) (reverse (last p)))
  2.         (setq isclosed 1
  3.               p        (append p (list (cadr p))))
  4.         (setq isclosed 0
  5.               p1       (nth (caar p) pl)
  6.               p2       (nth (cadar p) pl)            
  7.               ent      (list (cons 10
  8.                                    (f1)));_
  9.               )
  10.         )
  11. ...
  12. (while (> (length p) 2)
  13.         (setq p1  (nth (caar p) pl)
  14.               p2  (nth (cadar p) pl)         
  15.               v1  (f1)
  16.               p1  (nth (caadr p) pl)
  17.               p2  (nth (cadadr p) pl)        
  18.               v2  (f1)
  19.               p1  (nth (caaddr p) pl)
  20.               p2  (nth (cadr (caddr p)) pl)          
  21.               v3  (f1)
  22.               prv (car p)
  23.               nxt (caddr p)
  24.               p   (cdr p)
  25.               p1  (nth (caar p) pl)
  26.               p3  (nth (cadar p) pl)
  27.               p2  (nth (car prv) pl)
  28.               p4  (nth (car nxt) pl)
  29.               )
  30.   ...
  31.  
2. in the 'cl while loop , (setq n ...) before (while n ...) will reduce one time vl-position .
Code - Auto/Visual Lisp: [Select]
  1.       (setq n (vl-position nxt cl));_reduce 'vl-position one time , edited by GSLS(SS)
  2.       (while n
  3.         (setq cl  (vl-remove nxt cl)
  4.               n   (- n (rem n 2))
  5.               m   (nth n cl)
  6.               pol (cons m pol)
  7.               cl  (vl-remove m cl));_reduce 'nth one time
  8.         (if (vl-position nxt pol)
  9.           (setq nxt nil)
  10.           (setq nxt (reverse (car pol))))
  11.         (and (not (setq n (vl-position nxt cl)))
  12.              (setq pol (reverse pol)
  13.                    nxt (reverse (car pol))
  14.                    n   (vl-position nxt cl)
  15.                    ))
  16.         )
  17.  
3. define lambda function to replace vl-remove for build cl list loop will improve speed for huge list ; It also can be added position determine for > (/ (length lst) 2) , and use reverse to speed up .
Code - Auto/Visual Lisp: [Select]
  1.   ;; remove-nth for contour
  2.   (defun f2  (i lst / fst)
  3.     (setq fst nil)
  4.     (repeat (rem i 4)
  5.       (setq fst (cons (car lst) fst)
  6.             lst (cdr lst)))
  7.     (repeat (/ i 4)
  8.       (setq fst (vl-list* (cadddr lst)
  9.                           (caddr lst)
  10.                           (cadr lst)
  11.                           (car lst)
  12.                           fst)
  13.             lst (cddddr lst)))
  14.     (append
  15.       (reverse fst)
  16.       (cdddr lst)))
  17. ;;--------------
  18. ...
  19. (while (< j (length el))
  20.       (setq e  (nth j el)
  21.             z1 (nth (car e) zl)
  22.             z2 (nth (cadr e) zl)
  23.             zm (max zm z1 z2)
  24.             j  (1+ j))
  25.  ;_ Reduce size of el on zmax criteria.                                  ;
  26.       (if (and (= (rem j 3) 0) (< zm (+ z intv)))
  27.         (setq j  (- j 3)
  28.               el (f2 j el);_remove-nth for contour
  29.               zm -1e19))
  30.       (if (= z1 z)
  31.         (setq z1 (- z1 1e-8)))          ; If on Interval we disturb         ;
  32.       (if (= z2 z)
  33.         (setq z2 (- z2 1e-8)))          ; the z value a little.             ;
  34.       (if (or (< z1 z z2) (> z1 z z2))
  35.         (setq cl (cons e cl))           ; Edge is added to Crossed List     ;
  36.         )      
  37.       )
  38. ...
  39.  
4. don't shift 'clayer between major with minor ,just use (cons 8 ...)
Code - Auto/Visual Lisp: [Select]
  1. ...
  2. (setq seg       (length ent)
  3.             vcs (+ vcs seg)
  4.             ent (vl-list* (cons 0 "LWPOLYLINE")
  5.                           (cons 100 "AcDbEntity")
  6.                           (cons 100 "AcDbPolyline")
  7.                           (cons 8
  8.                                 (if (zerop (rem z majcnt))
  9.                                   "Contour Major"
  10.                                   "Contour Minor"))                      
  11.                           (cons 90 seg)                  
  12.                           (cons 70 isclosed)
  13.                           (cons 38 z)
  14.                           ent)
  15.             )
  16. ...
  17.  
Title: Re: Triangulation (re-visited)
Post by: pedroantonio on March 08, 2014, 05:37:28 AM
I try the prof command but i can't change the scale .

And what ocd command do?

Can you give me some instructions for them ?

Thanks
Title: Re: Triangulation (re-visited)
Post by: ymg on March 09, 2014, 08:09:55 AM
Topographer,

Sorry for late reply.

In your drawing there is an incorrect triangle, so the sorting routine for the triangle list
crash on it.

I will check the get_tin routine to see if there is a bug there, or add something to prevent this.

Meanwhile use tin on the point and you will get the contour.

The prof routine is for making a profile from a set of 3dface, or a triangulation or yet again from
a 3dpolyline.  However it is not finished, so not ready for production.

OCD is a routine i got from AUGI forum, will be use to trim triangulation.  This is also not ready

ymg
Title: Re: Triangulation (re-visited)
Post by: ymg on March 09, 2014, 08:20:03 AM
chlh_jd,

The previous version of the program had function like that.

But in an effort to squeeze every bit of speed I`ve put everything inline
thus gaining a tiny bit of speed by not calling a function.  On a 1000 points
triangulation this is about 50000 calls.

Second suggestion make sense to me.

Setting the current layer also saves me as many  calls to cons  as there are vertices in the contours.

Thanks for the helping hands.

ymg
Title: Re: Triangulation (re-visited)
Post by: pedroantonio on March 09, 2014, 12:29:15 PM
Thank you ymg
Title: Re: Triangulation (re-visited)
Post by: ymg on March 10, 2014, 04:26:04 AM
Topographer,

The problem was in the GET_TIN routine.

Find a revision attached below.

By the way OCD stands for Outside Contour Delete.
So given a boundary polyline, it will trim everything that is outside
polyline.

ymg
Title: Re: Triangulation (re-visited)
Post by: pedroantonio on March 10, 2014, 05:04:05 AM
Thank you  ymg

I have two comments

1) OCD delete everething out of the polyline. This is a problem because  delete all my measure points, block,TINS , etc. Can  you fix it to delete only contours ?
It is good to have all the TINS .I forget  delete things in layer off
2) Can you add breaklines is important for correct TINS.

Nice job keep working we need you !!!!!

Thanks
Title: Re: Triangulation (re-visited)
Post by: ymg on March 10, 2014, 01:47:49 PM
Topographer,

As stated earlier OCD did not originate with me.

It is in the program because we will need a  functionnality of that type
sooner or later.  Right now I did not even look at it although I know we
will need to modify it some.

Breaklines are certainly a needed additions.  I have done some exploratory
work on it.  Still not ready for prime time though.

Understand that I do this as a hobby, so I sometimes get fed up of looking
at it and move on to something else.  I let it cook then come back to it.

There is also some more work to be done with the contouring.  Namely we
need to highlight the depression contour.  There too I've done a bit of work
but not ready.  Another recurring problem is roundoff error with the fractionnal
contour.  So far still haven't got 100% reliability.

ymg
Title: Re: Triangulation (re-visited)
Post by: pedroantonio on March 10, 2014, 01:56:44 PM
I understand , Thank you.
Title: Re: Triangulation (re-visited)
Post by: ymg on March 11, 2014, 10:59:09 AM
chlh_jd,

Quote
Thanks Ymg , it did fix the bug in the case "intv=0.25 majcnt=1.0"; but error in the case  "intv=0.1 majcnt=0.5".

I had to add a fuzz factor when we compare current contour z to see if the points z1 and z2 are equal to it.

I have also increased the disruption to 1e-03 from 1e-08.

Seems to have cured it!, so find attached the revision.

ymg
Title: Re: Triangulation (re-visited)
Post by: chlh_jd on March 12, 2014, 09:09:17 AM
Hello Ymg ,
I'm sorry , did not read your every version .
Thank you for your reply and fixing the bug .
I'll take much time to test the new version after some time ,
Very pleased to test it and help some . :-)
Title: Re: Triangulation (re-visited)
Post by: chlh_jd on March 12, 2014, 09:31:21 AM
Hi Ymg,
In my head , Longer code still requires a larger computer memory , so shorting the codes is necessary for reduce computer memory usage , if we have enough computer memory  , we also can build other ways list for contour routine  to replace a large number of 'nth' . So we have to compare the speed after complied the file .
In the contour routine , make a zl will speed up some .
Code: [Select]
...
(setq ti   (car (_VL-TIMES)) ; Re-initialize timer for Contouring
zl   (mapcar (function caddr) pl) ;_only for zlist                               
zmin (apply (function min) zl) ;_improve speed by GSLS(SS) 2014.3.2             
zmax (apply (function max) zl)
zmin (* (fix (/ zmin intv)) intv) ;_zmin, first level for contour.   (* (+ (fix (/ zmin intv)) 1) intv)
zmax (* (fix (/ zmax intv)) intv) ;_ zmax; last level for contour.               
z    zmin ; Initialize Current Contour level.             
...                 
)
  (setq tl (vl-sort tl
    (function
      (lambda (a b)
(< (max (nth (car a) zl)
(nth (cadr a) zl)
(nth (caddr a) zl))
   (max (nth (car b) zl)
(nth (cadr b) zl)
(nth (caddr b) zl)))))))
...
Title: Re: Triangulation (re-visited)
Post by: ymg on March 13, 2014, 01:19:00 AM
chlh_jd,

Thanks, for the sort idea.

On a 2000 triangles list I do gain about 0.25 seconds (Non-Compiled)

Quote
In my head , Longer code still requires a larger computer memory

Very right, I am trading space for speed.

ymg
Title: Re: Triangulation (re-visited)
Post by: ymg on March 14, 2014, 04:49:59 AM
Yet another bug in the contour generation routine removed.

Also implemented some of chlh_jd's suggestions.

Hopefully everything's OK now, so I can start work on
Depression Contours.

ymg
Title: Re: Triangulation (re-visited)
Post by: chlh_jd on March 15, 2014, 02:02:36 PM
Ymg,
The new version test OK in contour routine . Thank you very much .
I'm really looking forward to deal with discontinuous triangulation which just you said no support .
Title: Re: Triangulation (re-visited)
Post by: motee-z on March 15, 2014, 06:21:05 PM
excellent job for countor lines but it will be perfect if you take into consider break lines.
(break lines is a 3d polyline so 3d face not intersect with it because it represent a cliff in land)
thanks
Title: Re: Triangulation (re-visited)
Post by: ymg on March 16, 2014, 12:55:41 AM
motee-z,

I know what is a breakline.

I have done some preliminary work on it.

But we also have to take into considerations boundaries of the tin
plus holes into the triangulation.

Conceptually all we need to do is to erase all the triangles intercepted
by the breaklines, then re-triangulate the hole created.

My thinking would be a CCW polyline would represent a boundary where
the tin is inside. Clockwise poly would be a hole.

But there is a lot of catch in there.

ymg

Title: Re: Triangulation (re-visited)
Post by: teknomatika on March 31, 2014, 10:32:12 AM
ymg,
is a fantastic tool.
However, PROF function is not working. Always returns the same error.

Quote
Command: prof

Select a Linear Entity:

Error: bad argument type: fixnump: nil

I am using a lwpolyline as a linear entity. Not sure what am I doing wrong.
Attached the sample file
Title: Re: Triangulation (re-visited)
Post by: Pad on March 31, 2014, 11:20:46 AM
ymg,

brilliant work, amazing.

P
Title: Re: Triangulation (re-visited)
Post by: ymg on March 31, 2014, 11:25:31 AM
teknomatica,

Prof is not completed as explained in a previous post.

I am currently working on it.

Try it with the attached, you should be able to get the profile
from a tin at least.

There is still quite a bit of work to be done on the UI.

Also, I am not satisfied with the current selection method
the getneighbour routine is way too slow.

So far, I have come up with a new method.  Now I need
to complete the UI for every case. (Tin, Contour, 3DFACE and 3DPOLY)

Also working on the surface selection interface.

ymg
Title: Re: Triangulation (re-visited)
Post by: ymg on March 31, 2014, 11:32:15 AM
Pad,

Thank you , for the encouragement.

ymg
Title: Re: Triangulation (re-visited)
Post by: chlh_jd on April 10, 2014, 05:56:29 AM
hi, ymg
The contour routine still get error  in the case of the dwg I post ,when intv = 0.1 majintv=0.5 .
Even the Tin routine don't get right result in this drawing .
Title: Re: Triangulation (re-visited)
Post by: ymg on April 10, 2014, 01:25:30 PM
chlh_jd,

In your drawing you had at least 20 illegal 3dfaces shaped as a line.

Don 't know how you generated them.  Once these are removed everything works.

You also claim that the Tin did not work.  I could not check as you did not provide
the points.

ymg
Title: Re: Triangulation (re-visited)
Post by: ymg on April 10, 2014, 05:46:48 PM
I did regenerate your points.

And you are bound to have troubles when the points are nearly on top
of each other.

Same problem with your circle, reduce the density of the points.

ymg
Title: Re: Triangulation (re-visited)
Post by: chlh_jd on April 11, 2014, 07:50:47 AM
Ymg,
I'm sorry for not provide the points .  :oops:
Thank you for check this case .
In realistic terrain , there are some steep and cliffs , I wish the contour routine can support this case .
You have also mentioned, can not handle discontinuous 3DFACE , I wish it can .

Therefore, can we change an idea to deal with the  contour problem; For example, the first generation of each line segment at every elevations, and then combine them, and then fillet them .
Title: Re: Triangulation (re-visited)
Post by: ymg on April 11, 2014, 09:27:15 AM
chlh_jd,

I thik I found the culprit.  There were some duplicates (10 of them to be exact)
points that did not get filtered out.

modify this line at beginning of program:

Code: [Select]
(setq pl (vl-sort pl (function (lambda (a b) (< (cadr a) (cadr b))))) ;; Sort on Y Coordinate     
                pl (vl-sort pl (function (lambda (a b) (< (car  a) (car  b))))) ;; Sort on X Coordinate     
                pl (vl-remove nil                                               ;; Remove Duplicate Points 
                      (mapcar '(lambda (a b) (if (not (equal (cdr (reverse a)) (cdr (reverse b)) 1e-03)) a))
                            pl (append (cdr pl) (list (car pl)))                             
                      )
                   )
  )

Adding a fuzz factor on the comparison in the vl-remove line.

Seems to cure it.


ymg
Title: Re: Triangulation (re-visited)
Post by: ymg on April 11, 2014, 09:51:01 AM
chlh_jd,

contour ca run on disjointed set of 3dfaces.

In the picture below both sets were contoured
in one go.
Title: Re: Triangulation (re-visited)
Post by: chlh_jd on April 13, 2014, 03:27:44 AM
Ymg,
Thank you for fix this case .
some suggest :
1. Another use case may can be : First select norm ,just like (210 1.0 0.0 0.0 ) , not only for (210 0. 0. 1.) ; and then trans all 3dfaces points , and then make contours .
   
Code: [Select]
  (contour  pl  tl intv  majcnt majcolor    mincolor hfac  norm)2. In the "get_ss" function , will be error , if the 3dface is manual change ( because of the osnap accuracy ), it can be solve by two way :
   2.1 tolerance index come in , such as (equalmember p pl 1e-6) replace  (vl-position p pl).
   2.2 fix or round coordinate before construct the pointlist , such as
     
Code: [Select]
(setq pl (cons (mapcar (function (lambda (a) (/ (fix (* a 1e6)) 1e6))) p) pl)3. In the contour function , some position may get error :
  3.1 build xl part
   
Code - Auto/Visual Lisp: [Select]
  1. (while (setq n (vl-position nxt cl))     
  2.            (setq  cl (vl-remove nxt cl)
  3.                    n (- n (rem n 2))
  4.                    m (nth n cl);_cl may be nil after first 'vl-remove .
  5.                  pol (cons m pol)
  6.                   cl (vl-remove m cl)
  7.            )
  8.            (if (vl-position nxt pol)
  9.               (setq nxt nil)
  10.               (setq nxt (reverse (car pol)))
  11.            )
  12.          
  13.            (if (not (vl-position nxt cl))
  14.               (setq pol (reverse pol)
  15.                     nxt (reverse (car pol))
  16.               )
  17.            )  
  18.        )
  19.    
   3.2 foreach for xl part
 
Code - Auto/Visual Lisp: [Select]
  1.     (foreach p xl ;_p may be has nil item , just like ((17 9) nil)
  2.         (setq ent nil)
  3.       ...)
  4.  
  3.2 in the cond t condtion
 
Code - Auto/Visual Lisp: [Select]
  1.     (foreach p xl
  2.             ...
  3.        (while (> (length p) 2)
  4.             ...
  5.           (cond (...)
  6.                    (...)
  7.                    (t (setq cn1 (list (/ (+ (car p1) (car p2) (car p3)) 3.)
  8.                            (/ (+ (cadr p1) (cadr p2) (cadr p3)) 3.))
  9.                  cn2 (list (/ (+ (car p1) (car p3) (car p4)) 3.)
  10.                            (/ (+ (cadr p1) (cadr p3) (cadr p4)) 3.))
  11.                  ;_ (cn1 p1 v1 v2) or (cn1 p3 v1 v2) may be collinear 4 points , how deal it ?
  12.                  a1  (cond
  13.                        ((inters cn1 p1 v1 v2))
  14.                        ((inters cn1 p3 v1 v2))
  15.                        )
  16.                  a3  (cond
  17.                        ((inters cn2 p1 v2 v3))
  18.                        ((inters cn2 p3 v2 v3))
  19.                        ))
  20.                           ...
  21.                        )
  22.                    ...
  23.                   )
  24.                 ...
  25.                )
  26.  
Title: Re: Triangulation (re-visited)
Post by: ymg on April 13, 2014, 01:40:57 PM
chlh_jd,

not sure I am following you on all this.

Originally the program would not check for duplicate points.

Maybe I could add something in "gettin" to detect illegal
3dfaces.  However all these checks do take time.

All in all there will always be a way where you can throw
the program off if only due to limited precision of floating
point operations.

If you feed it garbage you will get garbage.

ymg
Title: Re: Triangulation (re-visited)
Post by: chlh_jd on April 14, 2014, 04:09:38 AM
You're right .
In the wrong direction to go right path indeed make road twists and turns .
Title: Re: Triangulation (re-visited)
Post by: chlh_jd on April 17, 2014, 10:17:15 AM
Can we use the autocad contour method ?
The output functions from acgex17.dll in ACAD2008 seems seems to have it .
Code: [Select]
?getContour@AcGeCurveBoundary@@QBEXAAHPAPAPAVAcGeEntity3d@@PAPAPAVAcGeCurve2d@@PAPAH3@Z
?getContour@AcGeImpCurveBoundary@@QBEXAAHPAPAPAVAcGeImpEntity3d@@PAPAPAVAcGeImpCurve3d@@PAPAH3@Z
?getContours@AcGeExternalBoundedSurface@@QBEXAAHAAPAVAcGeCurveBoundary@@@Z
?getContours@AcGeImpExternalBoundedSurface@@QBEXAAHAAPAVAcGeImpCurveBoundary@@@Z
Title: Re: Triangulation (re-visited)
Post by: ymg on April 17, 2014, 11:39:02 AM
chlh_jd,

Really don't know.  Worth a try!
Title: Re: Triangulation (re-visited)
Post by: hanhphuc on April 24, 2014, 03:41:25 AM
ymg,
is a fantastic tool.
However, PROF function is not working. Always returns the same error.

Quote
Command: prof

Select a Linear Entity:

Error: bad argument type: fixnump: nil

I am using a lwpolyline as a linear entity. Not sure what am I doing wrong.
Attached the sample file

hi teknomatika, maybe one of the endpoints (line entity's) is outside the TIN boundary?
Title: Re: Triangulation (re-visited)
Post by: hanhphuc on April 24, 2014, 05:03:06 AM

hi chlh_jd, this arx sample used by surveyor jobs can be applied in function: getz?
if we hide the first line (geomcal)** then we still can use ymg's getz, because ARX not loaded :-)
ymg

Code: [Select]
(if C:cal (princ "\nGeomcal loaded..")(arxload "geomcal"));** <-- this is optional

(if C:cal ;if loaded
 
(defun getz (p t1 t2 t3 / ptt ) ;defun opted by hanhphuc
(setq
ptt (list (car p)(cadr p)(1+(caddr p))))
(cal "ilp(p,ptt,t1,t2,t3)")
); getz
 
(defun getz .... code unchanged ) ;defun by ymg
       
) ;c:cal
Title: Re: Triangulation (re-visited)
Post by: ribarm on April 24, 2014, 06:08:41 AM
No need for geomcal.arx

Code - Auto/Visual Lisp: [Select]
  1. ;|(defun _ilp ( p1 p2 t1 t2 t3 / unit v^v Coplanar-p ptinsidetriangle-p n e p1e p2e p1ed p2ed p1p p2p v1 v2 )
  2.  
  3.   (defun unit ( v )
  4.     (mapcar '(lambda ( x ) (/ x (distance '(0.0 0.0 0.0) v))) v)
  5.   )
  6.  
  7.   (defun v^v ( v1 v2 )
  8.     (
  9.       (lambda ( a b )
  10.         (mapcar '(lambda ( a1 a2 b1 b2 ) (- (* a1 a2) (* b1 b2)))
  11.                  a (cdr b) b (cdr a)
  12.         )
  13.       )
  14.       (list (cadr v1) (caddr v1) (car v1) (cadr v1))
  15.       (list (cadr v2) (caddr v2) (car v2) (cadr v2))
  16.     )
  17.   )
  18.  
  19.   (defun Coplanar-p ( p1 p2 p3 p4 )
  20.     (
  21.       (lambda ( n1 n2 )
  22.         (equal (v^v n1 n2) '(0.0 0.0 0.0) 1e-8)
  23.       )
  24.       (v^v (mapcar '- p1 p2) (mapcar '- p1 p3))
  25.       (v^v (mapcar '- p1 p2) (mapcar '- p1 p4))
  26.     )
  27.   )
  28.  
  29.   (defun ptinsidetriangle-p ( pt p1 p2 p3 )
  30.     (if
  31.       (and
  32.         (Coplanar-p pt p1 p2 p3)
  33.         (not
  34.           (or
  35.             (inters pt p1 p2 p3)
  36.             (inters pt p2 p1 p3)
  37.             (inters pt p3 p1 p2)
  38.           )
  39.         )
  40.         (not
  41.           (or
  42.             (> (+ (distance pt p1) (distance pt p2)) (+ (distance p3 p1) (distance p3 p2)))
  43.             (> (+ (distance pt p2) (distance pt p3)) (+ (distance p1 p2) (distance p1 p3)))
  44.             (> (+ (distance pt p3) (distance pt p1)) (+ (distance p2 p3) (distance p2 p1)))
  45.           )
  46.         )
  47.       )
  48.       T
  49.       nil
  50.     )
  51.   )
  52.  
  53.   (setq n (unit (v^v (mapcar '- t2 t1) (mapcar '- t3 t1))))
  54.   (setq e (last (trans t1 0 n)))
  55.   (setq p1e (last (trans p1 0 n)))
  56.   (setq p2e (last (trans p2 0 n)))
  57.   (setq p1ed (abs (- p1e e)))
  58.   (setq p2ed (abs (- p2e e)))
  59.   (setq p1p (mapcar '+ p1 (setq v1 (mapcar '(lambda ( x ) (* p1ed x)) n))))
  60.   (setq p2p (mapcar '+ p2 (setq v2 (mapcar '(lambda ( x ) (* p2ed x)) n))))
  61.   (if (not (equal e (last (trans p1p 0 n)) 1e-8)) (setq p1p (mapcar '- p1 v1)))
  62.   (if (not (equal e (last (trans p2p 0 n)) 1e-8)) (setq p2p (mapcar '- p2 v2)))
  63.   (setq p (inters p1 p2 p1p p2p nil))
  64.   (if (ptinsidetriangle-p p t1 t2 t3)
  65.     p
  66.     nil
  67.   )
  68.  
  69. )|;
  70.  

Maybe this shorter variant - I think it's the same, but check - I would use this one :

Code - Auto/Visual Lisp: [Select]
  1. ;|
  2. (defun _ilp ( p1 p2 t1 t2 t3 / v^v Coplanar-p ptinsidetriangle-p n e p1n p2n p1p p2p )
  3.  
  4.   (defun v^v ( v1 v2 )
  5.     (
  6.       (lambda ( a b )
  7.         (mapcar '(lambda ( a1 a2 b1 b2 ) (- (* a1 a2) (* b1 b2)))
  8.                  a (cdr b) b (cdr a)
  9.         )
  10.       )
  11.       (list (cadr v1) (caddr v1) (car v1) (cadr v1))
  12.       (list (cadr v2) (caddr v2) (car v2) (cadr v2))
  13.     )
  14.   )
  15.  
  16.   (defun Coplanar-p ( p1 p2 p3 p4 )
  17.     (
  18.       (lambda ( n1 n2 )
  19.         (equal (v^v n1 n2) '(0.0 0.0 0.0) 1e-8)
  20.       )
  21.       (v^v (mapcar '- p1 p2) (mapcar '- p1 p3))
  22.       (v^v (mapcar '- p1 p2) (mapcar '- p1 p4))
  23.     )
  24.   )
  25.  
  26.   (defun ptinsidetriangle-p ( pt p1 p2 p3 )
  27.     (if
  28.       (and
  29.         (Coplanar-p pt p1 p2 p3)
  30.         (not
  31.           (or
  32.             (inters pt p1 p2 p3)
  33.             (inters pt p2 p1 p3)
  34.             (inters pt p3 p1 p2)
  35.           )
  36.         )
  37.         (not
  38.           (or
  39.             (> (+ (distance pt p1) (distance pt p2)) (+ (distance p3 p1) (distance p3 p2)))
  40.             (> (+ (distance pt p2) (distance pt p3)) (+ (distance p1 p2) (distance p1 p3)))
  41.             (> (+ (distance pt p3) (distance pt p1)) (+ (distance p2 p3) (distance p2 p1)))
  42.           )
  43.         )
  44.       )
  45.       T
  46.       nil
  47.     )
  48.   )
  49.  
  50.   (setq n (v^v (mapcar '- t2 t1) (mapcar '- t3 t1)))
  51.   (setq e (last (trans t1 0 n)))
  52.   (setq p1n (list (car (trans p1 0 n)) (cadr (trans p1 0 n)) e))
  53.   (setq p2n (list (car (trans p2 0 n)) (cadr (trans p2 0 n)) e))
  54.   (setq p1p (trans p1n n 0))
  55.   (setq p2p (trans p2n n 0))
  56.   (setq p (inters p1 p2 p1p p2p nil))
  57.   (if (ptinsidetriangle-p p t1 t2 t3)
  58.     p
  59.     nil
  60.   )
  61.  
  62. )|;
  63.  

Both codes aren't correct... My update can be found here :
www.cadtutor.net/forum/showthread.php?89154-Solids-intersection-and-something-else...&s=293246d38c1367703f834a7d79f7944d&p=610836#post610836

M.R.
Title: Re: Triangulation (re-visited)
Post by: ymg on April 24, 2014, 09:21:26 AM
I have gone through 5 different version of getz before settling on the last one.

Here they are:

Code - Auto/Visual Lisp: [Select]
  1. (defun getz0 (p t1 t2 t3 /  v1 v2)
  2.  
  3.    (setq v1 (mapcar '- t2 t1)
  4.          v2 (mapcar '- t3 t1)
  5.           n (list (- (* (cadr v1) (caddr v2)) (* (caddr v1) (cadr v2)))
  6.                   (- (* (caddr v1) (car v2)) (* (car v1) (caddr v2)))  
  7.                   (- (* (car v1) (cadr v2)) (* (cadr v1) (car v2)))    
  8.             )
  9.    )
  10.    (list (car p)(cadr p)(/ (apply '+ (mapcar '* n (mapcar '- t1 p)))(caddr n)))
  11.  )
  12.  
  13. (defun getz1 (p t1 t2 t3 / )
  14.  
  15.    (setq v0 (list (- (car t1) (car  p)) (- (cadr t1) (cadr  p)) (- (caddr t1) (caddr  p)))
  16.          v1 (list (- (car t2) (car t1)) (- (cadr t2) (cadr t1)) (- (caddr t2) (caddr t1)))
  17.          v2 (list (- (car t3) (car t1)) (- (cadr t3) (cadr t1)) (- (caddr t3) (caddr t1)))
  18.           n (list (- (* (cadr v1) (caddr v2)) (* (caddr v1) (cadr v2)))
  19.                   (- (* (caddr v1) (car v2)) (* (car v1) (caddr v2)))  
  20.                   (- (* (car v1) (cadr v2)) (* (cadr v1) (car v2)))    
  21.             )
  22.    )
  23.    (list (car p)(cadr p)(/ (apply '+ (mapcar '* n v0))(caddr n)))
  24.  )
  25.  
  26. (defun getz2 (p t1 t2 t3 /  v1 v2)
  27.    (setq x  (car  p)  y  (cadr p)  z (caddr p)
  28.          x1 (car t1) y1 (cadr t1) z1 (caddr t1)
  29.          x2 (car t2) y2 (cadr t2) z2 (caddr t2)
  30.          x3 (car t3) y3 (cadr t3) z3 (caddr t3)
  31.           n (list (- (* (- y2 y1) (- z3 z1)) (* (- z2 z1) (- y3 y1)))
  32.                   (- (* (- z2 z1) (- x3 x1)) (* (- x2 x1) (- z3 z1)))  
  33.                   (- (* (- x2 x1) (- y3 y1)) (* (- y2 y1) (- x3 x1)))    
  34.             )            
  35.    )
  36.  
  37.    (list (car p)(cadr p)(/ (apply '+ (mapcar '* n v0))(caddr n)))
  38.  )
  39.  
  40. (defun getz3 (p t1 t2 t3 /  v1 v2)
  41.    (setq x  (car  p)  y  (cadr p)  z (caddr p)
  42.          x1 (car t1) y1 (cadr t1) z1 (caddr t1)
  43.          x2 (car t2) y2 (cadr t2) z2 (caddr t2)
  44.          x3 (car t3) y3 (cadr t3) z3 (caddr t3)
  45.           n (list (- (* (- y2 y1) (- z3 z1)) (* (- z2 z1) (- y3 y1)))
  46.                   (- (* (- z2 z1) (- x3 x1)) (* (- x2 x1) (- z3 z1)))  
  47.                   (- (* (- x2 x1) (- y3 y1)) (* (- y2 y1) (- x3 x1)))    
  48.             )            
  49.    )
  50.  
  51.    (list (car p)(cadr p)(/ (+ (* (- x1 x) (car n)) (* (- y1 y) (cadr n)) (* (- z1 z) (caddr n))) (caddr n)))
  52.  )
  53.  
  54. (defun getz4 (p t1 t2 t3 / n1 n2 n3 x x1 x2 x3 y y1 y2 y3 z z1 z2 z3)
  55.    (setq x  (car  p)  y  (cadr p)
  56.          x1 (car t1) y1 (cadr t1) z1 (caddr t1)
  57.          x2 (car t2) y2 (cadr t2) z2 (caddr t2)
  58.          x3 (car t3) y3 (cadr t3) z3 (caddr t3)
  59.          n1 (- (* (- y2 y1) (- z3 z1)) (* (- z2 z1) (- y3 y1)))
  60.          n2 (- (* (- z2 z1) (- x3 x1)) (* (- x2 x1) (- z3 z1)))  
  61.          n3 (- (* (- x2 x1) (- y3 y1)) (* (- y2 y1) (- x3 x1)))                      
  62.    )  
  63.    (list x y (/ (+ (* (- x1 x) n1) (* (- y1 y) n2) (* z1 n3)) n3))
  64.  )
  65.  
  66. (defun getz5 (p t1 t2 t3 / n1 n2 n3 x x1 x21 x31 y y1 y21 y31 z1 z21 z31)
  67.    (setq  x (car  p)  y (cadr  p)
  68.          x1 (car t1) y1 (cadr t1) z1 (caddr t1)        
  69.         x21 (- (car t2) x1)  y21 (- (cadr t2) y1) z21 (- (caddr t2) z1)
  70.         x31 (- (car t3) x1)  y31 (- (cadr t3) y1) z31 (- (caddr t3) z1)
  71.          n1 (- (* y21 z31) (* z21 y31))
  72.          n2 (- (* z21 x31) (* x21 z31))  
  73.          n3 (- (* x21 y31) (* y21 x31))                      
  74.    )  
  75.    (list x y (/ (+ (* (- x1 x) n1) (* (- y1 y) n2) (* z1 n3)) n3))
  76.  )
  77.  

now here are the results of a speed test including  marko's and hanphuc's versions.

Quote
(testgetz)

ymg0.    Elapsed: 2.761 sec.
ymg1.    Elapsed: 1.700 sec.
ymg2.    Elapsed: 1.514 sec.
ymg3.    Elapsed: 0.717 sec.
ymg4.    Elapsed: 0.609 sec.
ymg5.    Elapsed: 0.546 sec.
hanphuc. Elapsed: 16.162 sec.
marko1.  Elapsed: 10.608 sec.
marko2.  Elapsed: 7.581 sec.
_$
Title: Re: Triangulation (re-visited)
Post by: chlh_jd on April 24, 2014, 11:14:42 AM
hi chlh_jd, this arx sample used by surveyor jobs can be applied in function: getz?
if we hide the first line (geomcal)** then we still can use ymg's getz, because ARX not loaded :-)
...
I don't think so that use (cal "ilp...") would be faster than Ymg's getz function , because of it should cal not only z coor.
What I show In reply 168# I post , it's AutoCAD Interface routine , It does not have to be called through Vlisp .
Title: Re: Triangulation (re-visited)
Post by: ymg on April 24, 2014, 11:38:42 AM
Quote
What I show In reply 168# I post , it's AutoCAD Interface routine

chlh_jd

not too sure that the functions in your post are applicable to isolines.

ymg
Title: Re: Triangulation (re-visited)
Post by: chlh_jd on April 24, 2014, 09:12:00 PM
Quote
What I show In reply 168# I post , it's AutoCAD Interface routine

chlh_jd

not too sure that the functions in your post are applicable to isolines.

ymg

1+
Title: Re: Triangulation (re-visited)
Post by: ymg on May 05, 2014, 06:05:38 PM
I have added a new command to the triangulation program
to creates a boundary (concave hull) around the point set.

As you know there is no single solution to this problem.

However based on this paper:
 Efficient generation of simple polygons for characterizing the shape of a set of points in the plane (https://www.google.ca/url?q=http://ambientspatial.net/ddo/wp-content/papercite-data/pdf/duckham08.pr.pdf&sa=U&ei=ogVoU7GqJZPfsAT7k4Jw&ved=0CB8QFjAA&usg=AFQjCNHAwWh3A5OAUsU0KOTYobrDg57rLQ)

by Matt Duckham, Lars Kulik, Mike Worboys, Antony Galton

I have come up with a dynamic way to get a solution by
varying the length parameter from 0.1 to 1 and displaying
the resulting polygon.  You start with parameter set at 0.5
pressing "+" keys erodes the hull more, while minus erodes
less.

Of course when the parameter is equal to 1 what you have is
the Convex Hull.
 
Pressing "ENTER" or "SPACE BAR" or "LEFT-CLICK" will
accept the new Boundary, and the 3dface outside of it
will be deleted.

Pressing "RIGHT-CLICK" will cancel the operation.

There is room for optimization, but the speed ain't bad.

ymg


Title: Re: Triangulation (re-visited)
Post by: ymg on May 06, 2014, 11:13:35 AM
Here a small video illustrating the use of Xshape:

Title: Re: Triangulation (re-visited)
Post by: pedroantonio on May 07, 2014, 04:54:47 AM
Hi ymg i need some help with your code.Until yesterday the code works fine.Today when i try to use it gives me this alert message

Quote
Error in dialog file

"C:\Users\Prodromos\AppData\Local\Temp\tin.dcl", line 401: newline in string constant

Error in dialog file
"C:\Users\Prodromos\AppData\Local\Temp\tin.dcl", line 402: missing semicolon

Error in dialog file

"C:\Users\Prodromos\AppData\Local\Temp\tin.dcl", line 402:
syntax error
Symbol: "0
0.0
0.00".

why? Any ideas

Thanks
Title: Re: Triangulation (re-visited)
Post by: ymg on May 07, 2014, 06:54:07 PM
The error message is quite clear.

Check line 402 in temp.dcl it correspond to this.

Code: [Select]
(write-line "      list = \"0 \\n0.0 \\n0.00
                                             \\n0.000\\n0.0000\";          " f)

Make sure that it is what you have in the lisp file.
Title: Re: Triangulation (re-visited)
Post by: pedroantonio on May 08, 2014, 01:25:51 AM
Why create the dcl file wrong in the temp folder.
This path created wrong
Quote
list = \"0 \\n0.0 \\n0.00
                                             \\n0.000\\n0.0000\";     

This is my tin.dcl full of erorss !! Can any tell me why? This happend sundenly. I unistall autocad and then i clear all temp files .I installl autocad again and i have the same problem. I don't now what to do, because this lisp works .....

Title: Re: Triangulation (re-visited)
Post by: pedroantonio on May 08, 2014, 06:04:04 AM
The version 5.5 works fine .The new version has the problem.Can you fix it ?
Title: Re: Triangulation (re-visited)
Post by: ymg on May 08, 2014, 11:30:29 AM
topographer,

Delete the tin.dcl that is in your temp folder.

Then make sure you change the line
in the generatedcl routine of the lisp file,
to read like so all in one line :

Code: [Select]
(write-line "      list = \"0 \\n0.0 \\n0.00\\n0.000\\n0.0000\"; " f)
Title: Re: Triangulation (re-visited)
Post by: ymg on May 08, 2014, 12:49:50 PM
The attachment in reply #177 triangV0.5.6.lsp has been modified to correct
a bug in generatedcl routine.

ymg
Title: Re: Triangulation (re-visited)
Post by: pedroantonio on May 08, 2014, 05:26:26 PM
Thank you ymg
Title: Re: Triangulation (re-visited)
Post by: XXL66 on May 28, 2014, 09:22:25 AM
Hi,

Added a TEXT entity selection option, thus texts representing elevations (f.e. "15.256" etc) We use a decimal sign in the EU, don't know about the US.

BTW, i cannot run these functions in ACAD2015, works fine in BricsCAD. TIN computes 25000 points in less then 25 seconds.
Title: Re: Triangulation (re-visited)
Post by: XXL66 on May 28, 2014, 12:38:13 PM
i would like to try to add breaklines. I came across this document:
This method seems to be used in arcgis.

http://www.isprs.org/proceedings/xxix/congress/part4/28_XXIX-part4.pdf

If you can find any other interesting documents for implementing breaklines, please share it !

thx

Title: Re: Triangulation (re-visited)
Post by: ymg on May 28, 2014, 01:07:59 PM
xxl66,

I am working on adding breaklines.

However, due to the way Evgeny's triangulation work
I still have not find the proper way.

I do have another triangulation program (not published yet)
which should be easier to modify to accomodate breaklines.

If the breakline are defined before hand, it normally is sufficient
to prevent Triangle Swap when the common side between
to triangle on the stack are part of a breakline.

The bad news is that new triangulation is quite a bit slower
than Evgenyi's way, although probably still acceptable
if we get Breaklines.

ymg
Title: Re: Triangulation (re-visited)
Post by: XXL66 on May 29, 2014, 05:23:03 AM
hi,

i would just add a 3D polyline option and add the vertices to the TIN. When TIN completed integrate the polylines, but of course easier said then done.
Maybe it is an idea when building the TIN to add some kind of property to the triangles when it is crossing or touching a poly(break)line. Thus the (after)computation only needs to use a selection of triangles involved with breaklines. Or maybe add entity name of the breakline as property.
Of course there should also be a verification for self-crossing and crossing polylines first.
Title: Re: Triangulation (re-visited)
Post by: XXL66 on May 30, 2014, 03:35:41 AM
http://www.cs.berkeley.edu/~jrs/papers/inccdt.pdf

Found this very interesting document. There is pseudo code available for inserting segments into a delaunay triangulation.
Title: Re: Triangulation (re-visited)
Post by: XXL66 on May 30, 2014, 06:35:29 AM
hi,

i was comparing speed between acad and bcad, in bcad 2500 take .3 seconds in acad 3+ seconds. for 10000 points in acad 33 seonds and bcad 3.6 seconds. It seems bcad is 10 times faster !
i wasn't able to test larger sets in acad. in bcad i have no trouble, even 60000 points. But when i try fe 25000 points in acad (2015) i get the following error.

Command: TIN
Select objects: all
25000 found
Select objects:
Usage: (acet-ui-progress [<label> [<max>] | <current>])

is this function integer limited?



Title: Re: Triangulation (re-visited)
Post by: ymg on May 30, 2014, 10:15:35 AM
XXL66

I had read the paper by Shewchuk.  It is indeed interesting.

A more interesting one would be An improved incremental algorithm for
constructing restricted Delaunay triangulations  (http://citeseerx.ist.psu.edu/viewdoc/download?doi=10.1.1.61.3862&rep=rep1&type=pdf) by Marc Vigo Anglada

Although basic content and method is the same.  You need to evacuate
all triangle edges cut by a breakline and then re-triangulate the 2 polygons
created by the insertion of that edge.

The complexity of that operation is bound to slow down processing of a set of points.

A way out would be to begin by the insertion of all the edges, then as said previously
prevent any swapping of edges for these triangles.

But I am not too sure that Evgenyi's algorithm can be modified to do that.

I am not too concerned about huge triangulations.  For that there are all kind of
solutions.  What I am after is something that is very flexible and easy to operate
for triangulation on the order of a few thousands points.

The other suject that need to be addressed are boundaries and holes in the TIN.

ymg
Title: Re: Triangulation (re-visited)
Post by: ymg on May 30, 2014, 10:31:50 AM
Here is the new triangulation as per Sloan's paper.

This is a first version, so there are certainly many ways
to optimize it and gain some speed.

To use it just call sloan instead of triangulate in the Tin program.

ymg

Code - Auto/Visual Lisp: [Select]
  1. ;;****************************************************************************;
  2. ;; sloan              by ymg                                                  ;
  3. ;; Delaunay's Triangulation as per S.W. Sloan's papers,                       ;
  4. ;; A Fast Algorithm For Constructing Delaunay Triangulations In The Plane.    ;
  5. ;; A Fast Algorithm For Generating Constrained Delaunay Triangulations.       ;
  6. ;;                                                                            ;
  7. ;;                                                                            ;
  8. ;;****************************************************************************;
  9.  
  10. (defun sloan (pl  / )
  11.    (setq version "V0.0.1")
  12.    (setq tl nil nl nil tn nil)  
  13.    (if pl
  14.       (progn
  15.          (setq   ti (car (_VL-TIMES));Initialize timer for Triangulation      ;
  16.                  bb (list (apply 'mapcar (cons 'min pl))
  17.                           (apply 'mapcar (cons 'max pl))
  18.                     )
  19.                xmin (caar bb)      
  20.                xmax (caadr bb)      
  21.                ymin (cadar bb)      
  22.                ymax (cadadr bb)
  23.                dmax (max (- xmax xmin)(- ymax ymin))
  24.                  ; Points are Scaled to 1 along Max of x and y dimensions     ;
  25.                  pl (mapcar
  26.                        (function
  27.                            (lambda (a) (list (/ (- (car a) xmin) dmax)
  28.                                              (/ (- (cadr a) ymin) dmax)
  29.                                              (caddr a)
  30.                                        )
  31.                            )        
  32.                        )
  33.                        pl
  34.                     )
  35.                  np (length pl)                      ; Number of Pts          ;
  36.                  
  37.                  ;Vertex of Supertriangle are appended to the Point list      ;
  38.                  pl (append pl (list '(-100. -100. 0.)'(100. -100. 0.)'(0. 100. 0.)))
  39.                
  40.                  tl (list (list np (1+ np)(+ np 2))) ; Init.  Triangle list.  ;
  41.                  nl (list (list nil nil nil))        ; Init.  Neighbour list. ;
  42.                 stk nil                              ; Init.  Swapping Stack. ;
  43.                  nt 0                                ; Init.  Triangles Index.;
  44.                  n -1                                ; Init.  Point Index.    ;
  45.                  
  46.          )              
  47.  
  48.          
  49.          ;Begin Insertion of Points                                           ;
  50.          (acet-ui-progress "Points Insertion:" np)
  51.          (repeat np
  52.            
  53.             (setq   n (1+ n)
  54.                     p (nth n pl)
  55.                    tn (triloc p pl tl nl) ; Index of Triangle containing p.   ;
  56.                    tc (nth tn tl)   ntc (nth tn nl)        
  57.                     a (car ntc)       b (cadr ntc)    c (caddr ntc)
  58.                    v1 (car  tc)       v2 (cadr  tc)   v3 (caddr  tc)
  59.                    t1 (list n v1 v2)  nt1 (list (+ nt 2) a (+ nt 1))
  60.                    nt (1+ nt)
  61.                    t2 (list n v2 v3)  nt2 (list tn b  (+ nt 1))
  62.                    nt (1+ nt)
  63.                    t3 (list n v3 v1)  nt3 (list (- nt 1) c tn)
  64.                    
  65.                    tl (subst t1 tc tl)             ; Updates Current Triangles;
  66.                    nl (subst nt1 ntc nl)           ; Updates Its Neighbours   ;
  67.  
  68.                    tl (append tl (list t2 t3))     ; Creates 2 New Triangles  ;
  69.                    nl (append nl (list nt2 nt3))   ; Creates 2 New Neighbours ;
  70.             )      
  71.             (if a (setq stk (cons tn stk)))
  72.             (if b
  73.                (progn
  74.                   (setq bn (nth b nl))
  75.                   (cond
  76.                      ((= (car   bn) tn) (setq nl (subst (list (- nt 1) (cadr bn) (caddr bn)) bn nl)))
  77.                      ((= (cadr  bn) tn) (setq nl (subst (list (car bn) (- nt 1)  (caddr bn)) bn nl)))
  78.                      ((= (caddr bn) tn) (setq nl (subst (list (car bn) (cadr bn) (- nt 1))   bn nl)))                  
  79.                   )
  80.                   (setq stk (cons (- nt 1) stk))
  81.                )
  82.             )  
  83.             (if c
  84.                (progn
  85.                   (setq cn (nth c nl))
  86.                   (cond
  87.                      ((= (car   cn) tn) (setq nl (subst (list nt (cadr cn) (caddr cn)) cn nl)))
  88.                      ((= (cadr  cn) tn) (setq nl (subst (list (car cn) nt  (caddr cn)) cn nl)))
  89.                      ((= (caddr cn) tn) (setq nl (subst (list (car cn) (cadr cn) nt)   cn nl)))                
  90.                   )
  91.                   (setq stk (cons nt stk))
  92.                )
  93.            )
  94.            
  95.            (while stk
  96.                 (setq   l (car stk) ln (nth l nl) lt (nth l tl)
  97.                         r (cadr ln) rn (nth r nl) rt (nth r tl)
  98.                       stk (cdr stk)    
  99.                 )      
  100.                 (cond
  101.                    ((= (car   rn) l) (setq v1 (car    rt) v2 (cadr  rt) v3 (caddr rt)
  102.                                             a (cadr   rn)  b (caddr rn)  c (caddr ln)))
  103.                    ((= (cadr  rn) l) (setq v1 (cadr   rt) v2 (caddr rt) v3 (car   rt)
  104.                                             a (caddr  rn)  b (car   rn)  c (caddr ln)))
  105.                    ((= (caddr rn) l) (setq v1 (caddr  rt) v2 (car  rt) v3 (cadr rt)
  106.                                             a (car    rn)  b (cadr  rn)  c (caddr ln)))
  107.                 )
  108.              
  109.                 (if (swap v1 v2 v3 n pl)
  110.                    (progn
  111.                       (setq tl (subst (list (car lt) (cadr lt) v3) lt tl)
  112.                             nl (subst (list (car ln) a r) ln nl)
  113.                                    
  114.                             tl (subst (list n v3 v1) rt tl)
  115.                             nl (subst (list l  b  c) rn nl)
  116.                       )
  117.                       (if a
  118.                          (progn
  119.                             (setq an (nth a nl))
  120.                             (cond
  121.                                ((= (car   an) r) (setq nl (subst (list l (cadr an) (caddr an)) an nl)))
  122.                                ((= (cadr  an) r) (setq nl (subst (list (car an) l  (caddr an)) an nl)))
  123.                                ((= (caddr an) r) (setq nl (subst (list (car an) (cadr an) l)   an nl)))                
  124.                             )
  125.                             (setq stk (cons l stk))
  126.                          )
  127.                       )
  128.                       (if b (setq stk (cons r stk)))
  129.                       (if c
  130.                          (progn
  131.                             (setq cn (nth c nl))
  132.                             (cond
  133.                                ((= (car   cn) l) (setq nl (subst (list r (cadr cn) (caddr cn)) cn nl)))
  134.                                ((= (cadr  cn) l) (setq nl (subst (list (car cn) r  (caddr cn)) cn nl)))
  135.                                ((= (caddr cn) l) (setq nl (subst (list (car cn) (cadr cn) r)   cn nl)))                
  136.                             )
  137.                          )
  138.                       )
  139.                    )
  140.                 )
  141.            )  
  142.          
  143.            (acet-ui-progress -1)
  144.          
  145.          ) ;We are done with points insertion. ;
  146.          
  147.          (acet-ui-progress)
  148.          
  149.          ;Purge Triangle list of any triangle that has a common vertex with supertriangle.        
  150.          (setq tl (vl-remove-if-not
  151.                      (function
  152.                         (lambda (a) (and (< (car a) np)(< (cadr a) np)(< (caddr a) np)))
  153.                      )
  154.                      tl
  155.                   )
  156.          )
  157.          ;; Here we will replace call to get neighour wit adjustment to nl          
  158.          (setq nl (getneighbour tl))
  159.          
  160.          ; Re-Scale the point list                                            ;
  161.          (setq pl (mapcar
  162.                      (function
  163.                          (lambda (a) (list (+ (* (car  a) dmax) xmin)
  164.                                            (+ (* (cadr a) dmax) ymin)
  165.                                            (caddr a)
  166.                                      )
  167.                          )
  168.                       )  
  169.                       pl
  170.                   )
  171.          )
  172.  
  173.          ;Create a layer and Draw the triangulation                           ;
  174.          
  175.          (mk_layer (list "TIN" 8))
  176.          (acet-ui-progress "Drawing 3DFaces:" (length tl))
  177.          (setq 3df '(0 . "3DFACE"))
  178.          (foreach tr tl
  179.             (entmakex (list 3df                        
  180.                            (cons 10 (nth (car tr)   pl))
  181.                            (cons 11 (nth (car tr)   pl))
  182.                            (cons 12 (nth (cadr tr)  pl))
  183.                            (cons 13 (nth (caddr tr) pl))
  184.                       )
  185.             )
  186.             (acet-ui-progress -1)
  187.          )
  188.          (acet-ui-progress)
  189.       )
  190.    )
  191.    
  192.    (princ (strcat "\n     CDT " version " - Elapsed time: " (rtos (/ (- (car (_VL-TIMES)) ti) 1000.) 2 4) " secs, " (itoa (length tl)) " 3DFACES"))
  193.  
  194. )
  195.  
  196.  
  197.  
  198. ;;****************************************************************************;
  199. ;; (swap l r pl)                                                              ;
  200. ;; Cline & Renka Swap Test                                                    ;
  201. ;;                                                                            ;
  202. ;; Given a triangle defined by three points indices v1, v2, v3                ;
  203. ;; and an index to pointp ,                                                   ;
  204. ;; Returns T is p is inside circle circumscribing triangle v1 v2 v3.          ;
  205. ;;                                                                            ;
  206. ;;****************************************************************************;
  207.  
  208. (defun swap (v1 v2 v3 p pl / cosa cosb sina sinb v1 v2 v3
  209.                              x1 x13 x1p x2 x23 x2p x3 xp
  210.                              y1 y13 y1p y2 y23 y2p y3 yp)
  211.    
  212.     (setq  p (nth p pl)  xp (car  p) yp (cadr  p)
  213.           v1 (nth v1 pl) x1 (car v1) y1 (cadr v1)
  214.           v2 (nth v2 pl) x2 (car v2) y2 (cadr v2)
  215.           v3 (nth v3 pl) x3 (car v3) y3 (cadr v3)
  216.          x13 (- x1 x3)  y13 (- y1 y3)
  217.          x23 (- x2 x3)  y23 (- y2 y3)
  218.          x1p (- x1 xp)  y1p (- y1 yp)
  219.          x2p (- x2 xp)  y2p (- y2 yp)
  220.         cosa (+ (* x13 x23) (* y13 y23))
  221.         cosb (+ (* x1p x2p) (* y1p y2p))  
  222.     )            
  223.     (cond
  224.        ((and (not (minusp cosa))(not (minusp cosb))) nil)
  225.        ((and (minusp cosa)(minusp cosb)))
  226.        (t  (setq sina (- (* x13 y23) (* x23 y13))
  227.                  sinb (- (* x2p y1p) (* x1p y2p))
  228.            )    
  229.            (minusp (+ (* sina cosb)(* sinb cosa)))
  230.        )         
  231.     )
  232. )  
  233.  
  234. ;;****************************************************************************;
  235. ;; (edgrpl l k r e)                                                           ;
  236. ;;                                                                            ;
  237. ;; Find edge in Triangle l which is adjacent to triangle K                    ;
  238. ;;                                                                            ;
  239. ;; Input: l Index of triangle                                                 ;
  240. ;;        r Index of triangle r in neighbour list                             ;
  241. ;;        v Replacement value                                                 ;
  242. ;;        e Neighbour List                                                    ;
  243. ;;                                                                            ;
  244. ;;****************************************************************************;
  245.  
  246. (defun edgrpl (l r v e /  ln tr)
  247.    (setq ln (nth l e) tr (nth r tl))
  248.    (cond
  249.        ((= (car   ln) r) (list v (cadr tr) (caddr tr)))
  250.        ((= (cadr  ln) r) (list (car tr) v (caddr tr)))
  251.        ((= (caddr ln) r) (list (car tr) (cadr tr) v))
  252.    )     
  253. )        
  254.  
  255.  
  256. ;;****************************************************************************;
  257. ;; (triloc p)                                                                 ;
  258. ;;                                                                            ;
  259. ;; Locates triangle which encloses point p using Lawson's Walk.               ;
  260. ;;                                                                            ;
  261. ;; Given p a point, Returns Index in tl of triangle containing the point.     ;
  262. ;; If outside the triangulation Return is nil.                                ;
  263. ;;                                                                            ;
  264. ;; Point List pl and Neigbour List nl are defined outside this routine.       ;
  265. ;; by ymg  August 2013                                                        ;
  266. ;; Optimized Speed and re-organized code January 2014                         ;
  267. ;; Nice but get lost when triangulation is disjointed.                        ;
  268. ;;****************************************************************************;
  269.  
  270. (defun triloc (p pl tl nl / notfound i p1 p2 p3 x x1 x2 x3 y y1 y2 y3)
  271.      
  272.     (if (not tn) (setq tn (/ (length tl) 2)))
  273.     (setq x (car p)  y (cadr p)  notfound t)  
  274.     (while (and notfound tn)        
  275.         (setq   i (nth tn tl)
  276.                p1 (nth (car   i) pl)  p2 (nth (cadr  i) pl) p3 (nth (caddr i) pl)                
  277.               x1x (- (car p1) x)  y1y (- (cadr p1) y)
  278.               x2x (- (car p2) x)  y2y (- (cadr p2) y)
  279.               x3x (- (car p3) x)  y3y (- (cadr p3) y)  
  280.         )      
  281.         (cond
  282.            ((minusp (- (* x1x y2y) (* y1y x2x))) (setq tn (car   (nth tn nl))))
  283.            ((minusp (- (* x2x y3y) (* y2y x3x))) (setq tn (cadr  (nth tn nl))))
  284.            ((minusp (- (* x3x y1y) (* y3y x1x))) (setq tn (caddr (nth tn nl))))          
  285.            ((setq notfound nil))      
  286.         )        
  287.     )  
  288.     tn
  289. )
  290.  
Title: Re: Triangulation (re-visited)
Post by: pedroantonio on May 31, 2014, 01:42:30 PM
Quote
Here is the new triangulation as per Sloan's paper.

This is a first version, so there are certainly many ways
to optimize it and gain some speed.

To use it just call sloan instead of triangulate in the Tin program.

Hi  ymg.I can not understand it ,can you explain me plesase. To load the sloan  we must copy sloan.lsp and paste in Triangulation.lsp ?

Thanks
Title: Re: Triangulation (re-visited)
Post by: ymg 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
Title: Re: Triangulation (re-visited)
Post by: XXL66 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.


Title: Re: Triangulation (re-visited)
Post by: ymg 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
Title: Re: Triangulation (re-visited)
Post by: ymg 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
Title: Re: Triangulation (re-visited)
Post by: ymg on June 04, 2014, 07:13:11 PM
I did find a bug in the above, will post a revision.

ymg
Title: Re: Triangulation (re-visited)
Post by: XXL66 on June 05, 2014, 10:20:54 AM
nice work.

Do i understand correctly that edges are added AFTER the TIN is computed ?
Title: Re: Triangulation (re-visited)
Post by: ymg 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
Title: Re: Triangulation (re-visited)
Post by: XXL66 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 ?
Title: Re: Triangulation (re-visited)
Post by: ymg 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
Title: Re: Triangulation (re-visited)
Post by: ymg 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.  
Title: Re: Triangulation (re-visited)
Post by: XXL66 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.
(http://s30.postimg.org/72e8whksd/cmap.jpg) (http://postimg.org/image/72e8whksd/)
Title: Re: Triangulation (re-visited)
Post by: XXL66 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)
Title: Re: Triangulation (re-visited)
Post by: ymg 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
Title: Re: Triangulation (re-visited)
Post by: XXL66 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 ?












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





Title: Re: Triangulation (re-visited)
Post by: XXL66 on June 11, 2014, 06:05:50 AM
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.
(http://i59.tinypic.com/i1ab7d.jpg)



Title: Re: Triangulation (re-visited)
Post by: ymg on June 11, 2014, 08:42:10 AM
XXL66,

Quote
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


Title: Re: Triangulation (re-visited)
Post by: XXL66 on June 11, 2014, 09:55:04 AM
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 8) (9 7 3) (8 3 2) (11 5 10) (10 5 4) (10 4 6) (12 6 7) (12 7 9) (12 9 8) (13 6 12) (13 10 6) (14 12 8) (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

...


Title: Re: Triangulation (re-visited)
Post by: ymg on June 11, 2014, 11:08:48 AM
Quote
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))
)

Quote
((2 1 0) (3 1 2) (8 3 2) (8 2 0))
(21 8 1 0)
Title: Re: Triangulation (re-visited)
Post by: XXL66 on June 11, 2014, 11:21:19 AM
thx,

btw: is there a 'inters' function that works 2D only ?
Title: Re: Triangulation (re-visited)
Post by: ymg on June 11, 2014, 11:23:23 AM
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.  
Title: Re: Triangulation (re-visited)
Post by: ymg on June 11, 2014, 11:27:34 AM
Quote
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
Title: Re: Triangulation (re-visited)
Post by: ribarm on June 11, 2014, 11:34:39 AM
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.
Title: Re: Triangulation (re-visited)
Post by: XXL66 on June 11, 2014, 01:19:09 PM
Quote
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 ?







Title: Re: Triangulation (re-visited)
Post by: ymg on June 11, 2014, 03:48:54 PM
Quote
Can you explain nl and el ?

nl points to the neighouring triangle for the corresponding edge.

In your example you have tl= ((2 0 1) (3 2 1))

This can be expressed as a flat edge list
 el = '((2 0) (0 1) (1 2) (3 2) (2 1) (1 3))

The neighbouring triangle through an edge will always have the same vertex but reversed
so we use following code to get position in tl of the neighour.
Code: [Select]
(if (setq p (vl-position (reverse e) el))
          (setq posl (cons (/  p 3) posl))
          (setq posl (cons nil posl) bl (cons e bl))
      )

So after running we have :

nl = ((nil nil 1)(nil 0 nil))

nl is always the same length as tl

Normally the triangulation uses only nl and tl.
However CONTOUR does use el pending that I
rewrites it.

An alternate way would be to do away with tl and nl
and use only el.  This could save on updating which
is expensive when using list.

ymg
Title: Re: Triangulation (re-visited)
Post by: ymg on June 11, 2014, 04:59:20 PM
Still need a bit of work, but here is a
version of Triang that will let you specify
constraints (Breaklines).

Constraints can be either lines from point node
to point node or 3dpoly.

This is a first stroke, so speed has not been optimized yet.

Title: Re: Triangulation (re-visited)
Post by: pedroantonio on June 12, 2014, 02:18:08 AM
hI ymg. I am using Autocad 2010. When i load the new version TriangV0.5.8 and white TIN or CONT gives me this error

Error: too few arguments

I dont know why. Can you fix it .

Thanks
Title: Re: Triangulation (re-visited)
Post by: XXL66 on June 12, 2014, 02:56:44 AM
For me it still works. However i noticed it crashes on the acet- function (express tools) in bricscad.
I next tried it in acad2014 with a single 3d polyline, it does some segments but eventually crashes on a segment.

     TIN - Elapsed time: 0.7640 secs, 1641 3DFACES
Error: bad argument type: fixnump: nil

I noticed it is really slow, probably because of these fence selections, actually this is also what i do in my c++ code and this also works very slow.

@topographer: do you have express-tools installed ?
Title: Re: Triangulation (re-visited)
Post by: pedroantonio on June 12, 2014, 03:07:30 AM
Yes i have express tools , and the previous version TriangV0.5.6 works fine. I dont know .....
Title: Re: Triangulation (re-visited)
Post by: XXL66 on June 12, 2014, 04:31:36 AM
when does this error appear, before or after selection, dialog box?

does it crash on any selection of entities ?
Title: Re: Triangulation (re-visited)
Post by: pedroantonio on June 12, 2014, 04:36:49 AM
I load the lisp and when i write TIN or CONT gives me this error and don't open any box
Title: Re: Triangulation (re-visited)
Post by: XXL66 on June 12, 2014, 07:12:32 AM
@topographer: might be something with the dcl file in the temprefix folder

@ymg: i think the error happens when the edge is not intersected by any triangles (vshr = nil).
            whenever any of the triangle edges is equal to a b you can skip it (a b) is member of el ?
           

Wouldn't it be possible to compute the edges before the 3Dfaces are created ?

f.e. remove and add new triangle in tl and then finaly draw the 3Dfaces

Code: [Select]
(defun addedge
       (a b / ls x lsa ip)
   ;; get all triangles from tl that have connection with point a of the edge
  (setq ls (vl-remove-if-not
     'vl-consp
     (mapcar '(lambda (x)
(if (member a x)
  x
)
      )
     tl
     )
   )
  )
  (print ls)
  (setq cnt 0)
  (foreach x (mapcar '(lambda (x) (vl-remove a x)) ls) ;; find the intersection of edge a-b
    (if (setq ip (inters (list (car (nth a pl)) (cadr (nth a pl)))
(nth b pl)
(nth (car x) pl)
(nth (cadr x) pl)
t
)
)
      (progn
(setq tra (nth cnt ls)) ;; triangle is the one that crosses adge a-b
        (setq iea (list (car x) (cadr x))) ;; the intersecting edge

(print tra)
(print iea)
        (command "point" ip) ;; just for display purpose
      )
    )
    (setq cnt (+ cnt 1))
  )
  ;; next thing to do:  based on edge iea search the other triangles until point b is member of a triangle
  ;; update tl (remove tra) and el, nl...
  ;;...

)

Title: Re: Triangulation (re-visited)
Post by: XXL66 on June 12, 2014, 10:26:28 AM
there is an error in the error reporting

nil should be '(nil nil)

Code: [Select]
(if (member '(nil nil) lst)
    (progn
      (msgbox "Triangulation"
      64
      (strcat "There Were At Least One Breakline Who"
      "\nHad An Endpoint Not In The Point Set\n"
      "\nProceeding With Triangulation"
      "\nWithout Breaklines."
      )
      2
      )
      nil
    )
  )
Title: Re: Triangulation (re-visited)
Post by: ymg on June 12, 2014, 11:32:36 AM
Quote
nil should be '(nil nil)

It is a bug, but a comparison with (nil nil) won't resolve it,
as we should flag the problem if a or b are nil.

The triangulation and speed is the same.  Edge insertion is a different
operation, the speed of which depends on how many triangles are crossed
by an insertion.

One bottleneck is the recomputing of the complete neighour list for
each edge.  This will be changed by recomputing only the affected triangles,
and should bring a speed improvement.

For Bcad all you need to do is replace the call to acet-ss-intersection
with a function that will give you the common entities between
two selection set.  All this in function get_trname.

As an alternative we could maintain a list of ename for the 3dfaces
but I don't believe it would be worth it.

ymg

Title: Re: Triangulation (re-visited)
Post by: ymg on June 12, 2014, 11:57:15 AM
I've corrected the bug pointed out by XXL66.

Also new triangles are replaced in tl instead of
deleting them and appending.

Title: Re: Triangulation (re-visited)
Post by: XXL66 on June 12, 2014, 12:46:00 PM
Command: TIN

Error: too few arguments
Command:

Title: Re: Triangulation (re-visited)
Post by: ymg on June 12, 2014, 01:05:47 PM
Quote
Error: too few arguments

I've just tested it from a restart of Acad,
and I don't have this problem.
Title: Re: Triangulation (re-visited)
Post by: XXL66 on June 12, 2014, 02:18:59 PM
most have loaded the wrong file...

however, i think it crashes now whenever an edge is already part of a triangle.
you can exclude these i guess


(if (not (member k el))
           (progn
             (addedge (car k) (cadr k))
           )
         )
Title: Re: Triangulation (re-visited)
Post by: ymg on June 12, 2014, 03:07:37 PM
I think the bug might be a little deeper than that.

It arises as when the cavity is a single triangle.

Will need to wrap the while loop inside a conditionnal
test, so that we can constraint a single triangle.

Also upon revising Anglada's pseudo code I need to
add this precondition.

Quote
Precondition: a; b member of pl and edge ab not member of tl

So maybe your condition is sufficient.

ymg
Title: Re: Triangulation (re-visited)
Post by: ymg on June 12, 2014, 03:59:41 PM
Here I modified ADDEDGE to take care of Anglada's precondition.

I elected to do it there, because prior to triangulation we cannot
know for sure if that edge will be present or not.

Code - Auto/Visual Lisp: [Select]
  1. ;;****************************************************************************;
  2. ;; addedge     by ymg                        May   2014                       ;
  3. ;;                                                                            ;
  4. ;; As per paper: An Improved Incremental Algorithm For Constructing           ;
  5. ;;               Restricted Delaunay Triangulations. by Marc Vigo Anglada     ;
  6. ;;                                                                            ;
  7. ;; Arguments: a, Index of point in a triangulation.                           ;
  8. ;;            b, Index second point, defining edge ab to be inserted          ;
  9. ;;                                                                            ;
  10. ;; External Variables tl and nl will be modified.                             ;
  11. ;;                                                                            ;
  12. ;; Will insert an edge in an existing triangulation.  Triangles crossed by    ;
  13. ;; the edge will be deleted.  Cavity will  be re-triangulated to restore      ;
  14. ;; Delaunay's condition. New triangle will be redrawn.                        ;
  15. ;;                                                                            ;
  16. ;;****************************************************************************;
  17.  
  18. (defun addedge (a b / 3df  pa pb poll polu topo tr v vopo vshr)
  19.    (setq pa (nth a pl)
  20.          pb (nth b pl)
  21.          tn nil
  22.          tn (triloc (polar pa (angle pa pb) 0.001) pl tl nl)
  23.          tr (nth tn tl)
  24.           v a
  25.          dl nil polu nil poll nil newtri nil
  26.    )
  27.    (if (not (and (member a tr) (member b tr)))
  28.       (progn
  29.          (while (not (member b tr))
  30.             (setq topo (topp tr v tl nl)
  31.                   vopo (vopp topo tr)
  32.                   vshr (vl-remove vopo topo)
  33.             )
  34.             (if (onleft_p vopo a b)
  35.                (setq  v (if (onleft_p (car vshr) a b) (car vshr) (cadr vshr)) polu (cons v polu))
  36.                (setq  v (if (not (onleft_p (car vshr) a b)) (car vshr) (cadr vshr)) poll (cons v poll))
  37.             )
  38.             (setq dl (cons tr dl) ; dl List of triangle to be modified              ;
  39.                   tr topo
  40.             )
  41.          )
  42.  
  43.          (setq v (car (vl-remove v vshr)))
  44.          (if (onleft_p v a b)
  45.             (setq polu (cons v polu))
  46.             (setq poll (cons v poll))
  47.          )  
  48.          (setq dl (cons tr dl))   ; Adding last triangle to be modified             ;
  49.          (setq polu (reverse polu) poll (reverse poll))  
  50.          
  51.          (setq newtri nil)        ; New Triangles will be accumulated in newtri     ;
  52.          (tripol polu a b   t)
  53.          (tripol poll a b nil)
  54.          (foreach tr dl
  55.             (entdel (get_trname tr pl))
  56.          )
  57.          (mk_layer (list "TIN" 8))
  58.          (setq 3df '(0 . "3DFACE"))
  59.          (setq i -1)
  60.          (foreach tr newtri
  61.             (entmakex (list 3df                        
  62.                            (cons 10 (nth (car tr)   pl))
  63.                            (cons 11 (nth (car tr)   pl))
  64.                            (cons 12 (nth (cadr tr)  pl))
  65.                            (cons 13 (nth (caddr tr) pl))
  66.                       )
  67.             )
  68.             (setq tl (subst tr (nth (setq i (1+ i)) dl) tl))
  69.          )  
  70.          (setq nl (get_neighbour tl))
  71.       )
  72.    )
  73.    (princ)
  74. )
  75.  

ymg
Title: Re: Triangulation (re-visited)
Post by: pedroantonio on June 12, 2014, 06:36:01 PM
ymg.I still have the same problem .Is not working .......
Title: Re: Triangulation (re-visited)
Post by: ymg on June 12, 2014, 06:57:41 PM
topographer,

Did u remove the dcl from the temporary folder
as instructed by XXL66 ?
Title: Re: Triangulation (re-visited)
Post by: smemo on June 13, 2014, 02:04:09 AM
in row 116 of  TriangV0.5.8.LSP
(if (not (findfile fn)) (make_dcl)) 
add "fn" to generate dcl
(if (not (findfile fn)) (make_dcl fn))

great job, my compliments ymg
Title: Re: Triangulation (re-visited)
Post by: pedroantonio on June 13, 2014, 02:13:06 AM
Thank you smemo now works fine.....

I upload the correct code

Title: Re: Triangulation (re-visited)
Post by: smemo on June 13, 2014, 02:29:03 AM
in DCL when I select:
 [v] Generate Vonoroi Diagram
i get
Error: no function definition: GETNEIGHBOUR
Title: Re: Triangulation (re-visited)
Post by: motee-z on June 13, 2014, 04:09:46 AM
I got error in dcl dialogue at line 401 and 402
syntax error
symbol: "0
0.0
0.00"
 
Title: Re: Triangulation (re-visited)
Post by: XXL66 on June 13, 2014, 04:27:40 AM
Maybe we should try another approuch for the edges, namely by adding Steiner vertices on the edges (Gabriel) before doing the triangulation (because the TIN computation is very fast).

page 18:
https://team.inria.fr/titane/files/2014/03/cgal-meshes.pdf

Whenever a segment is 'encroached' you middle it. You check this again for the 2 new edges and so on. When all points ar added just run trianulation.
Now just find a fast method to check if a point is inclosed in the circle.
However, i'm not sure if this would solve every edge. I guess so because "Encroached subsegments have priority over skinny triangles". What do you think ?




 
Title: Re: Triangulation (re-visited)
Post by: csgoh on June 13, 2014, 05:13:28 AM
tested using acad13.
triangles cut across breaklines.??
the layer ts represents top of slope edge whereas bs represents the bottom edge of a slope.
any solutions?

cs
Title: Re: Triangulation (re-visited)
Post by: XXL66 on June 13, 2014, 05:58:45 AM
I think there is still a bug in the add edges function, might have to do with tolerance on the points.

The point position for each edge end point is searched in the pl list. I think it might fail here. You probably got the warning msgbox "missing endpoint" ?
Maybe it would be better to build the pl list from start based on edge vertices only + solitary points.





Title: Re: Triangulation (re-visited)
Post by: csgoh on June 13, 2014, 06:12:01 AM
I did not get any error messages when testing out.

cs
Title: Re: Triangulation (re-visited)
Post by: XXL66 on June 13, 2014, 06:43:10 AM
i did (using your dwg), see attachment
Title: Re: Triangulation (re-visited)
Post by: ymg on June 13, 2014, 09:26:06 AM
smemo,


Thanks for the appreciation.

Voronoi will not work in a constrained triangulation.
Some of the region would overlap.

However it does work for a Delaunay triangulation.
So maye we should add the following in the triangulate
function. But the main bug is the function name is
get_neighour

Code: [Select]
((if (and (= govor "1")(not cdtl))
    (progn
               ; Generates the Neighbour List                                 ;
(setq  tv (car (_vl-times))    ; Timer for Voronoi            ;
                       nl (get_neighbour tl)
                )


Title: Re: Triangulation (re-visited)
Post by: ymg on June 13, 2014, 09:36:45 AM
Quote
I think there is still a bug in the add edges function

I believe you means in the get_constraints function.  It is possible
as searching for points is a little tempermental.  Something else that need
to be done in there is to exclude LWPOLYLINE.

As for Steiner points and Gabriel's graph, I know of the technique
but you are entering a different ball park which is  the Augmented Triangulation.

Right now the biggest time hog is the recomputig of the whole neighbour list
for each edge.  As told earlier, I intend to fix it.

ymg
Title: Re: Triangulation (re-visited)
Post by: XXL66 on June 13, 2014, 09:58:28 AM
(setq a (vl-position (car e) pl)
          b (vl-position (cadr e) pl)
        flg (or (not a) (not b))
             lst (cons (list a b) lst)
)

in get_constraints yes, i think comparing vertices with point needs a tolerance, the vl-position will possible not found the according point in the list


I did some testing with steiner, it doesn't work in all cases, because when you add points it might be in a circumcle of a segment that already is processed.
This (terrible) code add's steiner points (only line segments)


Code: [Select]
(defun c:add_steiner (/ ss i e np newlist)
  (setq ss
(ssget '((0 . "LINE"))
)
  )
  (if ss
    (progn
      (repeat (setq i (sslength ss))
(setq e (ssname ss (setq i (1- i))))
(gabriel e)
;;; (setq newlist (append (gabriel e) newlist))
;;; (setq newlist (cons (cdr (assoc 10 (entget e))) newlist))
;;; (setq newlist (cons (cdr (assoc 11 (entget e))) newlist))
      )
    )
  )
;;;  (foreach np newlist
;;;    (entmake (list (cons 0 "POINT") (cons 10 np)))
;;;  )
)


(defun gabriel (e / entl bp ep mp r elist edge found i ss)
  (setq nplist nil)
  (setq entl (entget e))
  (setq bp (cdr (assoc 10 entl)))
  (setq ep (cdr (assoc 11 entl)))
  (setq mp (list (/ (+ (car bp) (car ep)) 2.0)
(/ (+ (cadr bp) (cadr ep)) 2.0)
(/ (+ (caddr bp) (caddr ep)) 2.0)
   )
  )
  ;; middle point
  (setq r (/ (distance bp (list (car ep) (cadr ep))) 2.0))
  ;; 2D radius
  (setq elist (list (list bp ep mp r)))
  (setq ss
(ssget "_w"
(list (- (car mp) r) (- (cadr mp) r))
(list (+ (car mp) r) (+ (cadr mp) r))
'((0 . "POINT"))
)
  )
  ;; selectionset of points around edge


  (while elist
    (setq edge (car elist))
    (setq bp (car edge))
    (setq ep (cadr edge))
    (setq mp (caddr edge))
    (setq r (cadddr edge))

    ;; (command "line" (list (- (car mp) r) (- (cadr mp) r)) (list (+ (car mp) r) (+ (cadr mp) r)) "")
    (if ss
      (progn
(setq found nil)
(repeat (setq i (sslength ss))
  (setq e (ssname ss (setq i (1- i))))
  (setq pt (cdr (assoc 10 (entget e))))
  (if (and (not found)
   (< (distance (list (car pt) (cadr pt)) mp) (- r 0.001)) ;;; 0.001 fuzz to avoid edge points bp ep
      )
    ;; point in circle, we have to split segment
    (progn
      (setq newmp_bp (list (/ (+ (car bp)
(car mp)
      )
      2.0
   )
   (/ (+ (cadr bp)
(cadr mp)
      )
      2.0
   )
   (/ (+ (caddr bp)
(caddr mp)
      )
      2.0
   )
     )
      )
      (setq newmp_ep (list (/ (+ (car ep)
(car mp)
      )
      2.0
   )
   (/ (+ (cadr ep)
(cadr mp)
      )
      2.0
   )
   (/ (+ (caddr ep)
(caddr mp)
      )
      2.0
   )
     )
      )
      (setq elist (cdr elist));;; remove current edge and add 2 new edge segments
      (setq elist (cons (list bp mp newmp_bp (/ r 2.0)) elist))
      (setq elist (cons (list ep mp newmp_ep (/ r 2.0)) elist))
      (entmake (list (cons 0 "POINT") (cons 10 mp)))
;     (setq nplist (cons mp nplist))
      (setq found t)
    )
  )
)
(if (not found)
  (setq elist (cdr elist))
)
;;; points do not meet criteria, remove the edge
      )
      (progn
(setq elist (cdr elist))
;;; no points, remove the edge
      )
    )
  )
 ; nplist
)


Title: Re: Triangulation (re-visited)
Post by: csgoh on June 14, 2014, 12:55:38 AM
Quote
i did (using your dwg), see attachment
XXL, You were right. Retested and got the error as shown.
Title: Re: Triangulation (re-visited)
Post by: mailmaverick on June 14, 2014, 01:47:55 PM
Why this error comes ?

Quote
There Were At Least One Breakline Who Had An Endpoint Not In The Point Set Proceeding With Triangulation Without Breaklines.
Title: Re: Triangulation (re-visited)
Post by: ymg on June 14, 2014, 02:57:22 PM
Quote
Why this error comes ?

Because the index of a vertex could not be found.

The breaklines have to be on existing points.

As said earlier probably need a fuzz on the comparison
of points to find the indices of each edge.

Other reason could be your line or polyline is not 3d.


ymg
Title: Re: Triangulation (re-visited)
Post by: XXL66 on June 14, 2014, 03:16:21 PM
Here is a suggestion for getting the constraints in another method.

first build a point list with a sublist that contains the index number of the constraints
xy sort this list and remove duplicates
build the constraints list

In this method a constraint also does not need to have a point on the vertex. If there is one it is no problem it will be removed from the pl list as duplicate (fuzz factor).

Thus you avoid the fuzz problem with vertices and their corresponding point objects.


My coding sucks, a lot of improvement possible.

Polylines not included yet

Code: [Select]
(defun c:test (/ s ei ent)
  (setq pl nil)
  (setq ss (ssget '((0 . "POINT,*LINE"))))
  (setq ei 0)
  ;;edge index number
  (repeat (setq i (sslength ss))
    (setq ent (entget (ssname ss (setq i (1- i)))))
    (cond ((= (cdr (assoc 0 ent)) "POINT")
   (setq
     pl (cons (list (cdr (assoc 10 ent)) nil)
      ;;
      pl
)
   )
  )
  ((= (cdr (assoc 0 ent)) "LINE")
   (setq
     pl (cons (list (cdr (assoc 10 ent)) ei)
      pl
)
   )
   (setq
     pl (cons (list (cdr (assoc 11 ent)) ei)
      pl
)
   )
   (setq ei (1+ ei))
  )
    )
  )

  ;; Sort pl on X and Y Coordinate then Remove duplicates             ;
  (setq
    pl (vl-sort pl
(function (lambda (a b)
    (or (< (car (car a)) (car (car b)))
(and (= (car (car a)) (car (car b)))
     (< (cadr (car a)) (cadr (car b)))
)
    )
  )
)
       )
  )
 
  (setq pl (remuppts2 pl 0.001))

  (setq cnst nil
i    0
cdtl nil
npl  nil
  )

  ;; build constraints
  (foreach p pl
    (setq npl (cons (car p) npl))
    (foreach y (cadr p)
      (if (setq q (assoc y cnst))
(progn
  (setq cdtl (cons (list (cdr q) i) cdtl))
)
(progn
  (setq cnst (cons (cons y i) cnst))
)
      )
    )
    (setq i (1+ i))
  )
  (setq pl (reverse npl))

)


;;****************************************************************************;
;; remduppts       by Joe Burke                                               ;
;; remove duplicate adjacent points from point list with fuzz factor          ;
;; Modified by ymg to operate on 2d points       ;
;; Modified by XXL for constraints points                                     ;
;;****************************************************************************;

(defun remuppts2 (pl fuz / res p np edgel)
  (setq edgel nil)
  (repeat (1- (length pl))
    (setq p (car pl))
    (setq np (cadr pl))

    (if (< (distance (list (car (car p)) (cadr (car p)))
     (car (cadr pl))
   )
   fuz
)
;;; points are identical
      (progn
(cond
  ((cdr p)
   ;; edge point, remove the duplicate point that is defined as solitary
   (setq edgel (cons (cadr p) edgel))
  )
  ((cdr np)
   ;; edge point, remove the duplicate point that is defined as solitary
   (setq edgel (cons (cadr np) edgel))
  )
  ((and (cdr p) (cdr np))
   (setq edgel (cons (cadr p) edgel))
   (setq edgel (cons (cadr np) edgel))
  )
)
      )
      (progn
(setq res (cons (list (car p) edgel) res))
(setq edgel nil)
      )
    )
    (setq pl (cdr pl))
  )
  (reverse (cons (car pl) res))
  ;; last one needs still some processing i think
)
Title: Re: Triangulation (re-visited)
Post by: XXL66 on June 15, 2014, 03:20:32 AM
Fixed a bug in the constraints list.

I think that there is still a bug in the getneighbour function, because i get an error on an edge that should be in the el list but it's not.
This is with the demo-tin from csgoh. If i remove that segment it works.

(http://i62.tinypic.com/16hp3cj.jpg)

notice in the next example there is no need for points on vertices

(http://i58.tinypic.com/o8gq6c.jpg)

Title: Re: Triangulation (re-visited)
Post by: ymg on June 15, 2014, 02:03:50 PM
Here fixed a few bugs in the get_constraints function.

First bug was the with ssget "_A" which would select
item on layer that were not frozen.  So modified the
selection at beginning of program and created ssb
the selection set of constraints

Get_constraints now received as an argument ssb
and proceed with each vertex by first attempting to
get the vl-position of the coordinates, if unsuccessful
an attempt is made with assoc-fuzz by Irneb to get
the position.

Finally if we did not find the position on both try,
instead of reverting to a triangulation without constraints
we proceed with the edges that we could find.

ymg

Title: Re: Triangulation (re-visited)
Post by: pedroantonio on June 15, 2014, 03:44:59 PM
Nice job ymg. Can you add a text box in the dcl menu for the text size, because all the time the text size is 2.5 .

Thanks
Title: Re: Triangulation (re-visited)
Post by: ymg on June 15, 2014, 04:13:34 PM
Yet another bug removed.

Title: Re: Triangulation (re-visited)
Post by: XXL66 on June 16, 2014, 12:48:38 AM
@ymg: why draw the 3dfaces first and next modify for the constraints ? Avoiding having to search for and removing entities could speed things up. Building a constraints list using the pl list indices would also avoid the multiple search attempts.   
Title: Re: Triangulation (re-visited)
Post by: ymg on June 16, 2014, 10:51:08 AM
XXL66,

What do you think cdtl is ?

It is a constraint list  made out of indices into point list.

I've explained to you that due to the particular algorithm
of the triangulation, I could not simply check if an edge
was a constraint and include it as we go.  If I ever find a
way I would certainly do it.

Constraints, normally are relatively few so it is not a big priority.
The updating of neighbour takes much more time than the redrawing.
On a 3000 triangles tin it is close to a second per inserted edge.

Inserting edges is very often an iterative process, where from a starting
triangulation you realize that you need one or a few more.  So to me
it is important that we keep the constraints insertion separate from
the original triangulation.

As I told you, trying to concentrate on getting something
running smoothly, then will optimize.


ymg
Title: Re: Triangulation (re-visited)
Post by: XXL66 on June 16, 2014, 01:19:01 PM
I know what it is, i was talking the way you build it (multiple searches for points).
You could use vertices instead of points.
Suppose you want to create a dtm from contours f.e. then there are no points.
You also have to remove entities after the tin is created.

I don't use NL only EL and triangles are drawn in a single entmake loop:  16 seconds instead of 430 seconds
Based about 4000 pts and 800 constraints.

Command:
Triangulation V0.5.8 loaded...!
Command:
Command: TIN

Select objects: Specify opposite corner: 4560 found

Select objects:

     TIN - Elapsed time: 3.4630 secs, 3293 3DFACES
     CDT V0.5.8 - Elapsed time: 430.6090 secs, 480 Constraints

Command: Specify opposite corner or [Fence/WPolygon/CPolygon]: *Cancel*

Command: (ssget "x" (list (cons 0 "3DFACE")))
<Selection set: 10b5a>

Command: E
ERASE
Select objects: p
3293 found

Select objects:

Command: APPLOAD
tmp2.lsp successfully loaded.


Command:
Command:
Command: TEST

Select objects: Specify opposite corner: 4560 found

Select objects:
._Layer
Current layer:  "TIN"
Enter an option [?/Make/Set/New/Rename/ON/OFF/Color/Ltype/LWeight/TRansparency/MATerial/Plot/Freeze/Thaw/LOck/Unlock/stAte/Description/rEconcile]: _Thaw
Enter name list of layer(s) to thaw: TIN Enter an option [?/Make/Set/New/Rename/ON/OFF/Color/Ltype/LWeight/TRansparency/MATerial/Plot/Freeze/Thaw/LOck/Unlock/stAte/Description/rEconcile]: _On
Enter name list of layer(s) to turn on: TIN Enter an option [?/Make/Set/New/Rename/ON/OFF/Color/Ltype/LWeight/TRansparency/MATerial/Plot/Freeze/Thaw/LOck/Unlock/stAte/Description/rEconcile]: _UnLock
Enter name list of layer(s) to unlock or <select objects>: TIN Enter an option [?/Make/Set/New/Rename/ON/OFF/Color/Ltype/LWeight/TRansparency/MATerial/Plot/Freeze/Thaw/LOck/Unlock/stAte/Description/rEconcile]:
Command:
     TIN - Elapsed time: 4.0250 secs, 3293 3DFACES
     Constraints - Elapsed time: 16.0830 secs.-1



Title: Re: Triangulation (re-visited)
Post by: ymg on June 16, 2014, 01:43:10 PM
XXL66.

cdtl contains vertices.

No matter what sooner or later you have to get the point
in order to compute circumcircle.

I told you before that el is a viable alternative to nl,
actually this is the way that contour operates.

I don't pretend to know it all, but the fact remain that
we now have something tjhat works.

Now you don't like it,  so be it.

ymg
Title: Re: Triangulation (re-visited)
Post by: XXL66 on June 17, 2014, 02:10:37 AM
I thought the whole idea of this forum was share ideas and thoughts to improve software.  When i suggest an idea that improves speed 25x times you don't like it, so be it.
Title: Re: Triangulation (re-visited)
Post by: ymg on June 17, 2014, 12:21:59 PM
XXL66,

I am open to ideas.  However I have told you many times
that despite looking for a way to do it, I could not achieve it
inline with the actual triangulation.

Went even so far as implementing another one which turns
out to be too slow.

Now going in the forum with an example of 20,000 points
and 458 constraints to show that it is slow is not sharing ideas.
It is simply, stating the obvious and in a rude way.

Rebuilding nl for each constraint is where all the time is consumed.

I also told you that I was concentrating on trying to get this one
going and then optimize.

Your suggestions, so far, is always throw everything and restart
leaves us with nothing.  Furthermore you have not demonstrated
that it is doable.

There are a zillion things that need to be ameliorated as it is.
Case in point we need to add a command to input constraints,
need to clean-up the whole program, need to address the issue
of boundaries and holes.  Layers handling is a mess etc. etc.

ymg



Title: Re: Triangulation (re-visited)
Post by: XXL66 on June 17, 2014, 03:00:39 PM
I posted code examples and ideas. It is doable. 6000 pts with 500 constraints in less then 3 seconds now and still room for code optimization. But i created my own method and do not use the algo you use. No need to recalc el and/or nl list.
Title: Re: Triangulation (re-visited)
Post by: ymg on June 17, 2014, 05:01:00 PM
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
Title: Re: Triangulation (re-visited)
Post by: XXL66 on June 18, 2014, 02:43:56 AM
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))
Title: Re: Triangulation (re-visited)
Post by: motee-z on June 18, 2014, 07:15:01 AM
Great job had be done thanks ymg
would you please add chainage start for profile because it always gives zero
Title: Re: Triangulation (re-visited)
Post by: XXL66 on June 18, 2014, 07:46:04 AM
Discovered a bug when using 'rectangular' contraints. Sorting goes wrong in specifc cases.
Title: Re: Triangulation (re-visited)
Post by: ymg on June 18, 2014, 11:20:13 AM
motee-z

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

ymg
Title: Re: Triangulation (re-visited)
Post by: ymg on June 18, 2014, 11:29:53 AM
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
Title: Re: Triangulation (re-visited)
Post by: ymg on June 18, 2014, 11:35:12 AM
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))


Title: Re: Triangulation (re-visited)
Post by: ymg on June 18, 2014, 02:27:14 PM
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
)


Title: Re: Triangulation (re-visited)
Post by: ymg on June 18, 2014, 03:56:53 PM
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
Title: Re: Triangulation (re-visited)
Post by: motee-z on June 18, 2014, 06:15:49 PM

































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   








Title: Re: Triangulation (re-visited)
Post by: ymg on June 18, 2014, 06:36:02 PM
Quote
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
Title: Re: Triangulation (re-visited)
Post by: motee-z on June 18, 2014, 08:09:14 PM
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
Title: Re: Triangulation (re-visited)
Post by: ymg on June 18, 2014, 08:26:58 PM
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
Title: Re: Triangulation (re-visited)
Post by: ymg on June 18, 2014, 10:54:12 PM
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|:

Quote
     TIN - Elapsed time: 3.4470 secs, 3909 3DFACES
     CDT V0.6.0 - Elapsed time: 11.7000 secs, 1941 Constraints
Title: Re: Triangulation (re-visited)
Post by: XXL66 on June 19, 2014, 01:07:03 AM
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)


Title: Re: Triangulation (re-visited)
Post by: XXL66 on June 19, 2014, 02:46:09 AM
I'm have a problem with this example dwg
When using lines you get multiple point definitions and the sorting seems to go wrong.


(((1058.56 1136.88 5.35))
((1058.56 1136.88 5.35) 3)
((1058.95 1137.71 5.35))
((1058.95 1137.71 5.35) 4)
((1060.88 1136.68 5.5))
((1060.88 1136.68 5.5) 0)
((1060.88 1137.85 5.5))
((1060.88 1137.85 5.5) 1)
((1061.13 1137.71 5.35) 2)
((1061.13 1136.88 5.35))
((1061.13 1136.88 5.35) 3)
((1061.13 1136.88 5.35) 2)
((1061.13 1136.88 5.35) 0)
((1061.13 1137.71 5.35))
((1061.13 1137.71 5.35) 4)
((1061.13 1137.71 5.35) 1))

I tried it also with your lastest TIN version and this also has of course the same sorting.
There seem to be 7 pts in pl although there should only be 6.

Command: !pl
((1058.56 1136.88 5.35) (1058.95 1137.71 5.35) (1060.88 1136.68 5.5) (1060.88 1137.85 5.5) (1061.13 1137.71 5.35) (1061.13 1136.88 5.35) (1061.13 1137.71 5.35))
Command: !cdtl
((1 6) (4 0) (4 5) (3 6) (2 5))

I tried different sorting alternatives but none seem to work, removing the duplicates first for me is not an option (because of the constraint indices added in the list).

Title: Re: Triangulation (re-visited)
Post by: XXL66 on June 19, 2014, 02:56:38 AM
Code: [Select]
 
(setq pl (vl-sort pl
  '(lambda (x y)
     (cond
       ((equal (car (car x)) (car (car y)) 0.001)
(< (cadr (car x)) (cadr (car y)))
       )
       ((< (car (car x)) (car (car y))))
     )
   )
)
)

adding a fuzz to the sort seems to solve it
Title: Re: Triangulation (re-visited)
Post by: pedroantonio on June 19, 2014, 10:11:39 AM
nice job ymg. Can you  modified so that Points Natural Ground remain on their original layer ?

Thanks
Title: Re: Triangulation (re-visited)
Post by: ymg on June 19, 2014, 10:21:59 AM
topographer,

Just remove or rem out this line at beginning of program.

Code: [Select]
(entmod (subst (cons 8 ptlay) (assoc 8 ent) ent))

As I said the layer handling is not proper as it is.
Not sure how to go about it, the goal being to be
able to have more than one TIN per drawing and
do volumetry.

ymg
Title: Re: Triangulation (re-visited)
Post by: motee-z on August 21, 2014, 03:00:15 PM
Long time not hear from ymg about developing triangulation
Title: Re: Triangulation (re-visited)
Post by: pedroantonio on August 25, 2014, 05:12:45 AM
Any news about Profile Along An Alignment ;
Title: Re: Triangulation (re-visited)
Post by: d2010 on August 25, 2014, 06:51:45 AM
Didge;
I have used this library:
http://www.cs.cmu.edu/~quake/triangle.html
But it is to be use with your C++ solutions.   :-(
You can transform C++ script,  or C C++ algorithms ,into autolisp-source-automatically.
Have fun ,you with youtube==
www.youtube.com/watch?v=91mwgtNSIrE (http://www.youtube.com/watch?v=91mwgtNSIrE)
 :roll:
Our  compilator.EXE can transform C++ to autolisp and reverse, lsp2cpp
Downloading  the full version, from:
http://lisp2arx.3xforum.ro/post/22/1/DOWNLOADING_vlacompilator_Here_/ (http://lisp2arx.3xforum.ro/post/22/1/DOWNLOADING_vlacompilator_Here_/)
You make user-account, and you  click again...on blue-blue-string...
Full tested in WindowsXP.
Best Regards..
Title: Re: Triangulation (re-visited)
Post by: ymg on August 26, 2014, 11:38:32 AM
Quote
Long time not hear from ymg about developing triangulation

Been on vacation and will remain at it until October.

Till then not much progress to expect.

ymg
Title: Re: Triangulation (re-visited)
Post by: CAB on August 26, 2014, 02:57:58 PM
Enjoy your time off.
Title: Re: Triangulation (re-visited)
Post by: snownut2 on August 26, 2014, 03:57:29 PM
Enjoy your time off.

X2
Title: Re: Triangulation (re-visited)
Post by: lamarn on August 27, 2014, 04:55:03 AM
To make TIN surfaces for walls i need to 3D rotate point temporary. see jpg
Would it be possible to make the function work with the local UCS (wall view) set.
I noticed some trans functions convert it to WCS.
Thanks in regard
Hans
Title: Re: Triangulation (re-visited)
Post by: lamarn on August 29, 2014, 03:56:05 AM
I am breaking my head to re-write this code so this works in user UCS.
There is something thats fixes the TIN to be created in WCS. What could it be?
Would like a achieve likewise code so i I do have to rotate3D the point to get right results..


Code: [Select]
;******************************************************************;
; TRIANGULATE - Lisp command to create a TIN from 3D points.       ;
; ===========                                                      ;
;                                                                  ;
; Written by Daniele Piazza, ADN member Mechanical Solution s.r.l. ;
; http://pdcode.com/code.htm                                       ;
;                                                                  ;
; Original C coding "Triangulate"  written by PAUL BOURKE          ;
; http://astronomy.swin.edu.au/~pbourke/modelling/triangulate/     ;
;                                                                  ;
; This program triangulates an irregular set of points.            ;
; You can replace some code (sorting, list manipulation,...) with  ;
; VLisp functions to reduce the execution time.                    ;
;                                                                  ;
; This code is not seriously tested, if you find a bug...sorry!!   ;
; Goodbye, Daniele                                                 ;
;*******************************************************************
;
;;
;;  Changes by CAB 03/13/06
;;  replaced the GETCIRCIRCUMCIRCLE routine
;;
(defun C:TRIANGULATE (/ fuzzy nulllist ss1 ptlst nv supertriangle trianglelst i j k edgelst
                        circle pt flag perc)

(setq OLDCMD (getvar "CMDECHO"))
(setvar "CMDECHO" 0)
(command ".UNDO" "GROUP")
(setq OLDSNAP (getvar "OSMODE"))
(setvar "OSMODE" 0)
(setq fuzzy 1e-8)   ; tolerance in equality test
(setq nulllist nil)
 
(princ "\nSelect points...")
(setq ss1 (ssget '((0 . "POINT"))))
(setq start (getvar "date") THINK-CNT 0)            ; initiate timer & Progress Spinner Counter
(setq ptlst (getptlist ss1))                        ; convert selection set to point list
(setq ptlst (xsort ptlst))                          ; sort point list by X co-ordinate
(setq nv (length ptlst))      ; number of points
(setq supertriangle (findsupertriangle ptlst))      ; find super triangle
(setq ptlst (append ptlst supertriangle))      ; append coordinates to the end of vertex list
(setq trianglelst (list (list supertriangle nil)))  ; add supertriangle to the triangle list

(setq i 0)
(setq cab 0) ; CAB debug
(while (< i nv)
   (THINKING (strcat "Processing TIN - " (itoa (/ (* i 100) nv)) "%    "))  ; update progress spinner
   (setq pt (nth i ptlst))
   (setq edgelst nil)                                ; initialize edge buffer
   (setq j 0)
   (while (and trianglelst (setq triangle (car (nth j trianglelst))))
     (setq flag T)
     (if (not (cadr (nth j trianglelst)))
       (progn
         (setq circle (getcircircumcircle triangle))       ; calculate circumcircle   
(if (< (+ (caar circle) (cadr circle)) (car pt))  ; test point x and (pt) location
   (setq trianglelst (nth_subst j (list (car (nth j trianglelst)) T) trianglelst))
)
(if (isinside pt circle)
   (setq edgelst     (addtriangleedges triangle edgelst)
trianglelst (nth_del j trianglelst)
flag      nil
   )
)
       ) ; end progn
     )   ; end if
     (if flag (setq j (1+ j)) )
   ) ; end while loop
   (setq edgelst (removedoublyedges edgelst fuzzy nulllist))           ; remove all doubly specified edges
   (setq trianglelst (addnewtriangles pt edgelst trianglelst))         ; form new triangles for current point
   (setq i (1+ i))                                                     ; get next vertex
) ; end while loop
(setq trianglelst (purgetrianglelst trianglelst supertriangle fuzzy)) ; remove triangles with supertriangles edges

(foreach triangle (mapcar 'car trianglelst)                           ; draw triangles
   (drawtriangle triangle)
)

(setvar "OSMODE" OLDSNAP)
(setq OLDSNAP nil)
(command ".UNDO" "END")
(setq stop (getvar "date"))
(princ (strcat "\r TIN Complete - Elapsed time: " (rtos (* 86400.0 (- stop start)) 2 2) " secs."))
(setvar "CMDECHO" OLDCMD) 
(princ)
)



; XSORT - Original Shell Sort function replaced with VLISP sort (much quicker :-)  ;
;                                                                                        ;
(defun XSORT ( PTLST /)
  (vl-sort PTLST (function (lambda (e1 e2) (< (car e1) (car e2)) ) ) )
)

; NTH_DEL ;
; ;
; delete the n item in the list (by position, not by value!!) ;
; ;
; Elimina l'oggetto che si trova nella posizione N della lista LST. L'utilizzo di ;
; funzioni ricorsive,oltre a non assicurare maggiore velocità, può creare problemi;
; di overflow dello stack in caso di liste molto lunghe. ;
(defun NTH_DEL (N LST / l)
(repeat n
  (setq l (cons (car lst) l)
lst (cdr lst)
  )
)
(append (reverse l)(cdr lst))
)

; NTH_SUBST ;
; ;
; Replace the index element in the list with new element. This function is ;
; recursive this is not a great solution with a large amount of data. ;
; ;
(defun NTH_SUBST (index new Alist)
(cond
  ((minusp index) Alist)
  ((zerop index)(cons new (cdr Alist)))
  (T (cons (car Alist)(nth_subst (1- index) new (cdr Alist))))
)
)

; GETPTLIST ;
; ;
; sset -> list (p1 p2 p3 ... pn) ;
; ;
(defun GETPTLIST (ss1 / i pt ptlst)
(if (not (zerop (sslength ss1)))
  (progn
   (setq i 0)
   (while
     (setq pt (ssname ss1 i))
     (setq ptlst (cons (cdr (assoc 10 (entget pt))) ptlst))
     (setq i (1+ i))
   )
  )
)
ptlst
)

; FINDSUPERTRIANGLE ;
; ;
; Search the supertriangle that contain all points in the data set ;
; ;
(defun FINDSUPERTRIANGLE (ptlst / xmax xmin ymax ymin dx dy dmax xmid ymid
          trx1 trx2 trx3 try1 try2 try3 trz1 trz2 trz3
)
(setq xmax (apply 'max (mapcar 'car ptlst))
       xmin (apply 'min (mapcar 'car ptlst))
       ymax (apply 'max (mapcar 'cadr ptlst))
       ymin (apply 'min (mapcar 'cadr ptlst))
       dx (- xmax xmin)
       dy (- ymax ymin)
       dmax (max dx dy)
       xmid (* (+ xmax xmin) 0.5)
       ymid (* (+ ymax ymin) 0.5)
       trx1 (- xmid (* dmax 2.0))
       try1 (- ymid dmax)
       trz1 0.0
       trx2 xmid
       try2 (+ ymid dmax)
       trz2 0.0
       trx3 (+ xmid (* dmax 2.0))
       try3 (- ymid dmax)
       trz3 0.0       
)
(list (list trx1 try1 trz1)
       (list trx2 try2 trz2)
       (list trx3 try3 trz3)
)
)




;;=============================================================
;;  Changes by CAB 03/13/06
;;  replaced the GETCIRCIRCUMCIRCLE routine
;;=============================================================

(defun getcircircumcircle (triangle / p1 p2 p3 pr1 pr2 cen rad bisector)
  ;;  return a pt list for a perpendicular bisector 20 units long
  (defun bisector (p1 p2 / perp_ang midpt)
    (setq p1       (list (car p1) (cadr p1)) ; make sure 2d point
          perp_ang (+ (angle p1 p2) (/ pi 2.0))) ; perpendicular angle
    (setq midpt (mapcar '(lambda (pa pb) (+ (/ (- pb pa) 2.0) pa)) p1 p2))
    (list (polar midpt perp_ang 10) (polar midpt (+ pi perp_ang) 10))
  )
  (setq p1  (car triangle)
        p2  (cadr triangle)
        p3  (caddr triangle)
        pr1 (bisector p1 p2)
        pr2 (bisector p1 p3)
        cen (inters (car pr1) (cadr pr1) (car pr2) (cadr pr2) nil)
        rad (distance cen p1)
  )
  (list cen rad)
)
;;=============================================================



; ISINSIDE ;
; ;
; test if pt is inside a circle ;
; ;
(defun ISINSIDE (pt circle)
(setq ctr (car circle)
       rad (cadr circle)
)
(< (distance pt ctr) rad)
)

; ADDTRIANGLEEDGES ;
; ;
; add triangle edges at the edge queue ;
; ;
(defun ADDTRIANGLEEDGES (triangle edgelst)
(append edgelst (list (list (car triangle)  (cadr triangle))
                       (list (cadr triangle) (caddr triangle))
                       (list (caddr triangle)(car triangle))
                 )
)
)

; DRAWTRIANGLE ;
; ;
; the fun side of the algorithm. Draw triangulation. ;
; ;
(defun DRAWTRIANGLE (triangle)
  (entmake (list (cons 0 "3DFACE") (cons 10 (car triangle))  (cons 11 (caddr triangle))
                                   (cons 12 (cadr triangle)) (cons 13 (cadr triangle))))
)

; EQUALMEMBER ;
; ;
; Check if "item" is in "lista" or not by equality test. With real number the ;
; standard fuction "member" not work correctly. ;
; ;
(defun EQUALMEMBER (item lista fuzzy /)
(apply 'or (mapcar '(lambda (x) (equal x item fuzzy)) lista))
)         

; REMOVEDOUBLYEDGES ;
; ;
; Test the edge queue to remove duplicates (warning CW & CCW!) ;
; ;
(defun REMOVEDOUBLYEDGES (edgelst fuzzy nulllist /)
(setq j 0)
(while (< j (length edgelst))
  (setq k (1+ j))
  (while (< k (length edgelst))
   (if
    (or (and (equal (car  (nth j edgelst)) (car  (nth k edgelst)) fuzzy)
             (equal (cadr (nth j edgelst)) (cadr (nth k edgelst)) fuzzy)
        )
        (and (equal (car  (nth j edgelst)) (cadr (nth k edgelst)) fuzzy)
             (equal (cadr (nth j edgelst)) (car  (nth k edgelst)) fuzzy)
        )
    )
    (setq edgelst (nth_subst j nulllist edgelst)
          edgelst (nth_subst k nulllist edgelst)
    )
   )
   (setq k (1+ k))
  )
  (setq j (1+ j))
)
edgelst
)

; ADDNEWTRIANGLES ;
; ;
; Add new triangle generated by pt to triangle list. ;
; ;
(defun ADDNEWTRIANGLES (pt edgelst trianglelst / j triangle )
(setq j 0)
(while (< j (length edgelst))
  (if (nth j edgelst)
   (setq triangle    (cons pt (nth j edgelst))
         trianglelst (cons (list triangle nil) trianglelst)
   )
  )
  (setq j (1+ j))
)
trianglelst
)

; PURGETRIANGLELST ;
; ;
; replace all triangles that share a vertex with supertriangle ;
; ;
(defun PURGETRIANGLELST (trianglelst supertriangle fuzzy /)
(setq j 0)
(while (and trianglelst (setq triangle (car (nth j trianglelst))))
  (if (apply 'or
             (mapcar '(lambda (x) (equalmember x supertriangle fuzzy))
                     triangle
             )
      )
   (setq trianglelst (nth_del j trianglelst))
   (setq j (1+ j))
  )
)
)


;                                       ;
; THINKING - STANDARD PROGRESS SPINNER  ;
;                                       ;
(defun THINKING (prmpt)
  (setq THINK-CNT (1+ THINK-CNT))
  (princ (strcat "\r" (nth (rem THINK-CNT 4) '("\|" "\/" "\-" "\\")) prmpt))
)


; ********************************* END OF CODING *******************************************
(princ "\n'TRIANGULATE' Loaded \n")
(princ)

Title: Re: Triangulation (re-visited)
Post by: RAYAKMAL on September 12, 2014, 09:19:55 AM
I modified C:Prof to C:Sect.
What I was trying to accomplish is to create a sectioning function using available codes

Code - Auto/Visual Lisp: [Select]
  1. (defun c:Sect ( )
  2.    (prompt "\nSelect a Linear Entity: ")
  3.    (if (setq ent (entsel "\n. Select Line: "))
  4.       (progn        
  5.          (setq enm  (car ent))    
  6.          (setq dtot (vlax-curve-getDistAtPoint enm (vlax-curve-getEndPoint enm)))
  7.          (setq tn nil)
  8.          (setq ss   (ssget "_X" '((0 . "3DFACE"))))
  9.          (get_tin ss) ;; Output from get_tin: PL & TL (Global variables)        
  10.          (setq nl (get_neighbour tl))
  11.  
  12.          (setq  pobj (vlax-ename->vla-object enm)            
  13.                 prof nil          
  14.          )
  15.          (setq i (+ (vlax-curve-getEndParam enm) 1))
  16.  
  17.          (while (setq p (vlax-curve-getPointAtParam enm (setq i (1- i))))
  18.             (setq tn (triloc p pl tl nl)
  19.                   tr (nth tn tl)
  20.                   t1 (nth (car tr) pl)
  21.                   t2 (nth (cadr tr) pl)
  22.                   t3 (nth (caddr tr) pl)
  23.                   prof (cons (list (vlax-curve-getDistAtPoint enm p)
  24.                                    (caddr (getz p t1 t2 t3))
  25.                              )
  26.                              prof
  27.                        )
  28.             )
  29.          )
  30.          (setq p0 (vlax-curve-getStartPoint enm)
  31.                tn (triloc p0 pl tl nl)    tr (nth tn tl)
  32.                t1 (nth (car tr) pl) t2 (nth (cadr tr) pl) t3 (nth (caddr tr) pl)
  33.              dist 0.0
  34.            lastd 0.0
  35.             dtot (vlax-curve-getDistAtPoint enm (vlax-curve-getEndPoint enm))          
  36.           found t
  37.          )
  38.          (while (and (< dist dtot) found)
  39.             (setq tn (triloc p0 pl tl nl)
  40.                   tr (nth tn tl)
  41.                   t1 (nth (car tr) pl)
  42.                   t2 (nth (cadr tr) pl)
  43.                   t3 (nth (caddr tr) pl)
  44.                   el (list (list t1 t2) (list t2 t3) (list t3 t1))
  45.                found nil
  46.              )    
  47.             (foreach lin el        
  48.                (if (setq p1 (car (intersections (setq linobj (mk_lwp lin)) pobj)))
  49.                  (progn
  50.                    (setq dist (vlax-curve-getDistAtPoint enm p1))
  51.                       (if (> dist lastd)
  52.                         (setq  prof (cons (list dist (caddr (getz p1 t1 t2 t3))) prof)
  53.                                p0 (vlax-curve-getPointAtDist enm (+ dist 0.05))
  54.                                lastd dist
  55.                                found t                                
  56.                         )                      
  57.                       )                  
  58.                    )              
  59.                  )  
  60.                  (entdel (entlast))
  61.               )      
  62.            )
  63.            (setq prof (vl-sort prof (function (lambda (a b) (< (car a) (car b))))))
  64.            ;; Var prof now contains the list of the profile sorted.                  ;
  65.       );end progn
  66.    );end if
  67. )
  68.  

It worked. But I think it's too slow for cross sectioning on a very long polyline.
I found it interesting, if I choose a LINE I will get a profile with vertexes every 1 unit on the section; if I choose a POLYLINE, profile will be generated only on vertexes. I don't have any idea why this happens.

I tried to change (setq ss   (ssget "_X" '((0 . "3DFACE")))) with this (setq ss (ssget "F" (list pt1 pt2) '((0 . "3DFACE")))) where pt1 and pt2 were defined as vertexes of a line, but it returned error: error: bad argument type: fixnump: nil

I meant, ssget is ok, but the error is on this code:

Code - Auto/Visual Lisp: [Select]
  1.            (while (setq p (vlax-curve-getPointAtParam enm (setq i (1- i))))
  2.               (setq tn (triloc p pl tl nl)
  3.                     tr (nth tn tl)
  4.                     t1 (nth (car tr) pl)
  5.                     t2 (nth (cadr tr) pl)
  6.                     t3 (nth (caddr tr) pl)
  7.                     prof (cons (list (vlax-curve-getDistAtPoint enm p) (caddr (getz p t1 t2 t3))) prof)
  8.               )
  9.            )
  10.  

(vlax-curve-getPointAtParam enm (setq i (1- i))) <<<< This returned nil

Any idea how to fix this error?
Thanks in advance

Title: Re: Triangulation (re-visited)
Post by: lamarn on September 12, 2014, 10:49:02 AM
Error: no function definition: GET_NEIGHBOUR
Missing function?
Title: Re: Triangulation (re-visited)
Post by: RAYAKMAL on September 12, 2014, 11:08:46 AM
Error: no function definition: GET_NEIGHBOUR
Missing function?

No. it's in TriangV0.5.9.LSP written by YMG
Title: Re: Triangulation (re-visited)
Post by: pedroantonio on October 02, 2014, 04:02:05 AM
Hi ymg I found an error with the breaklines. Can you fix it ?

Thanks
Title: Re: Triangulation (re-visited)
Post by: topograph on October 05, 2014, 05:47:30 AM
I think that lines on zero plane cannot be breaklines.
Try to connect points on your breaklines with 3dpolyline, it work perfect.
....
 In this drawing, check "BLOCK" option in TIN dialog
Title: Re: Triangulation (re-visited)
Post by: pedroantonio on October 05, 2014, 10:44:59 AM
Thank you topograph.
Title: Re: Triangulation (re-visited)
Post by: pedroantonio on December 05, 2014, 03:51:46 PM
Any news about Profile Along An Alignment ?
Title: Re: Triangulation (re-visited)
Post by: sanju2323 on December 15, 2014, 12:27:56 PM
hi, how to plot interpolate elevation grid using lisp.
Title: Re: Triangulation (re-visited)
Post by: ymg on December 15, 2014, 03:53:00 PM
sanju,

Don't know if it is a question , but assuming it is,
all you need to do is to give a starting coordinates
and a spacing then call getz in a loop.

ymg
Title: Re: Triangulation (re-visited)
Post by: ymg on December 15, 2014, 04:04:41 PM
Topographer,

I've done some more work on profile.

However I am still not set as to how we should define an alignment.

It could be a 3dpolyline with extended data to define the horizontal curves
the vertical curves, the spirals etc.

All this not entirely clear in my head.

As it is you can get the profile from a simple lwpolyline or a 3dpoly (Straigth Line Only)

ymg
Title: Re: Triangulation (re-visited)
Post by: sanju2323 on December 16, 2014, 11:34:26 AM
YMG sir,
        I need lisp to draw spot elevation at grid format.
Title: Re: Triangulation (re-visited)
Post by: ElpanovEvgeniy on December 17, 2014, 10:55:42 AM
hi, You can plot the surface of the 3d elevation grid using lisp.
Title: Re: Triangulation (re-visited)
Post by: ymg on December 17, 2014, 01:57:34 PM
Hi Evgenyi,

Assuming he has a break line in this zone, the triangulation
would be a Constrained Delaunay Triangulation. (CDT)

From sanju's sample drawing, he did not triangulate  and contour
it with your routine or my modifications of it.

We have not seen much of you lately, hope everything is fine.

How would you address the internal storage of alignment for profile ?

ymg

Title: Re: Triangulation (re-visited)
Post by: sanju2323 on December 17, 2014, 08:43:48 PM
First I think you are not turn on all layers of sample drawing.
Second I don't know how to calculate and plot to elevation grid via lisp.
Title: Re: Triangulation (re-visited)
Post by: RAYAKMAL on December 18, 2014, 10:30:16 PM
I found out on TriangV0.5.9A.LSP

The result of
Code: [Select]

(setq prof (cons (list (vlax-curve-getDistAtPoint en p) (caddr (getz p t1 t2 t3))) prof))


sometimes contains nil and crashes my program. I modified it and use this instead:

Code: [Select]
      (if (vlax-curve-getDistAtPoint en p)
        (setq prof (cons (list (vlax-curve-getDistAtPoint en p)
                               (caddr (getz p t1 t2 t3))
                         )
                    prof)
        )
      );end if

Title: Re: Triangulation (re-visited)
Post by: sanju2323 on December 18, 2014, 10:56:57 PM
RAYAKMAL sir,
    Please attach lisp TriangV0.5.9A.LSP If you made changes
Title: Re: Triangulation (re-visited)
Post by: RAYAKMAL on December 18, 2014, 11:39:30 PM
RAYAKMAL sir,
    Please attach lisp TriangV0.5.9A.LSP If you made changes

Sorry, I don't think I have a right to change anything. Probably what the other found is different than mine.
I just mentioned here in the forum, just in case someone use some of the codes from TriangV0.5.9A.LSP and found the same error.
Anyway, thank you for your suggestion.
Title: Re: Triangulation (re-visited)
Post by: sanju2323 on January 05, 2015, 03:04:36 AM
Profile From Contour Lines
Title: Re: Triangulation (re-visited)
Post by: pedroantonio on January 08, 2015, 04:05:47 AM
hI sanju2323. nice lisp for Profile. Do you have any lisp for crossections ?
Title: Re: Triangulation (re-visited)
Post by: pedroantonio on January 12, 2015, 04:41:18 AM
somethin like this

Title: Re: Triangulation (re-visited)
Post by: AARYAN on January 12, 2015, 12:36:30 PM
Hello ymg,

I have used your routine and found the results are very good.
But unfortunately it takes a long time of approx 90 secs to process 13000 points. If I remove the getneighbour function it reduces the process time but I doubt if I miss some important sort of things by removing this function. So I would request to please tell me what does this function do in the routine? Is it safe I remove it out or shall I wait for another version which may increase the speed.

Thanks for your help.
Title: Re: Triangulation (re-visited)
Post by: ymg on January 12, 2015, 05:02:38 PM
AARYAN,

You are pushing the enveloppe with a 130000 pts.

The function get_neighbour establish an array of pointers
to each neigbouring triangle.

It is used for profiling and voronoi.

If all you need is the triangulation, you could
do it without generating it.

ymg
Title: Re: Triangulation (re-visited)
Post by: AARYAN on January 12, 2015, 11:04:58 PM
ymg,

Thanks for your reply. BTW there are only 12628 points and the elapsed time is 82.7120 secs; 25156 3DFACES, but if I remove the function get _ neighbour the elapsed tine reduced to 30.5760 secs, 25156 3DFACES.

Regards
Title: Re: Triangulation (re-visited)
Post by: sanju2323 on January 13, 2015, 05:36:47 AM
Try this lisp
Title: Re: Triangulation (re-visited)
Post by: ymg on January 13, 2015, 09:04:08 AM
sanju2323, AARYAN,

Thanks for your upload of these profiling apps.

However, it is not a good idea to profile from contour
if you have a TIN. 

It does come handy if all you have are contour digitized
from a topographic maps.

I do have a way (unpublished yet) to do it without going
through get_neighbour.

Question: Which version are you using ?
                It should not be that slow with only 14000 pts.

ymg
               

Title: Re: Triangulation (re-visited)
Post by: AARYAN on January 13, 2015, 10:39:01 AM
Hello ymg

I am using Triangulation vs 0.5.9. Am I not using the latest one??
Please provide routine which is faster as you said if possible. BTW I am looking for triangulation lisp.

Thanks for your help.
Title: Re: Triangulation (re-visited)
Post by: ymg on January 13, 2015, 06:23:06 PM
AARYAN,

If you are not doing profile, simply remove
the (setq nl (get_neighbour tl)) at the end
of the triangulate routine.

I am at version 0.6.0, but not ready to publish.
Slow progress because I am traveling a lot
these days.

Other option to accelerate would be to compile
it into a vlx.

ymg
Title: Re: Triangulation (re-visited)
Post by: AARYAN on January 13, 2015, 08:53:31 PM
Thank you ymg, I am actually doing the same i.e removed the last line of get_neighbour function but not compiled the routine yet. I will do and post the result.

BTW most of the structure of Triangulation function is similar to Mr.Elpanov's routine then what makes it run slower?? Cant we modify the those portion to achieve the speed if possible?

Regards
Title: Re: Triangulation (re-visited)
Post by: ymg on January 13, 2015, 09:40:06 PM
AARYAN,

The triangulation portion is Evgenyi's code.

Only diffference is that there is code to remove possible duplicates and a section
to generate Voronoi's diagram.  There is also a section for breaklines.

So if you have no breaklines and are not generating Voronoi the speed
penalty is only the check for duplicates point.

ymg

Title: Re: Triangulation (re-visited)
Post by: AARYAN on January 13, 2015, 10:17:52 PM
Thank you for your quick reply and Yes I do not want to generate voronoi diagram but sometimes I may have breaklines. It would be great If you can edit the code to force the algorithm work only for Triangulation then I think i may get what I need.

I must say your contour routine is truly amazing and highly appreciable.

Regards
Title: Re: Triangulation (re-visited)
Post by: pedroantonio on January 16, 2015, 10:56:47 AM
Hi sanju2323 i know quick profile lisp but is not what i am looking for.
I  want a lisp for cross section like the upload photo (with center Alignmet)
Title: Re: Triangulation (re-visited)
Post by: sanju2323 on January 17, 2015, 07:28:15 AM
Topographer,
Complete Solution In This Program Please try to Cadtools Program http://www.glamsen.se/CadTools.htm (http://www.glamsen.se/CadTools.htm)
Title: Re: Triangulation (re-visited)
Post by: sanju2323 on January 17, 2015, 07:37:47 AM
ymg,
 You can generate profiles from 3d polyline? If you have any lisp.
Title: Re: Triangulation (re-visited)
Post by: pedroantonio on January 17, 2015, 12:02:00 PM
I have  1.txt file with cross section details
I draw the section in the test.dwg

Can any one have a lisp to select the polyline and write the destanse and the elevetion ander the datum line?
Title: Re: Triangulation (re-visited)
Post by: pedroantonio on January 21, 2015, 05:30:53 AM
Hi ymg.Is it possible to update your code

1) Identify oasis
2)select a boudary and delete all the TINS out of it. (i have seen your boudary command with +,- keys but is not all the times correct)

thanks
Title: Re: Triangulation (re-visited)
Post by: sanju2323 on January 29, 2015, 06:58:27 AM
hello ymg sir, can you upgrade your in your tin lisp to calculate CUTTING FILLING Area from. 3DFACE
Title: Re: Triangulation (re-visited)
Post by: AARYAN on February 12, 2015, 10:59:21 PM
Hello ymg,

Please upgrade the program to calculate Cut and Fill Quantity from 2 sets of 3dFaces.
Title: Re: Triangulation (re-visited)
Post by: lamarn on February 13, 2015, 03:47:43 AM
An other question and request.

Can anyone explain me why the triangulate routine by Elpanov Evgeniy only constructs faces in WCS (top view oriented) i would like to see it work on vertical elements as well (side view orientated). For use .xyz data of interiour work and constructions

Thanks in advance
Title: Re: Triangulation (re-visited)
Post by: ymg on February 13, 2015, 09:36:24 AM
Lammerts,

For this you would need a 3d triangulation.

This one is a so called 2.5d which means plan view with a z.

If you have data for a wall you could rotate it, do the tin and then rotate it back.

ymg
Title: Re: Triangulation (re-visited)
Post by: sanju2323 on February 13, 2015, 11:51:27 PM
YMG,
  This lisp to change tin direction of vertex
Title: Re: Triangulation (re-visited)
Post by: ymg on February 14, 2015, 01:26:36 PM
sanju,

Thanks! for the contribution.

However for something like a tunnel a 3d triangulation
would be needed.

Not sure I  want to tackle this in autolisp. :?

ymg
Title: Re: Triangulation (re-visited)
Post by: lamarn on February 14, 2015, 02:14:39 PM
Thank you for clarification ymg. I noticed i would need to rotate the model to get it done. Flipping the face is not needed, but thanks for this routine also
Title: Re: Triangulation (re-visited)
Post by: sanju2323 on February 16, 2015, 12:20:56 AM
ymg,
  i don't know what you need. but i get you lisp to different result from 3d face.
Title: Re: Triangulation (re-visited)
Post by: pedroantonio on February 20, 2015, 12:32:29 PM
Hi ymg.Can you add add an option to identify Boundary and oasis ? Dynamic Boundary is not all the time correct.
It's easyer to have an option select oasis (Y/N) and select boundary (Y/N) as close polylines

Thanks
Title: Re: Triangulation (re-visited)
Post by: ymg on February 20, 2015, 06:09:11 PM
topographer,

It certainly is possible.

However lately my interest has turned to some other problem.

So progress is kinda slow!

ymg
Title: Re: Triangulation (re-visited)
Post by: sanju2323 on March 17, 2015, 06:00:27 AM
Why is forgotten in this topic. Think of something new
Title: Re: Triangulation (re-visited)
Post by: ribarm on March 26, 2015, 12:08:27 PM
Hi all...

Recently, I've tried to understand EE's main triangulation algorithm, so I've almost copied it entirely, changing only subfunction (getcircumcircle) and making it shorter - without unnecessary comments as ymg described it deeply... So what I did is replicate the code for my better understanding and learning... And now to my point... The main algorithm was developed according to insertion points from sorted point list by X axis... I tried to make my second version according to sorted point list by Y axis, and there was something wrong... I carefully changed every statement where it was needed to make it adapted for Y axis triangulation and by my observations and testing this variant failed to be consistent and functional like first X axis algorithm... Can someone see what I was missing, or this is some kind of bug in ACAD... I don't really know, but it would be nice if master Evgeniy or ymg could look into it... I've made comments where I thought it was desirable to describe what's difference between those 2 codes... I'll also attach my test DWG with points where one triangulation was done and where on other point clouds it's prepared for you to test and see why second algorithm is failing to produce the same result as first one...

Thanks for your attention and kind regards from me... Please if you see the trick shed some light - it will be beneficial for learning this very useful algorithm for all interested programmers...

First code - this one works fine :

Code - Auto/Visual Lisp: [Select]
  1. (defun c:triangulate-MR-EE-Xsort ( / triangulate ss i p pl tl )
  2.  
  3.   (defun triangulate ( pl / getcircumcircle xmin xmax ymin ymax cs pmin pmax t1 t2 t3 al p el tr l )
  4.  
  5.     (defun getcircumcircle ( p el / v^v mid circumcircle cp cr rr )
  6.        
  7.       (defun v^v ( u v )
  8.         (mapcar '(lambda ( s1 s2 a b ) (+ ((eval s1) (* (nth a u) (nth b v))) ((eval s2) (* (nth a v) (nth b u))))) '(+ - +) '(- + -) '(1 0 0) '(2 2 1))
  9.       )
  10.  
  11.       (defun mid ( p1 p2 )
  12.         (mapcar '(lambda ( a b ) (/ (+ a b) 2.0)) p1 p2)
  13.       )
  14.  
  15.       (defun circumcircle ( p1 p2 p3 / p12 p23 p31 c1 c2 c r )
  16.         (setq p12 (mid p1 p2))
  17.         (setq p23 (mid p2 p3))
  18.         (setq p31 (mid p3 p1))
  19.         (setq c1 (inters p12 (mapcar '+ p12 (v^v (mapcar '- p2 p1) '(0.0 0.0 1.0))) p23 (mapcar '+ p23 (v^v (mapcar '- p3 p2) '(0.0 0.0 1.0))) nil))
  20.         (setq c2 (inters p12 (mapcar '+ p12 (v^v (mapcar '- p2 p1) '(0.0 0.0 1.0))) p31 (mapcar '+ p31 (v^v (mapcar '- p3 p1) '(0.0 0.0 1.0))) nil))
  21.         (setq c (mid c1 c2))
  22.         (setq r (distance c p1))
  23.         (list (list (car c) (cadr c)) r)
  24.       )
  25.  
  26.       (setq cp (car (setq cr (circumcircle (list (car p) (cadr p) 0.0) (list (caar el) (cadar el) 0.0) (list (caadr el) (cadadr el) 0.0)))) rr (cadr cr))
  27.       (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 ;;;
  28.     )
  29.  
  30.     (setq xmin (caar (setq pl (vl-sort pl '(lambda ( a b ) (< (car a) (car b))))))) ;;; Sorted pl by X ;;;
  31.     (setq xmax (caar (vl-sort pl '(lambda ( a b ) (> (car a) (car b))))))
  32.     (setq ymin (cadar (vl-sort pl '(lambda ( a b ) (< (cadr a) (cadr b))))))
  33.     (setq ymax (cadar (vl-sort pl '(lambda ( a b ) (> (cadr a) (cadr b))))))
  34.     (setq cs (list (+ xmin (/ (- xmax xmin) 2.0)) (+ ymin (/ (- ymax ymin) 2.0))))
  35.     (setq pmin (list xmin ymin) pmax (list xmax ymax))
  36.     (setq t1 (polar cs 0.0 (setq rs (* 4.0 (distance pmin cs))))) ;;; Added 0.0 in polar for rotating supertriangle t1 is max X apex ;;;
  37.     (setq t2 (polar cs (+ 0.0 (/ (* 2.0 pi) 3.0)) rs))
  38.     (setq t3 (polar cs (+ 0.0 (/ (* 4.0 pi) 3.0)) rs))
  39.     (setq al (list (list t1 cs rs (list t1 t2 t3))))
  40.     (while pl
  41.       (setq p (car pl))
  42.       (setq pl (cdr pl))
  43.       (setq el nil)
  44.       (while al
  45.         (setq tr (car al))
  46.         (setq al (cdr al))
  47.         (cond
  48.           ( (< (caar tr) (car p)) ;;; Comparison of X values ;;;
  49.             (setq tl (cons (cadddr tr) tl))
  50.           )
  51.           ( (< (distance p (cadr tr)) (caddr tr))
  52.             (setq el (append (list
  53.                               (list (car (last tr)) (cadr (last tr)))
  54.                               (list (cadr (last tr)) (caddr (last tr)))
  55.                               (list (caddr (last tr)) (car (last tr)))
  56.                             ) el
  57.                     )
  58.             )
  59.           )
  60.           ( t (setq l (cons tr l)) )
  61.         )
  62.       )
  63.       (if l (setq al l l nil))
  64.       ;;; This sorting doesn't help ;;;
  65.       ;;; You can ommit this step ;;;
  66.       (setq el (vl-sort el '(lambda ( a b )
  67.                             (if (>= (caar a) (caar b))
  68.                               (< (caadr a) (caadr b))
  69.                               (< (caar a) (caar b))
  70.                             )
  71.                           )
  72.               )
  73.       )
  74.       ;;; End of comment - it work well with or without sorting ;;;
  75.       (while el
  76.         (if (or (member (reverse (car el)) el)
  77.                (member (car el) (cdr el))
  78.             )
  79.             (setq el (vl-remove (reverse (car el)) el)
  80.                   el (vl-remove (car el) el)
  81.             )
  82.             (setq al (cons (getcircumcircle p (car el)) al)
  83.                   el (cdr el)
  84.             )
  85.         )
  86.       )
  87.     )
  88.     (foreach tr al (setq tl (cons (cadddr tr) tl)))
  89.     (setq tl (vl-remove-if '(lambda ( x ) (or (member t1 x) (member t2 x) (member t3 x))) tl))
  90.   ) ;;; end of triangulate
  91.  
  92.   (setq ss (ssget '((0 . "POINT"))))
  93.   (repeat (setq i (sslength ss))
  94.     (setq p (cdr (assoc 10 (entget (ssname ss (setq i (1- i)))))))
  95.     (setq pl (cons p pl))
  96.   )
  97.   (triangulate pl)
  98.   (foreach trr tl
  99.     (entmake
  100.       (list (cons 0 "3DFACE")
  101.         (cons 10 (car trr))
  102.         (cons 11 (car trr))
  103.         (cons 12 (cadr trr))
  104.         (cons 13 (caddr trr))
  105.       )
  106.     )
  107.   )
  108.   (princ)
  109. )
  110.  

And the second corrected buggy one :

Code - Auto/Visual Lisp: [Select]
  1. (defun c:triangulate-MR-EE-Ysort ( / triangulate ss i p pl tl )
  2.  
  3.   (defun triangulate ( pl / getcircumcircle xmin xmax ymin ymax cs pmin pmax t1 t2 t3 al p el tr l )
  4.  
  5.     (defun getcircumcircle ( p el / v^v mid circumcircle cp cr rr )
  6.        
  7.       (defun v^v ( u v )
  8.         (mapcar '(lambda ( s1 s2 a b ) (+ ((eval s1) (* (nth a u) (nth b v))) ((eval s2) (* (nth a v) (nth b u))))) '(+ - +) '(- + -) '(1 0 0) '(2 2 1))
  9.       )
  10.  
  11.       (defun mid ( p1 p2 )
  12.         (mapcar '(lambda ( a b ) (/ (+ a b) 2.0)) p1 p2)
  13.       )
  14.  
  15.       (defun circumcircle ( p1 p2 p3 / p12 p23 p31 c1 c2 c r )
  16.         (setq p12 (mid p1 p2))
  17.         (setq p23 (mid p2 p3))
  18.         (setq p31 (mid p3 p1))
  19.         (setq c1 (inters p12 (mapcar '+ p12 (v^v (mapcar '- p2 p1) '(0.0 0.0 1.0))) p23 (mapcar '+ p23 (v^v (mapcar '- p3 p2) '(0.0 0.0 1.0))) nil))
  20.         (setq c2 (inters p12 (mapcar '+ p12 (v^v (mapcar '- p2 p1) '(0.0 0.0 1.0))) p31 (mapcar '+ p31 (v^v (mapcar '- p3 p1) '(0.0 0.0 1.0))) nil))
  21.         (setq c (mid c1 c2))
  22.         (setq r (distance c p1))
  23.         (list (list (car c) (cadr c)) r)
  24.       )
  25.  
  26.       (setq cp (car (setq cr (circumcircle (list (car p) (cadr p) 0.0) (list (caar el) (cadar el) 0.0) (list (caadr el) (cadadr el) 0.0)))) rr (cadr cr))
  27.       (list (mapcar '+ cp (list 0.0 rr)) cp rr (list p (car el) (cadr el))) ;;; Added Y apex of circumscribed triangle circle as first element of (getcircumcircle) output list ;;;
  28.     )
  29.  
  30.     (setq xmin (caar (vl-sort pl '(lambda ( a b ) (< (car a) (car b))))))
  31.     (setq xmax (caar (vl-sort pl '(lambda ( a b ) (> (car a) (car b))))))
  32.     (setq ymin (cadar (setq pl (vl-sort pl '(lambda ( a b ) (< (cadr a) (cadr b))))))) ;;; Sorted pl by Y ;;;
  33.     (setq ymax (cadar (vl-sort pl '(lambda ( a b ) (> (cadr a) (cadr b))))))
  34.     (setq cs (list (+ xmin (/ (- xmax xmin) 2.0)) (+ ymin (/ (- ymax ymin) 2.0))))
  35.     (setq pmin (list xmin ymin) pmax (list xmax ymax))
  36.     (setq t1 (polar cs (/ pi 2.0) (setq rs (* 4.0 (distance pmin cs))))) ;;; Added (/ pi 2.0) in polar for rotating supertriangle t1 is max Y apex ;;;
  37.     (setq t2 (polar cs (+ (/ pi 2.0) (/ (* 2.0 pi) 3.0)) rs))
  38.     (setq t3 (polar cs (+ (/ pi 2.0) (/ (* 4.0 pi) 3.0)) rs))
  39.     (setq al (list (list t1 cs rs (list t1 t2 t3))))
  40.     (while pl
  41.       (setq p (car pl))
  42.       (setq pl (cdr pl))
  43.       (setq el nil)
  44.       (while al
  45.         (setq tr (car al))
  46.         (setq al (cdr al))
  47.         (cond
  48.           ( (< (cadar tr) (cadr p)) ;;; Comparison of Y values ;;;
  49.             (setq tl (cons (cadddr tr) tl))
  50.           )
  51.           ( (< (distance p (cadr tr)) (caddr tr))
  52.             (setq el (append (list
  53.                               (list (car (last tr)) (cadr (last tr)))
  54.                               (list (cadr (last tr)) (caddr (last tr)))
  55.                               (list (caddr (last tr)) (car (last tr)))
  56.                             ) el
  57.                     )
  58.             )
  59.           )
  60.           ( t (setq l (cons tr l)) )
  61.         )
  62.       )
  63.       (if l (setq al l l nil))
  64.       ;;; This sorting doesn't help ;;;
  65.       ;;; You can ommit this step ;;;
  66.       (setq el (vl-sort el '(lambda ( a b )
  67.                             (if (>= (cadar a) (cadar b))
  68.                               (< (cadadr a) (cadadr b))
  69.                               (< (cadar a) (cadar b))
  70.                             )
  71.                           )
  72.               )
  73.       )
  74.       ;;; End of comment - it work well with or without sorting ;;;
  75.       (while el
  76.         (if (or (member (reverse (car el)) el)
  77.                (member (car el) (cdr el))
  78.             )
  79.             (setq el (vl-remove (reverse (car el)) el)
  80.                   el (vl-remove (car el) el)
  81.             )
  82.             (setq al (cons (getcircumcircle p (car el)) al)
  83.                   el (cdr el)
  84.             )
  85.         )
  86.       )
  87.     )
  88.     (foreach tr al (setq tl (cons (cadddr tr) tl)))
  89.     (setq tl (vl-remove-if '(lambda ( x ) (or (member t1 x) (member t2 x) (member t3 x))) tl))
  90.   ) ;;; end of triangulate
  91.  
  92.   (setq ss (ssget '((0 . "POINT"))))
  93.   (repeat (setq i (sslength ss))
  94.     (setq p (cdr (assoc 10 (entget (ssname ss (setq i (1- i)))))))
  95.     (setq pl (cons p pl))
  96.   )
  97.   (triangulate pl)
  98.   (foreach trr tl
  99.     (entmake
  100.       (list (cons 0 "3DFACE")
  101.         (cons 10 (car trr))
  102.         (cons 11 (car trr))
  103.         (cons 12 (cadr trr))
  104.         (cons 13 (caddr trr))
  105.       )
  106.     )
  107.   )
  108.   (princ)
  109. )
  110.  

I'll attach DWG for testing...
M.R.

[EDIT : Codes updated and fixed problem - thanks to mr. ymg for his observation...]
Title: Re: Triangulation (re-visited)
Post by: ymg on March 27, 2015, 04:56:08 AM
Marko,


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

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

ymg
Title: Re: Triangulation (re-visited)
Post by: ribarm on March 27, 2015, 06:19:53 AM
Marko,


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

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

ymg

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

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

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

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

It just don't work on my PCs...
Title: Re: Triangulation (re-visited)
Post by: ribarm on March 27, 2015, 06:31:31 AM
Oh, yes ymg, you're right...

Should be :

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

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

Thanks, M.R.
Title: Re: Triangulation (re-visited)
Post by: ymg on March 27, 2015, 06:33:40 AM
Marko,

I will look a little deeper.

The comparison value should be the maxY of the triangle.

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

ymg
Title: Re: Triangulation (re-visited)
Post by: ymg on March 27, 2015, 07:04:00 AM
Marko,

Glad, you could straighten the problem.

ymg
Title: Re: Triangulation (re-visited)
Post by: ribarm on March 27, 2015, 12:32:35 PM
Hi all...
Here is my combined version that will do correct triangulation satisfying both X and Y axises algorithms and all this for making correct Xmax and Ymax edge of point cloud triangulation - formed triangulation must satisfy condition of convex hull of point cloud... So what's left after triangulation in X axis - it's added with Y axis algorithm - Xmax edge is convex and opposite, what's left after triangulation in Y axis - it's added with X axis algorithm - Ymax edge is convex...

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

HTH, M.R.
Regards...
P.S. After all it seems that my efforts in learning triangulation was beneficial at least for my standards...
Title: Re: Triangulation (re-visited)
Post by: ribarm on March 27, 2015, 03:14:55 PM
I know this is now odd and slow, but it should handle the cases like this that I've attached...
BTW. Code is now bigger...

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

M.R.
Title: Re: Triangulation (re-visited)
Post by: ymg on March 27, 2015, 04:11:18 PM
Marko,

I do not understand!

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

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

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

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

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

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

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

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

  (defun circumcircleucs ( p1 p2 p3 / D Dcx Dcy c r )
    (setq D (* 4.0 (- (* (- (car p1) (car p2)) (- (cadr p1) (cadr p3))) (* (- (car p1) (car p3)) (- (cadr p1) (cadr p2))))))
    (setq Dcx (* 2.0 (-
                      (* (- (cadr p1) (cadr p3)) (+ (expt (car p1) 2) (expt (cadr p1) 2) (- (expt (car p2) 2)) (- (expt (cadr p2) 2))))
                      (* (- (cadr p1) (cadr p2)) (+ (expt (car p1) 2) (expt (cadr p1) 2) (- (expt (car p3) 2)) (- (expt (cadr p3) 2))))
                    )
             )
    )
    (setq Dcy (* 2.0 (-
                      (* (- (car p1) (car p2)) (+ (expt (car p1) 2) (expt (cadr p1) 2) (- (expt (car p3) 2)) (- (expt (cadr p3) 2))))
                      (* (- (car p1) (car p3)) (+ (expt (car p1) 2) (expt (cadr p1) 2) (- (expt (car p2) 2)) (- (expt (cadr p2) 2))))
                    )
             )
    )
    (setq c (list (/ Dcx D) (/ Dcy D)))
    (setq r (distance c p1))
    (list c r)
  )
 
  (setq zucs (v^v (mapcar '- p2 p1) (mapcar '- p3 p1)))
  (setq p1ucs (trans p1 0 zucs) p2ucs (trans p2 0 zucs) p3ucs (trans p3 0 zucs))
  (setq cr (circumcircleucs p1ucs p2ucs p3ucs))
  (list (trans (list (caar cr) (cadar cr) (caddr p1ucs)) zucs 0) (cadr cr))
)
Title: Re: Triangulation (re-visited)
Post by: ymg on March 27, 2015, 05:38:51 PM
Marko,

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

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

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

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

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

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

ymg

Title: Re: Triangulation (re-visited)
Post by: ribarm on March 27, 2015, 07:25:38 PM
Ok, ymg... I've replaced Evgeniy's (getcircumcircle) inside my code :
http://www.theswamp.org/index.php?topic=9042.msg542790#msg542790

It's now a little faster than before, but I think it's reliable enough in finding correct convex boundary triangulation... Still it has multiple calculations for step rotations of UCS by 15 degree and I've added fixed radius of supertriangle (if (setq n (atoi (substr (setq str (rtos (distance pmin cs) 1 0)) (- (strlen str) 2)))) (setq rs (expt 10.0 (+ n 2)))) which is big enough and satisfies the most cases for which (polar) function can obtain correct point coordinates... Yes final triangles are purged from supertriangle, but you can't for sure state that purging will leave convex shape... So this method is little slow, but I think that it's the best of two worlds - speed and reliability of getting correct convex result...
Title: Re: Triangulation (re-visited)
Post by: ymg on March 28, 2015, 05:36:51 PM
Marko,

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

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

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

ymg

Title: Re: Triangulation (re-visited)
Post by: pedroantonio on March 29, 2015, 02:55:03 AM
Any news about TriangV0.5.9A.lsp .Any updated version ?

Thanks
Title: Re: Triangulation (re-visited)
Post by: ymg on March 29, 2015, 07:13:13 AM
topographer,

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

ymg
Title: Re: Triangulation (re-visited)
Post by: ribarm on April 01, 2015, 10:53:53 AM
Marko,

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

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

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

ymg

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

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

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

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

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

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

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

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

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

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

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

  (setq ss (ssget '((0 . "POINT"))))
  (repeat (setq i (sslength ss))
    (setq p (cdr (assoc 10 (entget (ssname ss (setq i (1- i)))))))
    (setq pl (cons p pl))
  )
  (triangulate pl)
  (foreach tr tl
    (entmake
      (list (cons 0 "3DFACE")
        (cons 10 (car tr))
        (cons 11 (car tr))
        (cons 12 (cadr tr))
        (cons 13 (caddr tr))
      )
    )
  )
  (princ)
)
Title: Re: Triangulation (re-visited)
Post by: ymg on April 01, 2015, 01:08:37 PM
Marko,

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

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

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

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

ymg

Title: Re: Triangulation (re-visited)
Post by: ribarm on April 01, 2015, 02:01:03 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.
Title: Re: Triangulation (re-visited)
Post by: ymg 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
Title: Re: Triangulation (re-visited)
Post by: ribarm 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]
  1. (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 )
  2.  
  3.   (defun mid ( p1 p2 )
  4.     (mapcar '(lambda ( a b ) (/ (+ a b) 2.0)) p1 p2)
  5.   )
  6.  
  7.   ;; 3D to 2D point  -  M.R.
  8.   ;; Returns 2D point list from supplied 3D point list or returns supplied argument if it isn't 3D point list
  9.  
  10.   (defun 3D->2D ( p )
  11.       (if (and (listp p) (vl-every '(lambda ( x ) (eq (type x) 'REAL)) p) (eq (length p) 3))
  12.           (list (car p) (cadr p))
  13.           p
  14.       )
  15.   )
  16.  
  17.   ;; Collinear-p  -  M.R.
  18.   ;; Returns T if p1,p2,p3 are collinear
  19.  
  20.   (defun MR:Collinear-p ( p1 p2 p3 )
  21.       (equal  (distance p1 p3)
  22.               (+ (distance p1 p2) (distance p2 p3))
  23.           1e-8
  24.       )
  25.   )
  26.  
  27.   ;; Clockwise-p  -  Lee Mac
  28.   ;; Returns T if p1,p2,p3 are clockwise oriented or collinear
  29.  
  30.   (defun LM:Clockwise-p ( p1 p2 p3 )
  31.       (<  (-  (* (- (car  p2) (car  p1)) (- (cadr p3) (cadr p1)))
  32.               (* (- (cadr p2) (cadr p1)) (- (car  p3) (car  p1)))
  33.           )
  34.           1e-8
  35.       )
  36.   )
  37.  
  38.   ;; Convex Hull  -  Lee Mac
  39.   ;; Implements the Graham Scan Algorithm to return the Convex Hull of a list of points.
  40.    
  41.   (defun LM:ConvexHull ( lst / ch p0 )
  42.       (cond
  43.           (   (< (length lst) 4) lst)
  44.           (   (setq p0 (car lst))
  45.               (foreach p1 (cdr lst)
  46.                   (if (or (< (cadr p1) (cadr p0))
  47.                           (and (equal (cadr p1) (cadr p0) 1e-8) (< (car p1) (car p0)))
  48.                       )
  49.                       (setq p0 p1)
  50.                   )
  51.               )
  52.               (setq lst
  53.                   (vl-sort lst
  54.                       (function
  55.                           (lambda ( a b / c d )
  56.                               (if (equal (setq c (angle p0 a)) (setq d (angle p0 b)) 1e-8)
  57.                                   (< (distance p0 a) (distance p0 b))
  58.                                   (< (if (equal c (* 2.0 pi) 1e-8) 0.0 c) (if (equal d (* 2.0 pi) 1e-8) 0.0 d))
  59.                               )
  60.                           )
  61.                       )
  62.                   )
  63.               )
  64.               (setq ch (list (caddr lst) (cadr lst) (car lst)))
  65.               (foreach pt (cdddr lst)
  66.                   (setq ch (cons pt ch))
  67.                   (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))))
  68.                       (setq ch (cons pt (cddr ch)))
  69.                   )
  70.               )
  71.               ch
  72.           )
  73.       )
  74.   )
  75.  
  76.   (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 )
  77.  
  78.     (defun getcircumcircle ( p el / circumcircle cp cr rr )
  79.        
  80.       (defun circumcircle ( p1 p2 p3 / ang c r )
  81.         (if
  82.           (not
  83.             (zerop
  84.               (setq ang (- (angle p2 p3) (angle p2 p1)))
  85.             )
  86.           )
  87.           (setq c (polar p3 (+ -1.570796326794896 (angle p3 p1) ang) (setq r (/ (distance p1 p3) (sin ang) 2.0)))
  88.                r (abs r)
  89.           )
  90.         )
  91.         (list c r)
  92.       )
  93.  
  94.       (setq cp (car (setq cr (circumcircle (3D->2D p) (3D->2D (car el)) (3D->2D (cadr el))))) rr (cadr cr))
  95.       (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 ;;;
  96.     )
  97.  
  98.     (setq pll pl)
  99.     (setq xmin (caar (setq pl (vl-sort pl '(lambda ( a b ) (< (car a) (car b))))))) ;;; Sorted pl by X ;;;
  100.     (setq xmax (caar (vl-sort pl '(lambda ( a b ) (> (car a) (car b))))))
  101.     (setq ymin (cadar (vl-sort pl '(lambda ( a b ) (< (cadr a) (cadr b))))))
  102.     (setq ymax (cadar (vl-sort pl '(lambda ( a b ) (> (cadr a) (cadr b))))))
  103.     (setq cs (list (+ xmin (/ (- xmax xmin) 2.0)) (+ ymin (/ (- ymax ymin) 2.0))))
  104.     (setq pmin (list xmin ymin) pmax (list xmax ymax))
  105.     (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 ;;;
  106.     ;;(setq t1 (polar cs 0.0 (setq rs (* 2.0 factor (distance pmin cs)))))
  107.     (setq t2 (polar cs (+ 0.0 (/ (* 2.0 pi) 3.0)) rs))
  108.     (setq t3 (polar cs (+ 0.0 (/ (* 4.0 pi) 3.0)) rs))
  109.     (setq al (list (list t1 cs rs (list t1 t2 t3))))
  110.     (while pl
  111.       (setq p (car pl))
  112.       (setq pl (cdr pl))
  113.       (setq el nil)
  114.       (while al
  115.         (setq tr (car al))
  116.         (setq al (cdr al))
  117.         (cond
  118.           ( (< (caar tr) (car p)) ;;; Comparison of X values ;;;
  119.             (setq tl (cons (cadddr tr) tl))
  120.           )
  121.           ( (< (distance p (cadr tr)) (caddr tr))
  122.             (setq el (append (list
  123.                               (list (car (last tr)) (cadr (last tr)))
  124.                               (list (cadr (last tr)) (caddr (last tr)))
  125.                               (list (caddr (last tr)) (car (last tr)))
  126.                             ) el
  127.                     )
  128.             )
  129.           )
  130.           ( t (setq l (cons tr l)) )
  131.         )
  132.       )
  133.       (if l (setq al l l nil))
  134.       (while el
  135.         (if (or (member (reverse (car el)) el)
  136.                (member (car el) (cdr el))
  137.             )
  138.             (setq el (vl-remove (reverse (car el)) el)
  139.                   el (vl-remove (car el) el)
  140.             )
  141.             (setq al (cons (getcircumcircle p (car el)) al)
  142.                   el (cdr el)
  143.             )
  144.         )
  145.       )
  146.     )
  147.     (foreach tr al (setq tl (cons (cadddr tr) tl)))
  148.     (setq tl (vl-remove-if '(lambda ( x ) (or (member t1 x) (member t2 x) (member t3 x))) tl))
  149.     (setq pl pll)
  150.     (if (null ell)
  151.       (progn
  152.         (setq el (mapcar '(lambda ( a b ) (list a b)) (setq och (LM:ConvexHull pll)) (cdr (reverse (cons (car och) (reverse och))))))
  153.         (mapcar '(lambda ( x ) (setq pll (vl-remove x pll))) och)
  154.         (setq ich (LM:ConvexHull pll))
  155.       )
  156.     )
  157.     (if ich
  158.       (progn
  159.         (setq ell t)
  160.         (foreach e el
  161.           (if (not (vl-some '(lambda ( x ) (and (member (car e) x) (member (cadr e) x))) tl))
  162.             (progn
  163.               (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))))))))
  164.               (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))
  165.               (foreach p iche
  166.                 (if (or
  167.                       (and
  168.                         (vl-some '(lambda ( x ) (if (and (member (car e) x) (member p x)) (setq tr x))) tl)
  169.                         (vl-some '(lambda ( x ) (and (member (car e) x) (member p x))) (vl-remove tr tl))
  170.                       )
  171.                       (and
  172.                         (vl-some '(lambda ( x ) (if (and (member (cadr e) x) (member p x)) (setq tr x))) tl)
  173.                         (vl-some '(lambda ( x ) (and (member (cadr e) x) (member p x))) (vl-remove tr tl))
  174.                       )
  175.                     )
  176.                     (setq iche (vl-remove p iche))
  177.                 )
  178.               )
  179.               (setq i (length iche))
  180.               (setq iche (cons (car e) iche) iche (cons (cadr e) iche))
  181.               (if (null z)
  182.                 (setq z 10.0)
  183.               )
  184.               (setq z
  185.                 (cond
  186.                   ( (<= i (length (car (triangulate iche 10.0))))
  187.                     (if (>= z 10.0)
  188.                       z
  189.                       (setq z 10.0)
  190.                     )
  191.                   )
  192.                   ( (<= i (length (car (triangulate iche 25.0))))
  193.                     (if (>= z 25.0)
  194.                       z
  195.                       (setq z 25.0)
  196.                     )
  197.                   )
  198.                   ( (<= i (length (car (triangulate iche 50.0))))
  199.                     (if (>= z 50.0)
  200.                       z
  201.                       (setq z 50.0)
  202.                     )
  203.                   )
  204.                   ( (<= i (length (car (triangulate iche 100.0))))
  205.                     (if (>= z 100.0)
  206.                       z
  207.                       (setq z 100.0)
  208.                     )
  209.                   )
  210.                   ( (<= i (length (car (triangulate iche 250.0))))
  211.                     (if (>= z 250.0)
  212.                       z
  213.                       (setq z 250.0)
  214.                     )
  215.                   )
  216.                   ( (<= i (length (car (triangulate iche 500.0))))
  217.                     (if (>= z 500.0)
  218.                       z
  219.                       (setq z 500.0)
  220.                     )
  221.                   )
  222.                   ( (<= i (length (car (triangulate iche 1000.0))))
  223.                     (if (>= z 1000.0)
  224.                       z
  225.                       (setq z 1000.0)
  226.                     )
  227.                   )
  228.                 )
  229.               )
  230.             )
  231.           )
  232.         )
  233.       )
  234.     )
  235.     (list tl z)
  236.   ) ;;; end of triangulate
  237.  
  238.   (setq ss (ssget '((0 . "POINT"))))
  239.   (repeat (setq i (sslength ss))
  240.     (setq p (cdr (assoc 10 (entget (ssname ss (setq i (1- i)))))))
  241.     (setq pl (cons p pl))
  242.   )
  243.   (setq z (cadr (triangulate pl 10.0)))
  244.   (foreach tr (car (triangulate pl z))
  245.     (entmake
  246.       (list (cons 0 "3DFACE")
  247.         (cons 10 (car tr))
  248.         (cons 11 (car tr))
  249.         (cons 12 (cadr tr))
  250.         (cons 13 (caddr tr))
  251.       )
  252.     )
  253.   )
  254.   (princ)
  255. )
  256.  

 8-)
Title: Re: Triangulation (re-visited)
Post by: ribarm 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.
Title: Re: Triangulation (re-visited)
Post by: lamarn on April 02, 2015, 05:58:25 AM
Will do! Thanks..
Title: Re: Triangulation (re-visited)
Post by: lamarn 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
Title: Re: Triangulation (re-visited)
Post by: ribarm 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...
Title: Re: Triangulation (re-visited)
Post by: ribarm 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...
Title: Re: Triangulation (re-visited)
Post by: ymg 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
Title: Re: Triangulation (re-visited)
Post by: ribarm 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.
Title: Re: Triangulation (re-visited)
Post by: ymg on April 04, 2015, 06:40:15 PM
Marko,

What I mean by normalizing the point list is this:

Code - Auto/Visual Lisp: [Select]
  1.           (setq bb (list (apply 'mapcar (cons 'min pl))
  2.                           (apply 'mapcar (cons 'max pl))
  3.                         )
  4.                xmin (caar bb)      
  5.                xmax (caadr bb)      
  6.                ymin (cadar bb)      
  7.                ymax (cadadr bb)
  8.                dmax (max (- xmax xmin)(- ymax ymin))
  9.                  ; Points are Scaled to 1 along Max of x and y dimensions     ;
  10.                  pl (mapcar
  11.                        (function
  12.                            (lambda (a) (list (/ (- (car a) xmin) dmax)
  13.                                              (/ (- (cadr a) ymin) dmax)
  14.                                              (caddr a)
  15.                                        )
  16.                            )        
  17.                        )
  18.                        pl
  19.                     )
  20.  

Then before outputting the triangle, you reverse the process:

Code - Auto/Visual Lisp: [Select]
  1.                      (function
  2.                          (lambda (a) (list (+ (* (car  a) dmax) xmin)
  3.                                            (+ (* (cadr a) dmax) ymin)
  4.                                            (caddr a)
  5.                                      )
  6.                          )
  7.                       )  
  8.                       pl
  9.                   )
  10.          )
  11.  


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

Code - Auto/Visual Lisp: [Select]
  1. ;Removes doubled edges, computes circumcircles and add them to al ;
  2.            
  3.             (while el
  4.                (if (or (member (reverse (car el)) el)
  5.                        (member (car el) (cdr el)))
  6.                  (setq el (vl-remove (reverse (car el)) el)
  7.                        el (vl-remove (car el) el)
  8.                  )
  9.                  (progn  ; This replaces call to getcircumcircle function     ;
  10.                       (setq p (nth n pl)
  11.                             b (nth (caar el) pl)
  12.                             c (nth (cadar el) pl)
  13.                             c (list (car c) (cadr c)) ; Point c has to be 2d
  14.                            vl (list n (caar el) (cadar el))
  15.                       )
  16.                       (if (not (zerop (setq ang (- (angle b c) (angle b p)))))
  17.                          (setq cp (polar c (+ *-pi/2* (angle c p) ang)(setq r (/ (distance p c) (sin ang) 2.0)))
  18.                                al (cons (list (+ (car cp) (abs r)) cp (abs r) vl) al)
  19.                                el (cdr el)
  20.                          )
  21.                       )
  22.                  )
  23.                )
  24.             )
  25.  

ymg
Title: Re: Triangulation (re-visited)
Post by: ribarm 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...
Title: Re: Triangulation (re-visited)
Post by: ymg 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
Title: Re: Triangulation (re-visited)
Post by: ribarm 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]
  1. (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 )
  2.  
  3.   (defun mid ( p1 p2 )
  4.     (mapcar '(lambda ( a b ) (/ (+ a b) 2.0)) p1 p2)
  5.   )
  6.  
  7.   ;; 3D to 2D point  -  M.R.
  8.   ;; Returns 2D point list from supplied 3D point list or returns supplied argument if it isn't 3D point list
  9.  
  10.   (defun 3D->2D ( p )
  11.       (if (and (listp p) (vl-every '(lambda ( x ) (eq (type x) 'REAL)) p) (eq (length p) 3))
  12.           (list (car p) (cadr p))
  13.           p
  14.       )
  15.   )
  16.  
  17.   ;; Collinear-p  -  M.R.
  18.   ;; Returns T if p1,p2,p3 are collinear
  19.  
  20.   (defun MR:Collinear-p ( p1 p2 p3 )
  21.       (equal  (distance p1 p3)
  22.               (+ (distance p1 p2) (distance p2 p3))
  23.           1e-8
  24.       )
  25.   )
  26.  
  27.   ;; Clockwise-p  -  Lee Mac
  28.   ;; Returns T if p1,p2,p3 are clockwise oriented or collinear
  29.  
  30.   (defun LM:Clockwise-p ( p1 p2 p3 )
  31.       (<  (-  (* (- (car  p2) (car  p1)) (- (cadr p3) (cadr p1)))
  32.               (* (- (cadr p2) (cadr p1)) (- (car  p3) (car  p1)))
  33.           )
  34.           1e-8
  35.       )
  36.   )
  37.  
  38.   ;; Convex Hull  -  Lee Mac
  39.   ;; Implements the Graham Scan Algorithm to return the Convex Hull of a list of points.
  40.    
  41.   (defun LM:ConvexHull ( lst / ch p0 )
  42.       (cond
  43.           (   (< (length lst) 4) lst)
  44.           (   (setq p0 (car lst))
  45.               (foreach p1 (cdr lst)
  46.                   (if (or (< (cadr p1) (cadr p0))
  47.                           (and (equal (cadr p1) (cadr p0) 1e-8) (< (car p1) (car p0)))
  48.                       )
  49.                       (setq p0 p1)
  50.                   )
  51.               )
  52.               (setq lst
  53.                   (vl-sort lst
  54.                       (function
  55.                           (lambda ( a b / c d )
  56.                               (if (equal (setq c (angle p0 a)) (setq d (angle p0 b)) 1e-8)
  57.                                   (< (distance p0 a) (distance p0 b))
  58.                                   (< (if (equal c (* 2.0 pi) 1e-8) 0.0 c) (if (equal d (* 2.0 pi) 1e-8) 0.0 d))
  59.                               )
  60.                           )
  61.                       )
  62.                   )
  63.               )
  64.               (setq ch (list (caddr lst) (cadr lst) (car lst)))
  65.               (foreach pt (cdddr lst)
  66.                   (setq ch (cons pt ch))
  67.                   (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))))
  68.                       (setq ch (cons pt (cddr ch)))
  69.                   )
  70.               )
  71.               ch
  72.           )
  73.       )
  74.   )
  75.  
  76.   (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 )
  77.  
  78.     (defun getcircumcircle ( p el / circumcircle cp cr rr )
  79.        
  80.       (defun circumcircle ( p1 p2 p3 / ang c r )
  81.         (if
  82.           (not
  83.             (zerop
  84.               (setq ang (- (angle p2 p3) (angle p2 p1)))
  85.             )
  86.           )
  87.           (setq c (polar p3 (+ -1.570796326794896 (angle p3 p1) ang) (setq r (/ (distance p1 p3) (sin ang) 2.0)))
  88.                r (abs r)
  89.           )
  90.         )
  91.         (list c r)
  92.       )
  93.  
  94.       (setq cp (car (setq cr (circumcircle (3D->2D p) (3D->2D (car el)) (3D->2D (cadr el))))) rr (cadr cr))
  95.       (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 ;;;
  96.     )
  97.  
  98.     (setq pll pl)
  99.     (setq xmin (caar (setq pl (vl-sort pl '(lambda ( a b ) (< (car a) (car b))))))) ;;; Sorted pl by X ;;;
  100.     (setq xmax (caar (vl-sort pl '(lambda ( a b ) (> (car a) (car b))))))
  101.     (setq ymin (cadar (vl-sort pl '(lambda ( a b ) (< (cadr a) (cadr b))))))
  102.     (setq ymax (cadar (vl-sort pl '(lambda ( a b ) (> (cadr a) (cadr b))))))
  103.     (setq cs (list (+ xmin (/ (- xmax xmin) 2.0)) (+ ymin (/ (- ymax ymin) 2.0))))
  104.     (setq pmin (list xmin ymin) pmax (list xmax ymax))
  105.     (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 ;;;
  106.     ;;(setq t1 (polar cs 0.0 (setq rs (* 2.0 factor (distance pmin cs)))))
  107.     (setq t2 (polar cs (+ 0.0 (/ (* 2.0 pi) 3.0)) rs))
  108.     (setq t3 (polar cs (+ 0.0 (/ (* 4.0 pi) 3.0)) rs))
  109.     (setq al (list (list (car t1) cs rs (list t1 t2 t3))))
  110.     (while pl
  111.       (setq p (car pl))
  112.       (setq pl (cdr pl))
  113.       (setq el nil)
  114.       (while al
  115.         (setq tr (car al))
  116.         (setq al (cdr al))
  117.         (cond
  118.           ( (< (car tr) (car p)) ;;; Comparison of X values ;;;
  119.             (setq tl (cons (cadddr tr) tl))
  120.           )
  121.           ( (< (distance p (cadr tr)) (caddr tr))
  122.             (setq el (append (list
  123.                               (list (car (last tr)) (cadr (last tr)))
  124.                               (list (cadr (last tr)) (caddr (last tr)))
  125.                               (list (caddr (last tr)) (car (last tr)))
  126.                             ) el
  127.                     )
  128.             )
  129.           )
  130.           ( t (setq l (cons tr l)) )
  131.         )
  132.       )
  133.       (if l (setq al l l nil))
  134.       (while el
  135.         (if (or (member (reverse (car el)) el)
  136.                (member (car el) (cdr el))
  137.             )
  138.             (setq el (vl-remove (reverse (car el)) el)
  139.                   el (vl-remove (car el) el)
  140.             )
  141.             (setq al (cons (getcircumcircle p (car el)) al)
  142.                   el (cdr el)
  143.             )
  144.         )
  145.       )
  146.     )
  147.     (foreach tr al (setq tl (cons (cadddr tr) tl)))
  148.     (setq tl (vl-remove-if '(lambda ( x ) (or (member t1 x) (member t2 x) (member t3 x))) tl))
  149.     (setq pl pll)
  150.     (if (null ell)
  151.       (progn
  152.         (setq el (mapcar '(lambda ( a b ) (list a b)) (setq och (LM:ConvexHull pll)) (cdr (reverse (cons (car och) (reverse och))))))
  153.         (mapcar '(lambda ( x ) (setq pll (vl-remove x pll))) och)
  154.         (setq ich (LM:ConvexHull pll))
  155.       )
  156.     )
  157.     (if ich
  158.       (progn
  159.         (setq ell t)
  160.         (foreach e el
  161.           (if (not (vl-some '(lambda ( x ) (and (member (car e) x) (member (cadr e) x))) tl))
  162.             (progn
  163.               (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))))))))
  164.               (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))
  165.               (foreach p iche
  166.                 (if (or
  167.                       (and
  168.                         (vl-some '(lambda ( x ) (if (and (member (car e) x) (member p x)) (setq tr x))) tl)
  169.                         (vl-some '(lambda ( x ) (and (member (car e) x) (member p x))) (vl-remove tr tl))
  170.                       )
  171.                       (and
  172.                         (vl-some '(lambda ( x ) (if (and (member (cadr e) x) (member p x)) (setq tr x))) tl)
  173.                         (vl-some '(lambda ( x ) (and (member (cadr e) x) (member p x))) (vl-remove tr tl))
  174.                       )
  175.                     )
  176.                     (setq iche (vl-remove p iche))
  177.                 )
  178.               )
  179.               (setq i (length iche))
  180.               (setq iche (cons (car e) iche) iche (cons (cadr e) iche))
  181.               (if (null z)
  182.                 (setq z 10.0)
  183.               )
  184.               (setq z
  185.                 (cond
  186.                   ( (<= i (length (car (triangulate iche 10.0))))
  187.                     (if (>= z 10.0)
  188.                       z
  189.                       (setq z 10.0)
  190.                     )
  191.                   )
  192.                   ( (<= i (length (car (triangulate iche 25.0))))
  193.                     (if (>= z 25.0)
  194.                       z
  195.                       (setq z 25.0)
  196.                     )
  197.                   )
  198.                   ( (<= i (length (car (triangulate iche 50.0))))
  199.                     (if (>= z 50.0)
  200.                       z
  201.                       (setq z 50.0)
  202.                     )
  203.                   )
  204.                   ( (<= i (length (car (triangulate iche 100.0))))
  205.                     (if (>= z 100.0)
  206.                       z
  207.                       (setq z 100.0)
  208.                     )
  209.                   )
  210.                   ( (<= i (length (car (triangulate iche 250.0))))
  211.                     (if (>= z 250.0)
  212.                       z
  213.                       (setq z 250.0)
  214.                     )
  215.                   )
  216.                   ( (<= i (length (car (triangulate iche 500.0))))
  217.                     (if (>= z 500.0)
  218.                       z
  219.                       (setq z 500.0)
  220.                     )
  221.                   )
  222.                   ( (<= i (length (car (triangulate iche 1000.0))))
  223.                     (if (>= z 1000.0)
  224.                       z
  225.                       (setq z 1000.0)
  226.                     )
  227.                   )
  228.                 )
  229.               )
  230.             )
  231.           )
  232.         )
  233.       )
  234.     )
  235.     (list tl z)
  236.   ) ;;; end of triangulate
  237.  
  238.   ;;                                                                            ;
  239.   ;; 3df2sol     by  ymg   mod by M.R.                                          ;
  240.   ;;                                                                            ;
  241.   ;; Given a triangle point list of 3DFACE Loft it Down to Elevation - elev     ;
  242.   ;; Returns the ename of the Solid created.                                    ;
  243.   ;; Original 3DFACE is deleted.                                                ;
  244.   ;;                                                                            ;
  245.  
  246.   (defun 3df2sol ( tr elev / en1 en2 p1 p2 p3 p4 )
  247.     (setq
  248.       p1 (car tr)
  249.       p2 (cadr tr)
  250.       p3 (caddr tr)
  251.       p4 (car tr)
  252.     )
  253.     (setq
  254.       en1
  255.       (entmakex
  256.         (list
  257.           (cons 0 "3DFACE")
  258.           (cons 10 (list (car p1) (cadr p1) elev))
  259.           (cons 11 (list (car p2) (cadr p2) elev))
  260.           (cons 12 (list (car p3) (cadr p3) elev))
  261.           (cons 13 (list (car p4) (cadr p4) elev))
  262.         )
  263.       )
  264.     )
  265.     (setq
  266.       en2
  267.       (entmakex
  268.         (list
  269.           (cons 0 "3DFACE")
  270.           (cons 10 p1)
  271.           (cons 11 p2)
  272.           (cons 12 p3)
  273.           (cons 13 p4)
  274.         )
  275.       )
  276.     )
  277.     (vl-cmdf "_.LOFT" en1 en2 "_MO" "_SOLID")
  278.     (while (> (getvar 'cmdactive) 0) (vl-cmdf ""))
  279.     (if (entget en1) (entdel en1))
  280.     (if (entget en2) (entdel en2))
  281.     (entlast)
  282.   )
  283.  
  284.   (prompt "\n................................................")
  285.   (prompt "\nTERRAIN TRIANGULATION IRREGULAR NETWORK MODELING")
  286.   (prompt "\n................................................")
  287.   (prompt "\n................................................")
  288.   (prompt "\nSELECT RANDOM 3D POINTS...")
  289.   (setq ss (ssget '((0 . "POINT"))))
  290.   (repeat (setq i (sslength ss))
  291.     (setq p (cdr (assoc 10 (entget (ssname ss (setq i (1- i)))))))
  292.     (setq pl (cons p pl))
  293.   )
  294.  
  295.   (setq elevmin (caddar (setq pl (vl-sort pl '(lambda ( a b ) (< (caddr a) (caddr b)))))))
  296.   (setq elmin (getreal (strcat "\nInput base elevation of terrain (must be < " (rtos elevmin 2 15) " ) : ")))
  297.   (while (>= elmin elevmin)
  298.     (setq elmin (getreal (strcat "\nInput base elevation of terrain (must be < " (rtos elevmin 2 15) " ) : ")))
  299.   )
  300.  
  301.   (setq ti (car (_vl-times)))
  302.   (setq ss3f (ssadd))
  303.   (setq z (cadr (triangulate pl 10.0)))
  304.   (foreach tr (car (triangulate pl z))
  305.     (ssadd
  306.       (3df2sol tr elmin)
  307.       ss3f
  308.     )
  309.   )
  310.  
  311.   (vl-cmdf "_.UNION" ss3f "")
  312.  
  313.   (prompt (strcat "\nElapsed time: " (rtos (/ (- (car (_vl-times)) ti) 1000.) 2 4) " secs."))
  314.   (princ)
  315. )
  316.  

M.R.
Title: Re: Triangulation (re-visited)
Post by: ymg 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
Title: Re: Triangulation (re-visited)
Post by: ymg on April 29, 2015, 03:59:52 PM
Here a small video for the c:prof command

ymg
Title: Re: Triangulation (re-visited)
Post by: pedroantonio on April 29, 2015, 04:49:22 PM
Hi  ymg !!This is the last version ? Did you add oasis in this version ?

Thanks !!
Title: Re: Triangulation (re-visited)
Post by: ymg on April 29, 2015, 05:18:10 PM
topographer,

Sorry, but not there yet!

ymg
Title: Re: Triangulation (re-visited)
Post by: ymg on April 29, 2015, 06:20:31 PM
Marko,

The idea of lofting is so we can overlap 2 surfaces
say one is existing ground, the other one projected.

If we loft both surfaces down to elevation 0,
we can calculate the cut and fill required.

The final volume is simply Volume of surface existing
minus the volume of the Projected.

I am oversimplifying here, as we must keep only
the overlapping part of both surfaces.

I did a bit of work on it, and could get the Volume.

Finding what is Cut and what is Fill however is trickier.

It's been a long time but I believe the below code was my latest.
Don't remember the status of it, so it needs to be checked.

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

ymg
Title: Re: Triangulation (re-visited)
Post by: ymg on April 30, 2015, 05:05:14 AM
I had remove some necessary function during
the clean-up (Namely massoc-fuzz) so

I have corrected the attachment in post #374

ymg
Title: Re: Triangulation (re-visited)
Post by: ymg on April 30, 2015, 03:36:33 PM
Topographer,

Concerning the oasis, holes or island however we name them,
it can be done with the program as it is.

The holes is actually a polyline that encircles an area without
points.

This is actually a close breakline without any points inside.

Only thing missing is as you create the CDT, 3dfaces will be created
inside the breaklines.  In other word the inside of your polyline
defining the breakline will be triangulated also.

All you need to do is to erase these inside triangles
manually upon completion. Should be easy if you
use the breakline as a selecting polygon.

ymg
Title: Re: Triangulation (re-visited)
Post by: ribarm on May 01, 2015, 12:44:53 PM
Here is my newest version of convex triangulation terrain modeling routine... It should be ab 5 times faster than LOFT variant... Only thing that now it uses SURFSCULPT command, so you should have ACAD that supports this...

Code - Auto/Visual Lisp: [Select]
  1. (defun c:terrain ( / mid 3D->2D MR:Collinear-p MR:ListClockwise-p LM:Clockwise-p LM:ConvexHull triangulate ss i p pl ell tl och elmin elmax elevmin elevmax fuzz ss3f ent entl entll ti z )
  2.  
  3.   (defun mid ( p1 p2 )
  4.     (mapcar '(lambda ( a b ) (/ (+ a b) 2.0)) p1 p2)
  5.   )
  6.  
  7.   ;; 3D to 2D point  -  M.R.
  8.   ;; Returns 2D point list from supplied 3D point list or returns supplied argument if it isn't 3D point list
  9.  
  10.   (defun 3D->2D ( p )
  11.       (if (and (listp p) (vl-every '(lambda ( x ) (eq (type x) 'REAL)) p) (eq (length p) 3))
  12.           (list (car p) (cadr p))
  13.           p
  14.       )
  15.   )
  16.  
  17.   ;; Collinear-p  -  M.R.
  18.   ;; Returns T if p1,p2,p3 are collinear
  19.  
  20.   (defun MR:Collinear-p ( p1 p2 p3 )
  21.       (equal  (distance p1 p3)
  22.               (+ (distance p1 p2) (distance p2 p3))
  23.           1e-8
  24.       )
  25.   )
  26.  
  27.   ;; MR:ListClockwise-p
  28.  
  29.   (defun MR:ListClockwise-p ( lst / z vlst )
  30.     (vl-catch-all-apply 'minusp
  31.       (list
  32.         (if
  33.           (not
  34.             (equal 0.0
  35.               (setq z
  36.                 (apply '+
  37.                   (mapcar
  38.                     (function
  39.                       (lambda ( u v )
  40.                         (- (* (car  u) (cadr  v)) (* (car  v) (cadr  u)))
  41.                       )
  42.                     )
  43.                     (setq vlst
  44.                       (mapcar
  45.                         (function
  46.                           (lambda ( a b ) (mapcar '- b a))
  47.                         )
  48.                         (mapcar (function (lambda ( x ) (car lst))) lst)
  49.                         (cdr (reverse (cons (car lst) (reverse lst))))
  50.                       )
  51.                     )
  52.                     (cdr (reverse (cons (car vlst) (reverse vlst))))
  53.                   )
  54.                 )
  55.               ) 1e-6
  56.             )
  57.           )
  58.           z
  59.           (progn
  60.             (prompt "\n\nChecked vectors are colinear - unable to determine clockwise-p of list")
  61.             nil
  62.           )
  63.         )
  64.       )
  65.     )
  66.   )
  67.  
  68.   ;; Clockwise-p  -  Lee Mac
  69.   ;; Returns T if p1,p2,p3 are clockwise oriented or collinear
  70.  
  71.   (defun LM:Clockwise-p ( p1 p2 p3 )
  72.       (<  (-  (* (- (car  p2) (car  p1)) (- (cadr p3) (cadr p1)))
  73.               (* (- (cadr p2) (cadr p1)) (- (car  p3) (car  p1)))
  74.           )
  75.           1e-8
  76.       )
  77.   )
  78.  
  79.   ;; Convex Hull  -  Lee Mac
  80.   ;; Implements the Graham Scan Algorithm to return the Convex Hull of a list of points.
  81.    
  82.   (defun LM:ConvexHull ( lst / ch p0 )
  83.       (cond
  84.           (   (< (length lst) 4) lst)
  85.           (   (setq p0 (car lst))
  86.               (foreach p1 (cdr lst)
  87.                   (if (or (< (cadr p1) (cadr p0))
  88.                           (and (equal (cadr p1) (cadr p0) 1e-8) (< (car p1) (car p0)))
  89.                       )
  90.                       (setq p0 p1)
  91.                   )
  92.               )
  93.               (setq lst (vl-remove p0 lst))
  94.               (setq lst (append (list p0) lst))
  95.               (setq lst
  96.                   (vl-sort lst
  97.                       (function
  98.                           (lambda ( a b / c d )
  99.                               (if (equal (setq c (angle p0 a)) (setq d (angle p0 b)) 1e-8)
  100.                                   (< (distance p0 a) (distance p0 b))
  101.                                   (< (if (equal c (* 2.0 pi) 1e-8) 0.0 c) (if (equal d (* 2.0 pi) 1e-8) 0.0 d))
  102.                               )
  103.                           )
  104.                       )
  105.                   )
  106.               )
  107.               (setq ch (list (caddr lst) (cadr lst) (car lst)))
  108.               (foreach pt (cdddr lst)
  109.                   (setq ch (cons pt ch))
  110.                   (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))))
  111.                       (setq ch (cons pt (cddr ch)))
  112.                   )
  113.               )
  114.               (reverse ch)
  115.           )
  116.       )
  117.   )
  118.  
  119.   (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 )
  120.  
  121.     (defun getcircumcircle ( p el / circumcircle cp cr rr )
  122.        
  123.       (defun circumcircle ( p1 p2 p3 / ang c r )
  124.         (if
  125.           (not
  126.             (zerop
  127.               (setq ang (- (angle p2 p3) (angle p2 p1)))
  128.             )
  129.           )
  130.           (setq c (polar p3 (+ -1.570796326794896 (angle p3 p1) ang) (setq r (/ (distance p1 p3) (sin ang) 2.0)))
  131.                r (abs r)
  132.           )
  133.         )
  134.         (list c r)
  135.       )
  136.  
  137.       (setq cp (car (setq cr (circumcircle (3D->2D p) (3D->2D (car el)) (3D->2D (cadr el))))) rr (cadr cr))
  138.       (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 ;;;
  139.     )
  140.  
  141.     (setq pll pl)
  142.     (setq xmin (caar (setq pl (vl-sort pl '(lambda ( a b ) (< (car a) (car b))))))) ;;; Sorted pl by X ;;;
  143.     (setq xmax (caar (vl-sort pl '(lambda ( a b ) (> (car a) (car b))))))
  144.     (setq ymin (cadar (vl-sort pl '(lambda ( a b ) (< (cadr a) (cadr b))))))
  145.     (setq ymax (cadar (vl-sort pl '(lambda ( a b ) (> (cadr a) (cadr b))))))
  146.     (setq cs (list (+ xmin (/ (- xmax xmin) 2.0)) (+ ymin (/ (- ymax ymin) 2.0))))
  147.     (setq pmin (list xmin ymin) pmax (list xmax ymax))
  148.     (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 ;;;
  149.     ;;(setq t1 (polar cs 0.0 (setq rs (* 2.0 factor (distance pmin cs)))))
  150.     (setq t2 (polar cs (+ 0.0 (/ (* 2.0 pi) 3.0)) rs))
  151.     (setq t3 (polar cs (+ 0.0 (/ (* 4.0 pi) 3.0)) rs))
  152.     (setq al (list (list (car t1) cs rs (list t1 t2 t3))))
  153.     (while pl
  154.       (setq p (car pl))
  155.       (setq pl (cdr pl))
  156.       (setq el nil)
  157.       (while al
  158.         (setq tr (car al))
  159.         (setq al (cdr al))
  160.         (cond
  161.           ( (< (car tr) (car p)) ;;; Comparison of X values ;;;
  162.             (setq tl (cons (cadddr tr) tl))
  163.           )
  164.           ( (< (distance p (cadr tr)) (caddr tr))
  165.             (setq el (append (list
  166.                               (list (car (last tr)) (cadr (last tr)))
  167.                               (list (cadr (last tr)) (caddr (last tr)))
  168.                               (list (caddr (last tr)) (car (last tr)))
  169.                             ) el
  170.                     )
  171.             )
  172.           )
  173.           ( t (setq l (cons tr l)) )
  174.         )
  175.       )
  176.       (if l (setq al l l nil))
  177.       (while el
  178.         (if (or (member (reverse (car el)) el)
  179.                (member (car el) (cdr el))
  180.             )
  181.             (setq el (vl-remove (reverse (car el)) el)
  182.                   el (vl-remove (car el) el)
  183.             )
  184.             (setq al (cons (getcircumcircle p (car el)) al)
  185.                   el (cdr el)
  186.             )
  187.         )
  188.       )
  189.     )
  190.     (foreach tr al (setq tl (cons (cadddr tr) tl)))
  191.     (setq tl (vl-remove-if '(lambda ( x ) (or (member t1 x) (member t2 x) (member t3 x))) tl))
  192.     (setq pl pll)
  193.     (if (null ell)
  194.       (progn
  195.         (setq el (mapcar '(lambda ( a b ) (list a b)) (setq och (LM:ConvexHull pll)) (cdr (reverse (cons (car och) (reverse och))))))
  196.         (mapcar '(lambda ( x ) (setq pll (vl-remove x pll))) och)
  197.         (setq ich (LM:ConvexHull pll))
  198.       )
  199.     )
  200.     (if ich
  201.       (progn
  202.         (setq ell t)
  203.         (foreach e el
  204.           (if (not (vl-some '(lambda ( x ) (and (member (car e) x) (member (cadr e) x))) tl))
  205.             (progn
  206.               (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))))))))
  207.               (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))
  208.               (foreach p iche
  209.                 (if (or
  210.                       (and
  211.                         (vl-some '(lambda ( x ) (if (and (member (car e) x) (member p x)) (setq tr x))) tl)
  212.                         (vl-some '(lambda ( x ) (and (member (car e) x) (member p x))) (vl-remove tr tl))
  213.                       )
  214.                       (and
  215.                         (vl-some '(lambda ( x ) (if (and (member (cadr e) x) (member p x)) (setq tr x))) tl)
  216.                         (vl-some '(lambda ( x ) (and (member (cadr e) x) (member p x))) (vl-remove tr tl))
  217.                       )
  218.                     )
  219.                     (setq iche (vl-remove p iche))
  220.                 )
  221.               )
  222.               (setq i (length iche))
  223.               (setq iche (cons (car e) iche) iche (cons (cadr e) iche))
  224.               (if (null z)
  225.                 (setq z 10.0)
  226.               )
  227.               (setq z
  228.                 (cond
  229.                   ( (<= i (length (car (triangulate iche 10.0))))
  230.                     (if (>= z 10.0)
  231.                       z
  232.                       (setq z 10.0)
  233.                     )
  234.                   )
  235.                   ( (<= i (length (car (triangulate iche 25.0))))
  236.                     (if (>= z 25.0)
  237.                       z
  238.                       (setq z 25.0)
  239.                     )
  240.                   )
  241.                   ( (<= i (length (car (triangulate iche 50.0))))
  242.                     (if (>= z 50.0)
  243.                       z
  244.                       (setq z 50.0)
  245.                     )
  246.                   )
  247.                   ( (<= i (length (car (triangulate iche 100.0))))
  248.                     (if (>= z 100.0)
  249.                       z
  250.                       (setq z 100.0)
  251.                     )
  252.                   )
  253.                   ( (<= i (length (car (triangulate iche 250.0))))
  254.                     (if (>= z 250.0)
  255.                       z
  256.                       (setq z 250.0)
  257.                     )
  258.                   )
  259.                   ( (<= i (length (car (triangulate iche 500.0))))
  260.                     (if (>= z 500.0)
  261.                       z
  262.                       (setq z 500.0)
  263.                     )
  264.                   )
  265.                   ( (<= i (length (car (triangulate iche 1000.0))))
  266.                     (if (>= z 1000.0)
  267.                       z
  268.                       (setq z 1000.0)
  269.                     )
  270.                   )
  271.                 )
  272.               )
  273.             )
  274.           )
  275.         )
  276.       )
  277.     )
  278.     (list tl z)
  279.   ) ;;; end of triangulate
  280.  
  281.  
  282.   (prompt "\n................................................")
  283.   (prompt "\nTERRAIN TRIANGULATION IRREGULAR NETWORK MODELING")
  284.   (prompt "\n................................................")
  285.   (prompt "\n................................................")
  286.   (prompt "\nSELECT RANDOM 3D POINTS...")
  287.   (command "_.UCS" "_W")
  288.   (setq ss (ssget '((0 . "POINT"))))
  289.   (repeat (setq i (sslength ss))
  290.     (setq p (cdr (assoc 10 (entget (ssname ss (setq i (1- i)))))))
  291.     (setq pl (cons p pl))
  292.   )
  293.  
  294.   (setq elevmin (caddar (setq pl (vl-sort pl '(lambda ( a b ) (< (caddr a) (caddr b)))))))
  295.   (setq elevmax (caddr (last pl)))
  296.   (setq elmin (getreal (strcat "\nInput base elevation of terrain (must be < " (rtos elevmin 2 15) " ) : ")))
  297.   (while (>= elmin elevmin)
  298.     (setq elmin (getreal (strcat "\nInput base elevation of terrain (must be < " (rtos elevmin 2 15) " ) : ")))
  299.   )
  300.   (setq elmax (getreal (strcat "\nInput top elevation of terrain (must be > " (rtos elevmax 2 15) " ) : ")))
  301.   (while (<= elmax elevmax)
  302.     (setq elmax (getreal (strcat "\nInput top elevation of terrain (must be > " (rtos elevmax 2 15) " ) : ")))
  303.   )
  304.   (initget 4)
  305.   (setq fuzz (getreal "\nSpecify fuzz edge inaccuracy to make possible creation of 3DSOLID with SURFSCULPT command <0.0> : "))
  306.   (if (null fuzz) (setq fuzz 0.0))
  307.  
  308.   (setq ti (car (_vl-times)))
  309.   (setq ss3f (ssadd))
  310.   (setq z (cadr (triangulate pl 10.0)))
  311.   (foreach tr (car (triangulate pl z))
  312.     (ssadd
  313.       (entmakex
  314.         (list (cons 0 "3DFACE")
  315.           (cons 10 (car tr))
  316.           (cons 11 (cadr tr))
  317.           (cons 12 (caddr tr))
  318.           (cons 13 (car tr))
  319.         )
  320.       )
  321.       ss3f
  322.     )
  323.   )
  324.  
  325.   (setq entl (entmakex
  326.                (append
  327.                  (list
  328.                    '(0 . "LWPOLYLINE")
  329.                    '(100 . "AcDbEntity")
  330.                    '(100 . "AcDbPolyline")
  331.                    (cons 90 (length och))
  332.                    '(70 . 1)
  333.                    (cons 38 elmin)                  
  334.                  )
  335.                  (mapcar '(lambda ( p ) (list 10 (car p) (cadr p))) och)
  336.                  (list
  337.                    (list 210 0.0 0.0 1.0)
  338.                  )
  339.                )
  340.              )
  341.   )
  342.   (if (not (zerop fuzz))
  343.     (progn
  344.       (if (MR:ListClockwise-p och)
  345.         (vla-offset (vlax-ename->vla-object entl) fuzz)
  346.         (vla-offset (vlax-ename->vla-object entl) (- fuzz))
  347.       )
  348.       (vla-move (vlax-ename->vla-object entl) (vlax-3d-point (list 0.0 0.0 0.0)) (vlax-3d-point (list 0.0 0.0 fuzz)))
  349.       (setq entll entl)
  350.       (setq entl (entlast))
  351.     )
  352.   )
  353.   (command "_.EXTRUDE" entl "" "_D" (list 0.0 0.0 elmin) (list 0.0 0.0 elmax))
  354.   (command "_.EXPLODE" (entlast))
  355.   (while (> (getvar 'cmdactive) 0) (command ""))
  356.   (if (not (zerop fuzz))
  357.     (progn
  358.       (command "_.UCS" "_M" (list 0.0 0.0 elmin))
  359.       (repeat (setq i (sslength (setq entl (ssget "_P"))))
  360.         (setq ent (ssname entl (setq i (1- i))))
  361.         (if (not (vl-catch-all-error-p (vl-catch-all-apply 'vla-get-centroid (list (vlax-ename->vla-object ent)))))
  362.           (progn
  363.             (ssdel ent entl)
  364.             (entdel ent)
  365.           )
  366.         )
  367.       )
  368.       (command "_.UCS" "_P")
  369.     )
  370.   )
  371.   (command "_.UCS" "_M" (list 0.0 0.0 elmax))
  372.   (repeat (setq i (sslength (if (eq (type entl) 'PICKSET) entl (setq entl (ssget "_P")))))
  373.     (setq ent (ssname entl (setq i (1- i))))
  374.     (if (not (vl-catch-all-error-p (vl-catch-all-apply 'vla-get-centroid (list (vlax-ename->vla-object ent)))))
  375.       (progn
  376.         (ssdel ent entl)
  377.         (entdel ent)
  378.       )
  379.     )
  380.   )
  381.   (if (not (zerop fuzz))
  382.     (progn
  383.       (command "_.REGION" entll "")
  384.       (ssadd (setq ent (entlast)) entl)
  385.     )
  386.     (setq ent (entlast))
  387.   )
  388.  
  389.   (command "_.REGION" ss3f "")
  390.   (while (setq ent (entnext ent))
  391.     (ssadd ent entl)
  392.   )
  393.  
  394.   (command "_.UCS" "_P")
  395.   (command "_.SURFSCULPT" entl "")
  396.   (command "_.UCS" "_P")
  397.  
  398.   (prompt (strcat "\nElapsed time: " (rtos (/ (- (car (_vl-times)) ti) 1000.) 2 4) " secs."))
  399.   (princ)
  400. )
  401.  

HTH, Regards, M.R.
Title: Re: Triangulation (re-visited)
Post by: ymg on May 01, 2015, 04:12:54 PM
Marko,

Looks good to me I am running 2012, so surfsculpt.

However I've not done a lot of 3d-modeling except
for the occasionnal simple model.

You are much more proficient at it than I am.

Is surfsculpt available to Briscad ?

Would like to keep thing compatible with it.

ymg
Title: Re: Triangulation (re-visited)
Post by: motee-z on May 01, 2015, 05:37:11 PM
Hello ymg
when executing the routine i got this message any reason for this i use autocad2013 version
Error: no function definition: MASSOC-FUZZ
Title: Re: Triangulation (re-visited)
Post by: ymg on May 01, 2015, 06:50:07 PM
motee-z,

Download the file again as I had removed the function
by mistakes.

Anyway in next revision probably tomorrow, this
function will no longer be required.

I hope to complete the automatic clean-up of
triangles inside holes of the triangulation in this
next revision.

A note of caution, there has been some revision to
the DCL.  So if you had run any of the older version,
you need to erase the tin.dcl  file that is in your temp directory.

ymg
Title: Re: Triangulation (re-visited)
Post by: ymg on May 02, 2015, 01:29:56 PM
As pledged, here is Revision 0.6.2.8 of triangulation
program.

Islands are now cleaned up after triangulation.

ymg
Title: Re: Triangulation (re-visited)
Post by: pedroantonio on May 02, 2015, 02:05:00 PM
Hi ymg nice update , but i have a bug. The problem is when the breaklines is in touch with the boundary. Look the test.dwg

Title: Re: Triangulation (re-visited)
Post by: pedroantonio on May 02, 2015, 02:26:37 PM
Hi ymg ,I havesome  questions.
1)I draw a 2d polyline on the contours and then i write prof to draw a long section, and gives me this message Error: divide by zero.
With the previous versions i didn't have this error.
2)I use attribiute block for my insert survey points.With the previous versions i didn't have any problems.Now i  need to turn off the layers of this block.Is this necessary

Look the test2.dwg with the 2d polyline and the layoff layers

Thanks
Title: Re: Triangulation (re-visited)
Post by: ymg on May 02, 2015, 05:47:55 PM
Topographer,

Seems to be a valid bug.  I believe it has to do
when there is no triangle inside the closed breaklines.

Right now I'm tired, so I'll look more closely
tomorrow.

Ditto, for the second bug.

ymg
Title: Re: Triangulation (re-visited)
Post by: ymg on May 03, 2015, 07:48:40 AM
Topographer,

Corrected the first bug that you submitted.

For the second, the problem is that the insert point
of your block are 2d.

Your blocks must be inserted at the proper elevation (3D)

As it is Blocks are left on whatever layer there were inserted to.
We could change this behaviour and move them to the "Tin Point ..."
layers.

We do not need to create a "POINT"  entity in order to triangulate
all I am using is the coordinates of insertion.

If we move the blocks to the "Tin Point ..." layers the c:tog command
could be used to make them appear or dissappear. 

We could, as you go in command c:prof, turn "Off" layer  "Tin Point ..."
to diminish the clutter on screen.  Although it is not absolutely necessary.

ymg
Title: Re: Triangulation (re-visited)
Post by: motee-z on May 03, 2015, 09:05:21 AM
Hello ymg
thank you for your big efforts to finish this great lisp
but i think the problem is still for draw profile and there is something going not well
the message still divided by zero
here is my sample
Title: Re: Triangulation (re-visited)
Post by: ribarm on May 03, 2015, 09:18:35 AM
I don't see a problem with TIN command :

Code: [Select]
Command: (LOAD "C:/Users/RIBAR/Downloads/TriangV0.6.2.9.LSP")
Triangulation V0.6.2.9 loaded...!

Command: TIN
Select objects: Specify opposite corner: 814 found

Select objects:

     TIN - Elapsed time: 1.8870 secs, 5131 3DFACES
     CDT V0.6.2.9 - Elapsed time: 14.9610 secs, 2082 Constraints

Attached is drawing after TIN command...

[EDIT : Oh I see the problem is with PROF command... after TIN]
Title: Re: Triangulation (re-visited)
Post by: ymg on May 03, 2015, 10:05:46 AM
Marko and motte-z,

I can see the problem here too.

Will look at it, more closely.

The fence selection seems to be wrong if we use a 3d-polyline
as the linear entity.

Or there is a problem in the getz function

ymg
Title: Re: Triangulation (re-visited)
Post by: ribarm on May 03, 2015, 10:13:55 AM
ymg, TriangV0.6.2.6 works as desired but profile is wrong... Tested with LINE entity...

[EDIT : Oh I see DATUM value must be added to distance to be match with value in table]... So it's OK...
Title: Re: Triangulation (re-visited)
Post by: ymg on May 03, 2015, 10:30:35 AM
Marko,

I've changed completely the way I calculate the profile.

Used to be Lawson's Walk to get the triangle number.

Now I find the triangle and intersections by exploiting
the return of ssnamex after using the linear entity
as a fence to get the selection set.

Although in version 0.6.2.6 that change was already there.

It is very possible that there is a bug in there.
Will look at it, or maybe you can spot it before me.

I've looked at it too long now, seeing doubles  :-)

ymg
Title: Re: Triangulation (re-visited)
Post by: ribarm on May 03, 2015, 10:59:41 AM
Ok ymg, I've spoted where is bug... It's in :

Code - Auto/Visual Lisp: [Select]
  1. (defun get_3dfpts (en / ent p1 p2 p3)
  2.    (setq ent (entget en)
  3.           p1 (cdr (assoc 10 ent))
  4.           p2 (cdr (assoc 11 ent))
  5.           p3 (cdr (assoc 12 ent))
  6.    )
  7.    (if (equal p1 p2)
  8.       (list p2 p3 (cdr (assoc 13 ent)))
  9.       (list p1 p2 p3)
  10.    )
  11. ;|  
  12.    ;; Insuring that Faces are  Listed Counterclockwise                        ;
  13.    
  14.    (setq x (car p1) y (cadr p1))                
  15.    (if (minusp  (- (* (- (car p2) x)(- (cadr p3) y)) (* (- (car p3) x)(- (cadr p2) y))))
  16.       (setq tp (list p1 p3 p2))
  17.       (setq tp (list p1 p2 p3))
  18.    )
  19. |;
  20. )
  21.  

I've commented what's different from V0.6.2.6
It works now by my tests, and I've slightly changed (centroid) to (centgrav) function. I think that it's just slightly more reliable...
I'll attach my revision...
Title: Re: Triangulation (re-visited)
Post by: ymg on May 03, 2015, 11:32:15 AM
Marko,

I did spot it also.

Need to change function get_3dfpts to this:

Code - Auto/Visual Lisp: [Select]
  1. (defun get_3dfpts (en / ent p1 p2 p3 p4)
  2.    (setq ent (entget en)
  3.           p1 (cdr (assoc 10 ent))
  4.           p2 (cdr (assoc 11 ent))
  5.           p3 (cdr (assoc 12 ent))
  6.    )
  7.    (if (equal p1 p2)
  8.       (setq p1 p2  p2 p3  p3 (cdr (assoc 13 ent)))
  9.    )    
  10.    
  11.    ;; Insuring that Faces are  Listed Counterclockwise                        ;
  12.    
  13.    (setq x (car p1) y (cadr p1))                
  14.    (if (minusp  (- (* (- (car p2) x)(- (cadr p3) y)) (* (- (car p3) x)(- (cadr p2) y))))
  15.       (list p1 p3 p2)
  16.       (list p1 p2 p3)
  17.    )
  18. )
  19.  

ymg

Title: Re: Triangulation (re-visited)
Post by: ribarm on May 03, 2015, 11:49:47 AM
Thanks ymg, it works...

M.R.
Title: Re: Triangulation (re-visited)
Post by: ymg on May 03, 2015, 11:50:23 AM
Here is the Lisp, with bug in function c:prof corrected.

I need your feedback about layer control.

Should we move the Points Block to the layer "Point name of surface " ?

As it is when they are points instead of blocks I move them.

Also notes that a 3d polyline cannot be used as the linear entity
for the profile.  This capacity will be in next revision.

Profile from Contour Lines is not implemented yet.

I believe there is still a bug in drawing the profile when
we have points with negative elevation.  Will correct also
in next revision.

ymg
Title: Re: Triangulation (re-visited)
Post by: motee-z on May 03, 2015, 05:37:42 PM
Hello ymg
i copied a 3dface generated by last version of triangulation
and with same points i created a 3dface using 3dface command
so the 2 3dface are same if we want to get z value inside
so if apply the function get z value on your 3d face it gave point outside
but if applied on second one i get elevation
what i am asking for. is there is any difference in creating 3dface
why function worke on one and on the second not work
that mean there is defference between 2 3dface
any clarification please
attached here the 2 3dface
Title: Re: Triangulation (re-visited)
Post by: ymg on May 04, 2015, 04:20:54 AM
motee-z,

As it is, the getz funtion actually "Bombed Out"
if the 3dface is completely flat.

So added a test in there to prevent that error.
will be in next revision.

Code - Auto/Visual Lisp: [Select]
  1. ;;                                                                            ;
  2. ;; getz     by ymg                                                            ;
  3. ;;                                                                            ;
  4. ;; Given point p and triangle defined by points t1, t2, t3                    ;
  5. ;; Returns: (x y z) where z is on face of triangle.                           ;
  6. ;;                                                                            ;
  7. ;; Added test to prevent Division by Zero    May 2015                         ;
  8. ;;                                                                            ;
  9.  
  10. (defun getz (p t1 t2 t3 / n1 n2 n3 x x1 x21 x31 y y1 y21 y31 z1 z21 z31)
  11.    (setq  x (car  p)  y  (cadr p)
  12.          x1 (car t1) y1 (cadr t1) z1 (caddr t1)        
  13.         x21 (- (car t2) x1)  y21 (- (cadr t2) y1) z21 (- (caddr t2) z1)
  14.         x31 (- (car t3) x1)  y31 (- (cadr t3) y1) z31 (- (caddr t3) z1)
  15.          n1 (- (* y21 z31) (* z21 y31))
  16.          n2 (- (* z21 x31) (* x21 z31))  
  17.          n3 (- (* x21 y31) (* y21 x31))
  18.    )
  19.    (if (zerop n3)
  20.       (list x y z1)
  21.       (list x y (/ (+ (* (- x1 x) n1) (* (- y1 y) n2) (* z1 n3)) n3))
  22.    )  
  23. )
  24.  

ymg
Title: Re: Triangulation (re-visited)
Post by: motee-z on May 04, 2015, 04:37:23 PM
yes ymg
but the 3d face not flat
and i mean in my question what is the difference between the 2 3dface they are the same dimension same elevation points
 but there are difference i don,t know where
Title: Re: Triangulation (re-visited)
Post by: ymg on May 04, 2015, 05:16:10 PM
motee-z

When I opened your drawing they were not the same.

First one has elevation 1097.52, 1097.52 and 1097.55
The second has 1097.55, 1097.55, 1097.55

Look at the result from entget below:

Quote
Command: (entget (car (entsel)))

Select object: ((-1 . <Entity name: 7ffff61ccf0>) (0 . "3DFACE") (330 . <Entity
name: 7ffff6059f0>) (5 . "1C7") (100 . "AcDbEntity") (67 . 0) (410 . "Model")
(8 . "TIN Natural Ground") (100 . "AcDbFace") (10 18.4842 6.96325 1097.52) (11
18.4842 6.96325 1097.52) (12 15.9999 14.4341 1097.52) (13 13.6163 8.10007
1097.55) (70 . 0))

Command: Specify opposite corner or [Fence/WPolygon/CPolygon]:
Command: (entget (car (entsel)))

Select object: ((-1 . <Entity name: 7ffff61cd80>) (0 . "3DFACE") (330 . <Entity
name: 7ffff6059f0>) (5 . "218") (100 . "AcDbEntity") (67 . 0) (410 . "Model")
(8 . "0") (100 . "AcDbFace") (10 21.4421 6.98593 1097.55) (11 26.31 5.84911
1097.55) (12 23.8257 13.32 1097.55) (13 21.4421 6.98593 1097.55) (70 . 0))


ymg
Title: Re: Triangulation (re-visited)
Post by: motee-z on May 04, 2015, 06:16:44 PM
oh my god you are right ymg
actually i applied polyline command by mistake instead of 3dface command on a gray 3dface 
ok any way if we make another 3dface same head point using 3dface command and move it for comparing there will different 
apologize me for mistake
Title: Re: Triangulation (re-visited)
Post by: ymg on May 04, 2015, 06:28:08 PM
motee-z

No need to apologize, to err is human.

ymg
Title: Re: Triangulation (re-visited)
Post by: Lee Mac on May 04, 2015, 06:31:40 PM
to err is human.
to forgive, divine.
- Alexander Pope

One of my favourite quotes  :-)
Title: Re: Triangulation (re-visited)
Post by: pedroantonio on May 05, 2015, 01:02:54 PM
Hi ymg . Is it possible to update the profile to support two terrain models.
For example i have measure this month an area and i have one terrain model with some section. After 5 months i measure the same area  and i want to calculate the volume of the
 fill and cut .In that case i have to update the same sections with a second line with new elevetions .(Draw one section first and then use the command to superimpose a second section.)


* * *  All this must be better if we have cross sections ,no length sections !!!! :-)

Thansks
Title: Re: Triangulation (re-visited)
Post by: ymg on May 05, 2015, 03:43:16 PM
topographer,

It is possible and planned at some point in the future.

I have in mind to implement extraction of Cross-Sections.  Idea would be to select the Alignment, select how long the section should be and at which interval,  then let it go.

If you extract the same Alignment from two different TINS, you could overlap the sections.

Right now, you can extract the same profile from two tins in the same drawing.  This is why
every TIN has a name, which correspond to the layer where it is kept.

Volumetry directly from the TINS, is also planned.  You probably saw a few post back some exchanges of ideas that I had with Marko Ribar on the subject.

This being said, this thing is a some sort of a toy to me.  I don't intend to put it up for sale and I certainly don't believe that it can be a replacement for C3D.  This is more like an educationnal undertaking.

So don't hold your breath for the above they may or may not come.

ymg
Title: Re: Triangulation (re-visited)
Post by: ymg on May 05, 2015, 04:56:37 PM
Quote
to forgive, divine.
- Alexander Pope

I must be very human, I err a lot!  :-)

ymg
Title: Re: Triangulation (re-visited)
Post by: ymg on May 06, 2015, 06:37:23 AM
Here, I've added 3D Polyline as linear entity.

The goal eventually is to turn them into alignment, complete with Vertical Curves, Horizontal Curves and/or Spiral Curves and be able to extract a profile under it.

Also corrected a few bugs and cleaned up the code a bit in c:prof.

There are some tiny change to the c:prof Dialog Box so do not forget to erase "tin.dcl" in your temp directory.

ymg
Title: Re: Triangulation (re-visited)
Post by: sanju2323 on May 07, 2015, 01:28:02 AM
ymg, need to improve profile datum. Ex. Datum should be Roundup and Datum Value starts above 2 meters.
Title: Re: Triangulation (re-visited)
Post by: ymg on May 07, 2015, 03:24:54 AM
sanju,

In the dialog box, there is an entry for elevation minimum.

As it opens it tells you the min and max of your Z data,
you enter in the min box the datum you want.  Say in the
case of your example al you have to do is enter 200 in that
edit box.

I use to calculate it, but very often you still need to change
because you want to be able to align two different profiles.

ymg
Title: Re: Triangulation (re-visited)
Post by: sanju2323 on May 07, 2015, 04:43:17 AM
ymg,
        You are right, I understand where my mistake. Thank you very much for Guidance.
Title: Re: Triangulation (re-visited)
Post by: ymg on May 07, 2015, 06:04:13 AM
sanju,

There is no right or wrong here.

It is simply a design choice.  I like to see the real minimum and maximum of the data
on opening the dialog.

What you proposed is also a possibility, but would need to add the real min and max
to the DCL, and I find it already a little too cluttered.

ymg
Title: Re: Triangulation (re-visited)
Post by: sanju2323 on May 07, 2015, 08:54:18 AM
ymg,
    is that possible to generate multiple cross section (profile) selected polylines.
Title: Re: Triangulation (re-visited)
Post by: ymg on May 08, 2015, 11:00:31 AM
Sanju,

Yes, It is possible and planned at one point.

However, to be really useful Cross-Sections need to be related
to a real Alignment not a simple polyline.

As you extract Cross-Sections you normally wants to relate them
to a standard section or at the very least to the elevation of the
reference Axis.

Working! on it.

ymg
Title: Re: Triangulation (re-visited)
Post by: ymg on May 08, 2015, 11:21:13 AM
Here new Revision 0.6.4.0

Done some change in the c:prof command.

If you enter 0 or a Negative Number in the Horizontal Increment edit box,
the profile will be generated at each intersections with 3DFACES.

I've also implemented (As per Sanju's request) automatic extent and increment
for the Graph of the profile.

The real spread of the Z data gets printed on the command line just before
opening the DCL.

ymg
Title: Re: Triangulation (re-visited)
Post by: sanju2323 on May 08, 2015, 11:46:06 PM
ymg,
      I have a sample file attachment standard format. You can add additional detail your own profile belongs it.
Title: Re: Triangulation (re-visited)
Post by: ymg on May 09, 2015, 03:19:10 AM
Sanju,

Yes, there are many styles of profiles.

Personnally, I dislike grids, they simply add clutter.
The distance band also does not add much information.
Don't like either the many colors of Text, (Christmas Tree Syndrome).

Only thing, I might add is a vertical tick bar on the left.
And more important than this, either symbol or text showing
the location of TC's and CT's. Same for spirals or Vertical curves
when present.  Some do it in a band, not sure I like it either.

This being said, we could implement a ton of options for the
style of the profile, as all necessary calculation are there.

We would need a popup dialog to choose these options, as the
one for basic profile is already cluttered.

Not planning on doing it soon.

ymg
Title: Re: Triangulation (re-visited)
Post by: ribarm on May 10, 2015, 03:23:43 PM
ymg, I've found some issues with TriangV0.6.4.0.lsp... If you can look into gif, I've marked my revisions... I'll attach my mod, but if someone sees some more things, please let us know...

M.R.
Title: Re: Triangulation (re-visited)
Post by: ymg on May 10, 2015, 03:42:08 PM
Marko,

The gif does not make sense to me, or maybe you attached the wrong one ?

Also looked into the attached lisp file, but could not see what the issue was about.
Anyway i
It's getting late here, so maybe my eyeballs are not in the proper position.

May take a little while before I reply properly, as I will be traveling for the next 10 days.

ymg
Title: Re: Triangulation (re-visited)
Post by: ribarm on May 10, 2015, 04:26:49 PM
ymg, I couldn't make better gif as it's big for the site... I'll explain :
- you told us to delete tin.dcl from temp folder, but you could make it be deleted automatically after usage, so I removed "fn" variable from locals and used (vl-file-delete fn) after two places (unload_dialog ...)... Now you can make updates to dcl and every new one will be actual...
- subfunction (regular) which is used in XSHAPE command had some typos, so I've modified it, not so important thing as it works and without my mod, but I think this was to be written correctly...
- finally at the end when main program is working, I've found that sometime CAD can't find distatpoint as point isn't on selected line, pline and to me it returned for first point dist nil and it should return 0.0...
So this line :
Code: [Select]
   (if (= opt 1)
      (progn
   (setq disl (mapcar '(lambda (a) (vlax-curve-getDistAtPoint en a)) pol))
...
I've replaced with :
Code: [Select]
   (if (= opt 1)
      (progn
   (setq disl (mapcar '(lambda (a) (vlax-curve-getDistAtPoint en (vlax-curve-getClosestPointTo en a))) pol))
...
and it worked - command PROFILE didn't fail...

Also I've noticed that you must start PROFILE command and cancel dialog to get displayed min and max Z values of section TIN, but I think that's not so important... DATUM values are recognized correctly in dialog, only this is little unexpected procedure for someone that wants to modify DATUM values...

So that's all that I've found till now... It works fine, congrats ymg...
Title: Re: Triangulation (re-visited)
Post by: ymg on May 10, 2015, 05:36:29 PM
Marko,

Yes I realize we could automate the cleaning of tin.dcl from the temp
directory.

However by doing so, we need to re-create every time we run the program.
But this is not a big issue, just a matter of preference.  However with the number
of revisions I am cranking out, your suggestion make sense.

Although, I never experienced any issues the suggestion of adding (vlax-curve-getClosestPointTo en a) is a safer way to go about it.  So It will be added.

The last comment about canceling the dialog, I do not understand.  The minZ and maxZ are written
to the command line area, before starting the dialog.  So I do not cancel and restart it.
This is there, only as a matter of preferences as I like to see the range of the data, although
function nicetick should give us reasonable values.

I appreciate your comments as they are always well researched.

Thanks!!,

ymg

Title: Re: Triangulation (re-visited)
Post by: ribarm on May 11, 2015, 12:02:53 PM
Hi ymg, I had free time, so I've updated your code on V0.6.4.1 ... I've added an option to erase inside polyline points along with 3DFACEs and I've formatted code so that it looks from notepad ++ like in VLIDE (replaced tab char with 8 spaces chars)... So from now I suggest you that you use space while writing... I'll attach LISP along with DWG where you can test it's functionality... Something more is different - I've noticed that when using (ssget "_WP") or (ssget "_CP") if PDMODE is different than 0 (point is larger shown with style) - (ssget) may cross with selection and undesired points - point cross presentation and not exactly point, so I've added changing to sysvar PDMODE 0 value when c:TIN - this way it's ensured correct selection is made... Also added few cosmetic changes at the end (UCS - World and PLAN) so when you load TriangV0.6.4.1.lsp correct setting of those preferences are done... Also if I may conclude, new version operates with POLYLINE entities as Constraints that may or may not pass through POINTs... In my DWG there are 2 3dpolys that are independent of POINTs and TIN is made correctly with erasing inside points...

So you can experiment now with your versions, but I suggest that you check this one as I think you may continue to work and with it on future projects...

M.R.

[EDIT : Reattached TriangV0.6.4.1.lsp with my latest posted fix... Little more spaces reducing after lines of code... There were 8 downloads till reattaching...]
Title: Re: Triangulation (re-visited)
Post by: ymg on May 11, 2015, 04:06:18 PM
Marko,

Thanks for your effort, but I am already at version 0.6.4.4 at home.

Although, I value your input very much, I would appreciate if you would
refrain from posting revision to the program.  On your copy you may
of course do whatever suits you.

Although the 3d polyline not touching a point may be a need for you
I don't want the program to operate this way.

For my part constraint should go through points.

I will look at it, and see what gets implemented in the next version.

ymg
Title: Re: Triangulation (re-visited)
Post by: ribarm on May 12, 2015, 03:44:07 AM
ymg, I've noticed also that sometime eroding with [ + ] while XSHAPE bugs with nil...

I've changed this :
Code: [Select]
   (defun xshape (ratio / a b bl ch e kl lg ne ps tn tr v)           
      (setq kl nil)
               
      (setq ch (get_extcont) ;el (get_edges tl)
            bl (mapcar '(lambda (a b) (list a b)) ch (cdr ch))
                           
            lg (* (apply 'max (mapcar '(lambda (a) (distance (nth (car a) pl) (nth (cadr a) pl))) bl)) ratio)
      )
     
      (while bl
         (setq  e (car bl)
               bl (cdr bl)
               tn (/ (vl-position e el) 3)
               tr (nth tn tl)
         )
...

To this :
Code: [Select]
   (defun xshape (ratio / a b bl ch e kl lg ne ps tn tr v)           
      (setq kl nil)
               
      (setq ch (get_extcont) ;el (get_edges tl)
            bl (mapcar '(lambda (a b) (list a b)) ch (cdr ch))
                           
            lg (* (apply 'max (mapcar '(lambda (a) (distance (nth (car a) pl) (nth (cadr a) pl))) bl)) ratio)
      )
     
      (while bl
         (setq  e (car bl)
               bl (cdr bl)
               tn (if (vl-position e el) (/ (vl-position e el) 3) nil)
               tr (if tn (nth tn tl) nil)
         )
...

Note (if) statement in (while bl (setq ... )...) ... It seems that with this mod it won't exit with nil...
So implement this fix, if it's correct inside posted Triang.lsp ...

[EDIT : I've reattached TriangV0.6.4.1.lsp with this fix and setq-ed nl (neighbor list) after rebuilding triangle list if there were deletion of inside points of Constraints just in case other subfunctions need this variable and I see that some of them need it...]

M.R.
Title: Re: Triangulation (re-visited)
Post by: BlackCADDER on May 14, 2015, 07:26:44 PM
'ymg' you are a genius.
I am using your program right now to generate pipeline profiles on the 'wheatsone lng plant' project in West Australia.
In the past I would be using 12D. This program does the job. The client supplied a triangulation of the site, your program does the rest.
Again, great work.
Title: Re: Triangulation (re-visited)
Post by: chlh_jd on May 17, 2015, 06:05:32 AM
'ymg' you are a genius.
I am using your program right now to generate pipeline profiles on the 'wheatsone lng plant' project in West Australia.
In the past I would be using 12D. This program does the job. The client supplied a triangulation of the site, your program does the rest.
Again, great work.



1+
Title: Re: Triangulation (re-visited)
Post by: ymg on May 18, 2015, 08:46:08 AM
Thanks !! for all the praises.

But the "Genius" should go to the guys who invented those things.

ymg
Title: Re: Triangulation (re-visited)
Post by: pedroantonio on June 06, 2015, 03:10:16 AM
Hi ymg. Any news about TriangV0.6.4.0 .lsp .Any updated version ?

Thanks
Title: Re: Triangulation (re-visited)
Post by: mac0312 on July 13, 2015, 04:27:15 AM
ymg,
I use TriangV0.6.4.0 .lsp to generate a triangulation, but the program is running very slowly, and the ADS request error occurs. Please see the attachment!

Title: Re: Triangulation (re-visited)
Post by: ymg on July 13, 2015, 03:29:01 PM
mac0312,

The program will error with more than 32767 points due to
limitation on the acet progress bar.

You can either remove every call to acet-ui-progress or modify
to call every 10 or 100 points.

Removing will give you a bit of speed at the cost of not having
any feedback while the program is running.

The other item that slows thing down every point is being checked for duplicates
and whether they are part of breaklines.  It does take time.

If you are sure that you do not have duplicates, you could bypass that.

ymg


Title: Re: Triangulation (re-visited)
Post by: mac0312 on July 14, 2015, 12:05:33 AM
ymg,thank you very much for your detailed explanation.
Title: Re: Triangulation (re-visited)
Post by: ymg on July 26, 2015, 11:15:45 AM
Here I've added Depression Contour Handling in this version.

(Corrected a bug in version 6.5.0, rplaced by version 6.5.1)

ymg
Title: Re: Triangulation (re-visited)
Post by: vpatilhas on July 31, 2015, 06:52:45 AM
Hy

Ymg

I can use the lisp with triangulation already made or how we correct the errors of triangulation in order to make a correct contour?

Thanks
Title: Re: Triangulation (re-visited)
Post by: ymg on July 31, 2015, 08:18:55 AM
vpatilhas,

Not sure I understand your question,  but If your drawing already contains
a triangulation, you can obtain Contours with command "c:cont" and then
selecting the 3DFACES in your triangulation.

Maybe upload an example drawing of an existing TIN to see what errors
you are talking about.

ymg
Title: Re: Triangulation (re-visited)
Post by: sanju2323 on August 01, 2015, 06:37:34 AM
ymg,
         Your Triang V0.6.5.0 Lisp file does not work very well. Please check the TEST.dwg file and rectify error.
Error shown as "TIN V0.6.5.0 - Elapsed time: 6.037 secs, 10278 3DFACESA vertex was added to a 2D pline (0) which had only one vertex. Error: bad argument type: 2D/3D point: nil"
Title: Re: Triangulation (re-visited)
Post by: ribarm on August 01, 2015, 08:00:01 AM
I've checked your DWG and used newest Triang version and I did get the same results, but without additional error message...

TIN V0.6.5.0 - Elapsed time: 6.037 secs, 10278 3DFACES
Title: Re: Triangulation (re-visited)
Post by: ymg on August 01, 2015, 08:16:33 AM
Sanju,

No error  here with your test drawing.

ymg
Title: Re: Triangulation (re-visited)
Post by: ribarm on August 01, 2015, 08:27:23 AM
Ahh, yes sanju, I forgot to turn on contours... Yes, I did get the same error, but with previous version it did fine :

Delete points inside Constraints [Yes/No] <Yes> :

     TIN - Elapsed time: 5.1480 secs, 10278 3DFACES
 CONTOUR V0.6.4.1 - Elapsed time: 153.5680 secs, 135 LWPOLYLINES, 27628 Vertices.Regenerating model.

My apology for my blunder...
Title: Re: Triangulation (re-visited)
Post by: ymg on August 01, 2015, 08:37:39 AM
Sanju,

Got the error in Contour, will check and post any correction.

ymg
Title: Re: Triangulation (re-visited)
Post by: ymg on August 05, 2015, 01:31:40 PM
Sanju,

Found the bug, here is correction as Version 6.5.1

Title: Re: Triangulation (re-visited)
Post by: sanju2323 on August 06, 2015, 02:32:27 AM
Thank you ymg to fix the problem of contour.
Title: Re: Triangulation (re-visited)
Post by: sanju2323 on September 16, 2015, 11:21:26 AM
ymg, You can update your lisp files. Multiple cross section generates, Please download attachment sample copy.
Title: Re: Triangulation (re-visited)
Post by: ymg on September 17, 2015, 06:45:21 AM
sanju,

I do plan to do it eventually.

Not been working on it actively. 

As told earlier, to be really useful we would need to
define alignment.

ymg
Title: Re: Triangulation (re-visited)
Post by: sanju2323 on September 18, 2015, 08:52:39 AM
ymg,

LISP file that might help every one related in civil field and survey field people, because we are using Autocad different type. For Example Autocad map, Autocad civil, and too many but it is a matter of seeing all the time using the single lisp and can work in any Autocad.

sanju.
Title: Re: Triangulation (re-visited)
Post by: Viswa Karma on September 28, 2015, 09:10:58 AM
Command: appload
TriangV0.6.5.1.LSP successfully loaded.


Command:
Triangulation V0.6.5.1 loaded...!
Command:
Command: tin

Select objects: all
5150 found

Select objects:

Error: no function definition: ACET-UI-PROGRESS
Title: Re: Triangulation (re-visited)
Post by: Viswa Karma on September 28, 2015, 09:12:10 AM
Command: appload
TriangV0.6.5.1.LSP successfully loaded.


Command:
Triangulation V0.6.5.1 loaded...!
Command:
Command: tin

Select objects: all
5150 found

Select objects:

Error: no function definition: ACET-UI-PROGRESS
Title: Re: Triangulation (re-visited)
Post by: ymg on September 28, 2015, 10:00:25 AM
Viswa,

You need Express Tools enabled in order to use the program.

ymg
Title: Re: Triangulation (re-visited)
Post by: TopoWAR on September 30, 2015, 08:07:16 PM
Hello friends!! The following DWG file upload because by using the function c:cont returns an error me, wanted to know if anyone can check it, thank you for this excellent application.

error:
Quote
Error: bad argument type: 2D/3D point: nil

the problem: tin creates triangle is in a straight line or as a line, I had made a function to remove triangles where two of its points are the same, something like:
Code: [Select]
(if (or (equal p1 p2 0.0001) (equal p2 p3 0.0001))
()
(setq n_tl (cons temp n_tl)))
Title: Re: Triangulation (re-visited)
Post by: ymg on October 01, 2015, 11:42:35 AM
TopoWar,

There is still a bug in the handling of contour when a point lies
exactly on the contour.

Will check it out and post a revision.

ymg
Title: Re: Triangulation (re-visited)
Post by: TopoWAR on October 01, 2015, 03:10:10 PM
ok, thanks for answering, would have to make a function that excludes items that are on the lines break or break lines, I could do that, but you have better knowledge than I about the lisp. thanks to the pending review, I am very grateful for the work in this routine!
Title: Re: Triangulation (re-visited)
Post by: ymg on October 01, 2015, 04:09:43 PM
TopoWar,

The problem is not with the breaklines, but in the contouring
when some of the point are right on the z of contour.

A workaround pending the revision would be to move everything
up or down by a few millimeters and then call contour.

I will hopefully post a revision by the end of the day tomorrow.

Hasta Luego!

ymg
Title: Re: Triangulation (re-visited)
Post by: TopoWAR on October 01, 2015, 04:14:01 PM
now I understand! thanks for everything!
Title: Re: Triangulation (re-visited)
Post by: ymg on October 01, 2015, 04:30:49 PM
TopoWar,

Here I attached your drawing.

I contoured after moving all points up by 3 millimeters.

I then moved back everything but the contours at
previous position.

Note that I edited your "Linea de Quiebres" by recreating
then as 3dpolyline going from node to node.

ymg
Title: Re: Triangulation (re-visited)
Post by: squirreldip on October 02, 2015, 06:52:43 PM
I've been looking through this thread and wish to give a huge bravo to all involved.

This has some incredible possibilities and I was thinking of some possible improvements:


First thought:

Has there been any thought to using a database for storage of the TIN utilizing something like the work that nullptr has done here http://www.theswamp.org/index.php?topic=28286.0 (http://www.theswamp.org/index.php?topic=28286.0)?

If a database was implemented could the TIN creation be faster and/or larger data sets?


Second thought:

(This may also be tied to the first)

What if the TIN was to utilize a simple attributed block for definition.  The block could define the database file location, the display of the TIN (i.e triangles on/off, contours on/off, boundary on/off, contour increments, etc...)

I'm thinking the block could be placed into the drawing and then routines run against the block.
A user could then have a set of routines for, say, adding points, adding breaklines and updating the display.


Third thought:

If the TIN were to be defined in a block then I see two useful routines that could be created...

(GetElevation TIN P)

TIN = Handle of the TIN
P = 2D Point
Return = Elevation (or nil)

and

(GetSection TIN P1 P2)

TIN = Handle of TIN
P1 = 2D Start Point
P2 = 2D End Point
Return = List of 3D points starting at P1 and ending at P2 including all intersections of edges.
Title: Re: Triangulation (re-visited)
Post by: ymg on October 03, 2015, 08:35:55 AM
squirreldip,

Adding an interface ta a database would probably slow things considerably.

As it is, a tin normally should be named.  So you can have many different TIN
in the same drawing.  There is a command named "TOG" that let you isolate
layers so only the tin or contours are visible. That part of the interface
does need some additionnal work.

The getsection routine is actually available and part of the (c:prof) routine.
If you draw a line on the Tin and execute c:prof, you have it with a grid.

What is planned is to choose an alignment and draw all the sections on a
given spacing along the alignment, including sections at beginning and end
of curves.

Bear in mind, that this done in lisp, so anything over 20,000 points is pushing it.

ymg

 
Title: Re: Triangulation (re-visited)
Post by: squirreldip on October 04, 2015, 02:45:48 AM
In my testing I've found that the limit seems to be closer to 10,000 points.

Alignments and cross sections is where I'd like to see this go (I'm a transportation engineer) - I have alignment routines that emulate what was done back with Land Desktop and use them extensively.  It's difficult in Civil3D to define complex geometry for large interchanges (for example) and custom lisp programming has proved very valuable in my design work.

For alignments I've developed base routines that 'Get Alignment', 'Write Alignment' and 'Draw Alignment'.  With an alignment defined I've found that two basic routines required -> given a coordinate return the Chainage and Offset and given a Chainage and Offset return the coordinates.  Create the building blocks and all other ideas will fall into place.  (Also similar routines for Profile and Superelevation).

My experience with Alignments and Profiles is why I'm suggesting building the TIN as a simple object and then having a few building block tools to run against it.  With these developed so many other tools can be created.

Most of the datasets I use are much, much larger than 20,000 points so I'm stuck using the Civil3D surfaces.  I'd really like to find a solution that will work without Civil3D.
Title: Re: Triangulation (re-visited)
Post by: ymg on October 04, 2015, 04:37:59 AM
squirreldip,

I agree with you that alignment is the way to go.

Unfortunately, this is probably the weakest part
of  "Triang" at this point.

One way to keep a triangulation would be to compress
it and keep the point in an ordering that permits to rebuild
it in linear time. (see the work of Mark Kreveld)
I know it is possible for Delaunay Triangulation but I am not sure
if it can be done with a Constrained triangulation.

Alignment would need a way to represent spirals and vertical curves.
They also need to refer to  typical section for a given chainage.
Superelevation, either through Design Speed parameters or chainage
also must be kept with the alignment.  Yet another item are widenings
of the roadway.

So lots of work!

ymg
Title: Re: Triangulation (re-visited)
Post by: squirreldip on October 04, 2015, 05:24:17 AM
I've attached my routines for creating alignments.  Alignments are defined by LWPolyline or separate entities - if separate entities they are lines/arcs/spirals (spirals are clothoid, defined as polylines with extended data - I tried to emulate how LDD created spirals which hadn't changed from the original DCA programs back in mid '80s).

All 6 routines must be loaded.

basic routines are:

GALIGN : Gets alignment - select start point, start station and then select polyline (or <return> to select collection of entities then the program will link them endpoint to endpoint)
WALIGN : Writes the alignment to a text file
RALIGN : Reads the alignmet from a text file
DALIGN : draws the alignment
DALIGNOS : draws an alignment at a specified offset

FITSPIRAL : will create a spiral-curve-spiral corner when two lines are selected or fir a spiral between a line and an arc.

Alignments are stored in a variable ALIGNLIST - list of alignment entities:
TANGENTS/ARCS : (STA P1 P2 BULGE OFFSET)
SPIRALS : same but BULGE is list (PLT PI PST Lo)
PLT = Long Tangent Point
PI = Spiral PI
PST = Short Tangent Point
Lo = Compound Spiral Cutoff Length (0 for full spirals)

Plus two analysis routines:

(XY (list STA OFFSET)) : Returns a list (X Y)
(STAOFF (list X Y)) : Returns a list (STA OFFSET)

There's other routines defined in the files - I think most of their names are pretty explanatory for what they do...

These were created many years ago by myself.  Originally in the mid 90's when I was working in Kuala Lumpur on their Bombardier LRT.  Also originally in Lisp but moved to Watcom C back in the DOS days - moved back to Lisp in the early days of Windows and most recently I've rewritten most of the routines in VB.NET to increase the speed.  I've used these for creating alignments with hundreds of entities - longest I've worked with is just over 150km long.  The speed is needed when solving iteratively (I've got routines for 3D modelling of LRT trains which are very processor hungry and the lisp version is too slow).

These were written long ago so the programming style may not be up to what others may expect and there's very little documentation in the files.

I also have Profile (parabolic vertical curves) and Superelevation (basically lists of station/left super/right super) alignment programming but I'll leave you with this to have time to look and review.

I hope these will be of some benefit.

Edit:  Added AArc.lsp which adds 3 routines:  ALINE, AARC, ASPIRAL (note for AARC +ve radiis are to the left and -ve are to the right)
AARC : Attach Arc to selected entity
ALINE : Attach Line to selected entity
ASPIRAL : Attach Spiral to selected entity
Title: Re: Triangulation (re-visited)
Post by: ymg on October 04, 2015, 07:32:35 AM
squirreldip,

Thanks for the upload, I will take a look at them and revert.

ymg
Title: Re: Triangulation (re-visited)
Post by: AARYAN on October 14, 2015, 07:46:05 AM
Hello ymg,

While trying to make contours (Major - 1 & Minor 0.5 with max smoothening) I am getting an error (bad argument type: numberp: nil). Can you please test the attached xyz file from your end.
Title: Re: Triangulation (re-visited)
Post by: ymg on October 14, 2015, 05:31:26 PM
aaryan,

If you want me to test, upload the drawing with the points plotted

Problem is probably the bug due to point with a z eaqual to contour.

Try to move everything by up or down by 3 milli.

This is a workaround until I finish debugging.

ymg
Title: Re: Triangulation (re-visited)
Post by: pedroantonio on November 15, 2015, 10:16:54 AM
Hi ymg. Any news about TriangV0.6.4.0 .lsp .Any updated version ?

Thanks
Modify message
Title: Re: Triangulation (re-visited)
Post by: ymg on November 15, 2015, 12:47:29 PM
Topographer,

Not yet, done some progress though on the problem in Contour.

ymg
Title: Re: Triangulation (re-visited)
Post by: ymg on November 16, 2015, 09:40:25 PM
Here is Triang V0.6.5.5

Finally got around to fix the bug in Contour generation.

Also fixed another one, where we could get into an endless loop
when clearing holes in the triangulation.

Sorry about the delay.

ymg
Title: Re: Triangulation (re-visited)
Post by: TopoWAR on November 17, 2015, 10:27:40 AM
YMG , Thank you for your work in this routine, very grateful !!! :-D :-D
Title: Re: Triangulation (re-visited)
Post by: ymg on November 17, 2015, 01:25:48 PM
TopoWar,

The fix creates the contour 0.001 unit lower than it should when we
have a summit that is right on a contour interval.

Would appreciate feedback if you test it.

ymg
Title: Re: Triangulation (re-visited)
Post by: TopoWAR on November 17, 2015, 02:49:46 PM
YMG , Hello, I've done some tests, the above error is gone, but I found an error I've seen for a long time, the routine creates a bad triangle, the point of the triangle 2 3 4 is in the same direction, this occasions that by making the curves generating an error, this routine may well, the wrong triangle is created to be a point in the middle of a line, it is assumed that the user should not do this, but few would know, in order see dwg, in previous versions I had made a function that eliminated the triangles where the angle was the same between the vertices 2-3 3-4. Thanks and I hope comments.

run c: cont interval 0.25, returns error at the wrong triangle
Code: [Select]
see entity (handent "733b")
Title: Re: Triangulation (re-visited)
Post by: pedroantonio on November 17, 2015, 03:02:13 PM
Hi TopoWAR your breaklines is not correct .Look the attach file and you will understand.
Title: Re: Triangulation (re-visited)
Post by: TopoWAR on November 17, 2015, 03:10:06 PM
Topographer ,You are right, I know the lines are wrong, the question is, how many people know that the lines are not done well? for example, a client sent me the file so that you do the corners, had thousands of lines, the routine did not work, I had to start investigating where the error occurred, what I say is: is there any way that the user know that that line break this bad?
Title: Re: Triangulation (re-visited)
Post by: ymg on November 17, 2015, 07:10:16 PM
TopoWar,

I will see what I can do to prevent this.

However, bear in mind that there always wiil be a way to
come up with something that will make it go wrong.

We are working with real number, hence finite precision.

Your example drawing is as bad as it gets.

However It did help in finding a few bugs. :oops:

ymg
Title: Re: Triangulation (re-visited)
Post by: TopoWAR on November 17, 2015, 07:15:57 PM
I understand, at some point I had solved the problem with the following code in previous versions.

Code: [Select]
(setq n_tl nil)
(foreach temp tl
      (setq p1 (list (car (nth 0 temp)) (cadr (nth 0 temp)))
    p2 (list (car (nth 1 temp)) (cadr (nth 1 temp)))
    p3 (list (car (nth 2 temp)) (cadr (nth 2 temp))))
      (if (or (equal p1 p2 0.0001) (equal p2 p3 0.0001))
()
(setq n_tl (cons temp n_tl))))
         (setq tl n_tl)
Title: Re: Triangulation (re-visited)
Post by: pedroantonio on November 18, 2015, 01:27:49 AM
Hi and forgive me but i know that the reason we use the breaklines is to help the program to understand what really happened in the field. So we add this break lines to draw the TINS correct. If we add wrong breaklines i don't know how the program  will understand that and fix it or alert us. The program can not know what we have measured outhere (in the field).It is our responsibility to add the  break lines  correct. If my friend TopoWar change the break lines in the drawing he will take other TINS for the same points. It was just a thought

Quote
how many people know that the lines are not done well? for example, a client sent me the file so that you do the corners, had thousands of lines, the routine did not work, I had to start investigating where the error occurred, what I say is: is there any way that the user know that that line break this bad?

I understand that. I also have clients who can not draw on autocad and i know topographers who do not use breaklines and there terrain models are complitely wrong. I was working to a topographer before some years  and he use Land Development 2002 to make the terrain model.For break lines he add a polyline and then change the polyline level to 0. He thought that his break lines are correct, but there are all wrong. After some time met another topographer and explain me  the correct way how to do the breaklines. He told me to add line from point to point because the line have other elevetion to the beginning and other elevetion to the end. And i have to pick all the points one -one. For that time i never trust any terrain model because the most clients don't know how to do it correct. They believe that thay will buy a programm and then  select all the points and BOOM Magic !!! :-D

Thanks
Title: Re: Triangulation (re-visited)
Post by: TopoWAR on November 18, 2015, 10:29:33 AM
Hi, I know you are right, I'll make a little guide to how you should make the breaklines, which are point-to-point logically, this for people who do not know, the routine works perfectly to thank you for the effort all !!!! Cheers!!!! :-D
Title: Re: Triangulation (re-visited)
Post by: ymg on November 18, 2015, 09:37:18 PM
Found a bug in the c:prof function of Triang V06.5.5

Here is correction.

Starting work on Cross Sections

ymg
Title: Re: Triangulation (re-visited)
Post by: rw2691 on November 24, 2015, 10:45:49 AM
YMG,

I am late to your project, but I have installed your program and tried to use it. I am very impressed with what you have been able to do. I can't believe you have done it with Lisp, and that it is a small code.

There are a few features, however, that I think could be improved. Building a TIN captures the point nodes and moves them to its own layer, "Point Natural Ground." That means that the nodes that the user has created (usually on a special layer of his own) are gone. It would be better if you simply copied them... or require that we "Import Points" by your own routine. That way the user would still have his own data that are separate from your own.

On account of some points being bogus by elevation (such as being at 0.0 or 99999.0), it would be useful to have maximum and minimum settings where your code would ignore them when building a TIN. Points like that always slip in when gathering them by actual field work.

Flipping a TIN is usually done after you look at the contours. I think there should be a way to regenerate the contours (ie. by the routine erasing the existing ones first).

Points are usually selected by Windowing them, and many are caught that aren't valid. The result is that bogus TIN's get built. As is, I have to snoop around and delete them before doing the Contours. Usually they aren't so easy to notice, and I end up with bad contours. Perhaps there could be a setting to not create a TIN that has a side that exceeds a certain distance.

Another way, which I expect is more difficult, is to have Boundary lines as a perimeter (which are similar to Break lines for the TIN) but function as an irregular window where TIN's cannot be built outside of it. I expect that this is too much to ask for.

Something more I want to suggest... All of your private functions should be named uniquely. Such as instead of "rtd", make it "ymg-rtd", because others may have their own "rtd" and it could function differently from yours. The same, if you have any globals, they should have prefixed names as well for the same reason.

I have to say again... This is a hot code! I think I am going to be using it for my survey work (and I hope you don't mind). Your code is far more than a simple academic exorcise. It is worthy of being applied to work. As for myself, generating a TIN system has always been beyond my programming capabilities. Integrating the TIN's with breaklines is what has always snagged me. That you have done so with such elegance is simply fantastic.

Rick
Title: Re: Triangulation (re-visited)
Post by: ymg on November 24, 2015, 12:15:35 PM
Rick,

First thanks for your constructive comments.

On the points being sent to a layer, I more or less agree with you.
Original data, could be preserved.  However having points in a
lot of different layers is not a good idea either.  As it is you could triangulate
and leave the point where they were. The only function that would be affected
is c:tog that permits you to toggle layers on or off.

Filtering of the data for duplicates, and bogus elevation takes time.
At the moment only duplicates are filtered out.  As with any filtering
the problem is establishing the criteria.

If you erase manually the preliminary contour after flipping,
you can execute c:cont , select the 3dface and get the contour
updated.  Alternatively a small function could be written to do it,
or added at enf of flip routine.

If you want to trianguate and have more than one surfaces living in
drawing, some discipline needs to be exercised on which entities are
in the drawing.  Your previous example of bogus point should already
be filtered in the field.

Boundary  lines during implementation during triangulation would
probably slow thing down a lot.  Have you tried function "c:Xshape"
which erodes the outside of the tin and remove unneeded triangle.

The private function issue:  What need to be done is to localized the function
thus returning them to nil on completion.
I am totally allergic to the concept of having an initial prefix on function name.


Thanks again for constructive comments and suggestions.
Will probably act on some of them.

ymg
Title: Re: Triangulation (re-visited)
Post by: rw2691 on November 25, 2015, 01:29:18 PM
YMG,

I tried XSHAPE. At some point it always deleted too many TIN's, and its actions seem random.

I tried setting a 3dpoly around the perimeter, but it deleted the poly when it built the TIN's, and its actions did not regard it as a breakline.

I changed the poly to line segments, and the XSHAPE still deleted too many TIN's (those being inside the perimter).

My only resort was to manually delete the exterior TIN's, and not use XSHAPE. Since the breaklines were another color I could tell what I should delete.

I still think it would be effective for the TIN to erase all TIN's that have a side that is too long. The down side is that a TIN that meets that condition could be inside the net.

But Topo's always have a concentration of usable points that are within a certain distance. Usually at around 50'. Allowing the user to set a parameter by the TIN query (perhaps 75' or 100') would eliminate most of the bogus TIN's, so long as the points were collected with consistency.

I like that your program keeps the breaklines above the TIN. That allows me to easily see where something might be wrong with how the TIN's connect with each other.

Rick
Title: Re: Triangulation (re-visited)
Post by: rw2691 on November 25, 2015, 02:07:21 PM
YMG

Do you have to create a Voronoi net for the program to use the Voronoi principle? Or is the Voronoi net only demonstrational?

Rick
Title: Re: Triangulation (re-visited)
Post by: ymg on November 26, 2015, 09:22:21 AM
Rick,

The Voronoi does not need to be created and is not a requirement.

ymg
Title: Re: Triangulation (re-visited)
Post by: rw2691 on November 26, 2015, 02:25:25 PM
YMG,

Using PROF I snapped to a TIN frame on one side of the net, then snapped to another on the farther side.

It built the profile, but it always starts at 0+20. The elevation for 0+20 is also not the start of the polyline for the selection.

I drew a circle with the radius of 20' with its center at the start of the polyline. I checked the elevation where the circle intersects the TIN and near the polyline... it was the elevation posted for 0+20.

This happens with every profile. It appears that the 0+00 station is not being posted.

Rick
Title: Re: Triangulation (re-visited)
Post by: ymg on November 26, 2015, 03:30:57 PM
Rick,

Thanks! for the testing, I did fid this bug also and it is corrected
in Version 0.7.0 (not posted yet).

This version will extract section also.

Will post as soon as sections are completed.

ymg
Title: Re: Triangulation (re-visited)
Post by: rw2691 on November 26, 2015, 04:12:48 PM
YMG,

I did contours at all settings for rounding. I found that there are minimal differences between the settings. In particular there are always the same number of vertices. I wonder if you couldn't increase the vertices per the greater roundings. As is, roundings are less extreme paths, but it is not smoothing the course beyond their deflections. Actually, I would prefer to see more vertices and less distortion from the NONE setting.

Rick
Title: Re: Triangulation (re-visited)
Post by: ymg on November 26, 2015, 07:14:04 PM
Rick,

This is opening a big can of worms.

The method I use is Christensen's, If you look at the litterature
you will find that many other ways have been tried, but none surpass this.

The biggest hurdles is preventing contour from crossing.

I agree with you that the setting changing the degree of smoothing
does not change much of anything.

See here: http://www.theswamp.org/index.php?topic=9042.msg501947#msg501947

ymg
Title: Re: Triangulation (re-visited)
Post by: rw2691 on November 27, 2015, 09:25:23 AM
YMG,

I see you have had to work through a lot scenario's, and have chosen a best solution. If I need "good looks" for a presentation I can always turn them into quadratics.

Rick
Title: Re: Triangulation (re-visited)
Post by: ymg on November 27, 2015, 11:22:26 AM
Rick,

If you spline them, you are bound to get crossing contours.

ymg
Title: Re: Triangulation (re-visited)
Post by: rw2691 on November 27, 2015, 01:41:36 PM
YMG,

I have tried it with PEDIT SPLINE, which makes it a quadratic and not a spline. It hugs the lines and stays near the vertice points. I get nearly the same results smoothing at NONE and MAX. The MAX as quadratic keeps it near your pattern. The NONE as quadratic doesn't look bad. I haven't tested it on lines that are very close to each other. I have noticed that it is something I would have to do by copying the contours before converting them. It makes your functions fail. At least the labeling functions, and expect the PROF will crash as well. They aren't type of objects that you are looking for.

I read that your routines won't work without Express Tools installed. Would it be too much to ask what commands you are using that are Express Tools?

Rick

Title: Re: Triangulation (re-visited)
Post by: rw2691 on November 27, 2015, 03:25:00 PM
YMG,

Can ask what ** does in the following... 

** (princ (strcat  "Minimum Z value: "

...at about line 3924.

The line will be off because I have been adding my own comments.

Rick
Title: Re: Triangulation (re-visited)
Post by: rw2691 on November 27, 2015, 03:31:21 PM
YMG,

Never mind... I see that it is a variable. I've never seen anyone use *'s as a name before.

Rick
Title: Re: Triangulation (re-visited)
Post by: ymg on November 28, 2015, 09:50:31 AM
Rick,

I use it as a temporary variable whose value I don't really need.

Most of the times so that I can wrap everything into a "setq" and
eliminates a "progn".

ymg
Title: Re: Triangulation (re-visited)
Post by: rw2691 on November 28, 2015, 04:04:39 PM
YMG,

You do clever programming. Things that I never imagined. I have been unaware that many of the things are even possible. Kudo's!

Rick
Title: Re: Triangulation (re-visited)
Post by: rw2691 on November 29, 2015, 09:12:05 AM
YMG,

I would like to revisit quadratics. It is a very conservative model for curvature. Its weakness comes by a lack of data. When applied to your own contours, you have developed a control rib with your MAX resolutions. The lack of data has been reduced.

I haven't created any quadratics that have been unfaithful to those enhanced vertices's. In actual application I would always review your MAX conditions, and probably edit them manually... I would do the same after converting them to quadratics. For myself, it's no different than deleting bogus (exterior) TIN's.

In summary, quadratics do introduce a risk that requires a critical review. Nevertheless, as a practitioner and professional, my client always expects a refined product. For them, that is visual. Smoothness. For me it is a practical accuracy. I think that your MAX contouring, combined with quadratic's, makes that happen.

It's an argument. But also only a suggestion. I think it would be nice to have Quadratic Conversion available as an automated "last step" option to production. The contours could be placed on a new layer (having a different color), and comparisons and manual editing would be easy.

In fact a greater tool for analysis would be to have a Tin-Cntr layer, and also an Avg-Cntr (for the MAX values), and a Qdr-Cntr layer (built from the MAX/AVG) which can all be reviewed to aid any manual editing that you might do to the quadratic later... or opt for using any of the others.

Rick
Title: Re: Triangulation (re-visited)
Post by: ymg on November 29, 2015, 03:00:47 PM
Rick,

I have nothing against quadratics per se, just warning you about the caveat.

Another consideration  is how accurate will be the final contours.

For now, I am concentrating on finalizing the Cross-Sections extractions.
Might  add an option to annotates the alignment.

Also looking, as per your suggestion, into updating the contours as we flip
triangles.

That should bring me to Christmas.

ymg

Title: Re: Triangulation (re-visited)
Post by: rw2691 on November 30, 2015, 08:29:35 AM
YMG,

Good deal... don't let me overload you, and don't let me get away with being dumb. Happy Holidays to you.

Rick
Title: Re: Triangulation (re-visited)
Post by: rw2691 on December 01, 2015, 10:12:20 AM
YMG,

I have an idea for eliminating the bogus exterior TIN's...

1) Prior to a TIN network being built, provide a routine for the user to construct a straight-line polyline (as a boundary) by their valid exterior points. If it is not a single polyline (by messing up and restarting), have the user merge all of its polyline segments.

2) Prompt the user to select the boundary and indicate an offset direction and distance for a temporary offset polyline (by a foot more-or-less) to its outside.

3) At activating the TIN, the boundary can be exploded to be used as breaklines. The temporary polyline can be moved to a layer that is frozen.

4) The TIN proceeds to build.

5) At completion the TIN's that are intercepted (crossed/fenced) by the temporary polyline are deleted.

6) Delete (or freeze the layer for) the temporary polyline.

Note: Before deriving this scheme I had looked at Xshape to force it to not violate breaklines. Rather than possibly damage Xshape, I thought that this alternative might work just as well.

Rick
Title: Re: Triangulation (re-visited)
Post by: ymg on December 01, 2015, 01:47:06 PM
Rick,

If you are willing to draw a boudary before, of course it simply becomes a breakline.

However it is a closed breakline, so you would need a case where you do not clean
the inside of it but instead the outside.

Xshape, is simply a way to trace a boundary after the triangulation.

The routine to creates the boundary before would simply be creating
an lwpolyline  with node osnap on and placing it on the boundary layer.

Any 3dface outside that lwpoly gets erased. Triangle List is updated.

Could add it, although I prefer doing the boundary  after.

ymg

Title: Re: Triangulation (re-visited)
Post by: ymg on December 02, 2015, 09:51:32 AM
Rick,

Modify this section of c:tin
Code - Auto/Visual Lisp: [Select]
  1.           ;;                                                                  ;
  2.           ;; Building Points List  and Selection Set of Constraints           ;
  3.           ;;                                                                  ;
  4.           ;;  pl, List of Points (3D)                                         ;
  5.           ;;                                                                  ;
  6.           ;;     Entities that Creates Points are:                            ;
  7.           ;;           "POINT"     , 3D coordinates                           ;
  8.           ;;           "INSERT"    , Insertion Point of Block                 ;
  9.           ;;           "POLYLINE"  , Coordinates of all Vertices              ;
  10.           ;;           "LINE"      , Coordinates of Both Endpoints            ;
  11.           ;;                                                                  ;
  12.           ;; ssb, Selection Set of Constraints.                               ;
  13.           ;;                                                                  ;
  14.           ;;    Valid Entities for Constraints Are:                           ;
  15.           ;;          "LWPOLYNE"   , Vertex have to be on Existing Point      ;
  16.           ;;          "POLYLINE"   , Open or Closed (Same for LWpoly)         ;
  17.           ;;          "LINE"       , Make Sure you Have Z Value in Them       ;
  18.           ;;                                                                  ;
  19.          
  20.           (setq pl nil  ssb (ssadd) lay (mk_layer (list "Point" 7)))
  21.           (repeat (setq i (sslength ss))
  22.               (setq  en (ssname ss (setq i (1- i)))
  23.                     ent (entget en)
  24.                    etyp (cdr (assoc 0 ent))                    
  25.               )
  26.               (cond
  27.                  ((= etyp "LWPOLYLINE") (ssadd en ssb))
  28.                  ((= etyp "POLYLINE")
  29.                      (ssadd en ssb)
  30.                      (setq pol (listpol en))
  31.                      (foreach p pol
  32.                         (setq pl (cons p pl))
  33.                      )
  34.                      
  35.                  )
  36.                  ((= etyp "LINE")
  37.                      (ssadd en ssb)
  38.                      (setq   a (cdr (assoc 10 ent))
  39.                              b (cdr (assoc 11 ent))
  40.                             pl (cons a (cons b pl))                        
  41.                      )     
  42.                  )
  43.                  ((= etyp "INSERT")
  44.                      (setq pl (cons (cdr (assoc 10 ent)) pl))
  45.                  )
  46.                  ((= etyp "POINT")
  47.                      (setq  pl (cons (cdr (assoc 10 ent)) pl)
  48.                            ent (entmod (subst (cons 8 lay) (assoc 8 ent) ent)))
  49.                  )
  50.               )
  51.           )
  52.          
  53.           ;; Sort pl on X and Y Coordinates, then Remove Duplicates           ;
  54.          
  55.           (setq pl (remduppoint (sortxy pl) fuzz))
  56.  
  57.  
  58.           ;;                                                                  ;
  59.           ;; Building Constraints List                                        ;
  60.           ;;                                                                  ;
  61.           ;; cdtl, List of Points (3d) Forming Constraints                    ;
  62.           ;;                                                                  ;
  63.           ;;  nfl, List of Points in Constraint That Are Not in pl            ;
  64.           ;;       Simply Issues a Warning to User, Constraint is             ;
  65.           ;;       Ignored and Triangulation Allowed to Continue.             ;
  66.           ;;                                                                  ;
  67.           ;;  wpl, List of Points List, Closed Constraints (Closed Polylines) ;
  68.           ;;       With No Points Inside.  These List are Used at End of the  ;
  69.           ;;       Triangulation to Erase All 3dfaces Inside these Polygons   ;
  70.           ;;       by "WP" Selection and Triangle List is Adjsuted.           ;
  71.           ;;                                                                  ;
  72.          
  73.          
  74.           (if (> (setq len (sslength ssb)) 0)
  75.              (progn
  76.                 (acet-ui-progress "Gathering Constraints:"  len )
  77.                 (setq cdtl nil nfl nil wpl nil lay (mk_layer (list "Boundary" 2)))
  78.                 (repeat (setq i len)
  79.                    (setq  en (ssname ssb (setq i (1- i)))
  80.                          ent (entget en)
  81.                         etyp (cdr (assoc 0 ent))
  82.                    )
  83.                    (cond
  84.                       ((= etyp "LWPOLYLINE")
  85.                          (setq pol (listpol en)
  86.                                  a (pos2d (car  pol) pl fuzz)
  87.                                  b (pos2d (cadr pol) pl fuzz)
  88.                          )         
  89.                          (if (and a b)
  90.                             (setq cdtl (cons (list a b) cdtl))
  91.                             (setq  nfl (cons (list a b) nfl))
  92.                          )     
  93.                          (foreach p (cdr pol)
  94.                             (if (setq a (pos2d p pl fuzz))
  95.                                (setq cdtl (cons (list (cadar cdtl) a) cdtl))
  96.                                (setq  nfl (cons (list (cadar  nfl) a)  nfl))
  97.                             )
  98.                          )
  99.                          (if (and (equal (car pol) (last pol) 0.001)
  100.                                   (> (length pol) 2)
  101.                                   (not (ssget "_WP" (cdr pol) '((0 . "POINT"))))
  102.                                   (not (vl-position pol wpl))
  103.                              )
  104.                             (setq wpl (cons pol wpl)
  105.                                   ent (entmod (subst (cons 8 lay) (assoc 8 ent) ent))
  106.                             )
  107.                          )
  108.                       )
  109.                       ((= etyp "POLYLINE")
  110.                          (setq pol (listpol en)
  111.                                  a (pos2d (car  pol) pl fuzz)
  112.                                  b (pos2d (cadr pol) pl fuzz)
  113.                          )
  114.                          (if (and a b)
  115.                             (setq cdtl (cons (list a b) cdtl))
  116.                             (setq  nfl (cons (list a b) nfl))
  117.                          )
  118.                          (foreach p (cdr pol)
  119.                             (if (setq b (pos2d p pl fuzz))
  120.                                (setq cdtl (cons (list (cadar cdtl) b) cdtl))
  121.                                (setq  nfl (cons (list (cadar  nfl) a)  nfl))
  122.                             )
  123.                          )
  124.                          
  125.                          (if (and (equal (car pol) (last pol) 0.001)
  126.                                   (> (length pol) 2)
  127.                                   (setq pol (distinct (mapcar '(lambda (a) (list (car a) (cadr a))) pol)))
  128.                                   (or (not (ssget "_WP" pol '((0 . "POINT"))))
  129.                                       (equal en *bounden*)
  130.                                   )    
  131.                                   (not (vl-position pol wpl))
  132.                              )
  133.                             (setq wpl (cons pol wpl)
  134.                                   ent (entmod (subst (cons 8 lay) (assoc 8 ent) ent))
  135.                                          
  136.                             )
  137.                          )
  138.                       )
  139.                       ((= etyp "LINE")
  140.                          (setq a (pos2d (cdr (assoc 10 ent)) pl fuzz)
  141.                                b (pos2d (cdr (assoc 11 ent)) pl fuzz)
  142.                          )      
  143.                          (if (and a b)
  144.                             (setq cdtl (cons (list a b) cdtl))
  145.                             (setq  nfl (cons (list a b)  nfl))
  146.                          )                       
  147.                       )                
  148.                    )
  149.                    (progress nil)
  150.                 )
  151.                
  152.               )
  153.             )
  154.             (setq cdtl (reverse cdtl))
  155.             (acet-ui-progress)
  156.  
  157.          (triangulate pl) ; Delaunay's Triangulation                          ;
  158.          
  159.          
  160.                
  161.          ;;                                                                   ;
  162.          ;; Insertion of Constraints                                          ;
  163.          ;;                                                                   ;
  164.  
  165.          (if cdtl
  166.             (progn
  167.                 (setq ti (time))
  168.                 (acet-ui-progress "Inserting Constraint:" (length cdtl))
  169.                 (foreach k cdtl
  170.                   (addedge (car k) (cadr k))
  171.                   (progress nil)
  172.                 )              
  173.                 (acet-ui-progress)
  174.                
  175.                 ;;                                                            ;
  176.                 ;; Erasing Triangles in Holes of Triangulation, and those     ;
  177.                 ;; Outside of the boundary. Adjusting Triangle List.          ;
  178.                 ;;                                                            ;
  179.                 ;; Notes: This is a fast hack where we select 3Dfaces with a  ;
  180.                 ;;        Crossing Polygon then Computes their Centroid and   ;
  181.                 ;;        remove those whose centroid is inside the poly.     ;
  182.                 ;;                                                            ;
  183.                 ;;        Will change it eventually to offset the polyline    ;
  184.                 ;;        to the outside by a few millimeters, and make the   ;
  185.                 ;;        Selection by Window Polygon.                        ;
  186.                 ;;                                                            ;
  187.                
  188.                 (vl-cmdf "_ZOOM" "_E")
  189.                 (if *bounden*
  190.                    (setq bp (distinct (mapcar '(lambda (a) (list (car a) (cadr a))) (listpol *bounden*))))
  191.                 )        
  192.                 (foreach wp wpl
  193.                    (setq  ss (ssget "_CP" wp '((0 . "3DFACE"))))
  194.                    (repeat (setq i (sslength ss))
  195.                       (setq  en (ssname ss (setq i (1- i)))
  196.                             ent (entget en)
  197.                              tp (list (cdr (assoc 11 ent))
  198.                                       (cdr (assoc 12 ent))
  199.                                       (cdr (assoc 13 ent))
  200.                                 )
  201.                              ct (centroid tp)
  202.                              in (ptinpoly_p ct (cons (last wp) wp))
  203.                       )
  204.                       (if (or
  205.                              (and in (not (equal wp bp)))
  206.                              (and (not in) (equal wp bp))
  207.                           )    
  208.                          (setq tr (list (vl-position  (car   tp) pl)
  209.                                         (vl-position  (cadr  tp) pl)
  210.                                         (vl-position  (caddr tp) pl)
  211.                                   )
  212.                                tl (vl-remove tr tl)
  213.                              3dfl (vl-remove en 3dfl)  
  214.                                ** (entdel en)
  215.                          )
  216.                       )                      
  217.                    )
  218.                    
  219.                    ;; Processing Boundary                                     ;
  220.                                      
  221.                 )    
  222.                 (vl-cmdf "_ZOOM" "_P")
  223.                 (vl-cmdf  "_DRAWORDER" ssb "" "_FRONT")
  224.                 (vl-cmdf "_regen")
  225.                 (princ (strcat "\n     CDT " version " - Elapsed time: " (rtos (- (time) ti) 2 3) " secs, " (itoa (length cdtl)) " Constraints"))
  226.                 (if nfl (princ (strcat "\nThere Were " (itoa (length nfl)) " Breakline Who Had An Endpoint Not In The Point Set.")))
  227.             )
  228.          )
  229.          
  230.          (if (= gocont "1")
  231.             (progn
  232.                (vla-endundomark *acdoc*)
  233.                (vla-startundomark *acdoc*)
  234.                (contour pl tl intv majcnt majcolor mincolor hfac)
  235.             )
  236.          )
  237.          (if (and (= gocont "1") (= golbl "1")) (c:lbl))
  238.        )    
  239.     )
  240.     (*error* nil)
  241.     (princ)
  242. )
  243.  
  244. (defun c:bound (/ sp tmp)
  245.    
  246.    (if (not csurf) (setq csurf "Natural Ground"))
  247.    (if (/= "" (setq tmp (getstring (strcat "\nCreates a Boundary for TIN <" csurf ">: "))))
  248.      (setq csurf tmp)
  249.    )  
  250.    (mk_layer (list "Boundary" 2))
  251.    (setq sp (butlast (cdr (assoc 10 (entget (car (entsel "\nSelect Start Point of Boundary: ")))))))
  252.    
  253.    (command "_3DPOLY" "NOD" sp)
  254.    (while (setq en (car (entsel "\nNext point on Boundary: ")))
  255.       (if (= (cdr (assoc 0 (setq ent (entget en)))) "POINT")
  256.         (command (cdr (assoc 10 ent)))
  257.       )
  258.    )  
  259.    (command "_c")
  260.    (setq *bounden* (entlast))
  261.    (princ)
  262. )
  263.  

Command c:bound will creates a 3dpoly and assign it to var *bounden*.

In processing the TIN the entity  *bounden* will be used as a breakline and
any external triangle will be deleted.

This might be slow as almost every triangle needs to be processed.

ymg

Title: Re: Triangulation (re-visited)
Post by: rw2691 on December 02, 2015, 01:32:09 PM
YMG,

Thanks for the new code... I didn't expect to see anything until after you have finished your standing project.

Unfortunately the code choked. It printed the following...

>>Command: tin
>>Select objects: Specify opposite corner: 418 found
>>Select objects:
>>Error: no function definition: PROGRESS

Maybe it refers to: (Progress nil). But that has always been in the code. I haven't known what it does. It looks like a function and a variable at the same time.

Rick


Title: Re: Triangulation (re-visited)
Post by: rw2691 on December 02, 2015, 02:34:32 PM
YMG,

I have tested it without creating a boundary...

>>Command: tin
>>Select objects: Specify opposite corner: 498 found
>>Select objects:
>>Error: no function definition: PROGRESS

It shows the same result.

Rick
Title: Re: Triangulation (re-visited)
Post by: rw2691 on December 02, 2015, 02:43:45 PM
YMG,

I restored the code to before the patch. It works as normal.

Rick
Title: Re: Triangulation (re-visited)
Post by: rw2691 on December 02, 2015, 02:57:50 PM
YMG,

I should mention that I have tried using 3dploy's as breaklines before and it hasn't worked.

Rick
Title: Re: Triangulation (re-visited)
Post by: ymg on December 02, 2015, 03:18:49 PM
Rick,

Sorry about that, this is a new routine to version 0.7.0 to be able
to have more than 32768 points.

Includes the following:

Code - Auto/Visual Lisp: [Select]
  1. (defun progress (div / **)
  2.    (cond
  3.       (div (if (zerop (setq count (1- count)))
  4.               (setq count div  ** (acet-ui-progress -1))
  5.            ))
  6.       (t (acet-ui-progress -1))
  7.    )    
  8. )
  9.  

Incidentally, I am making progress on c:flip, where contours will be
updated as you flip triangle.

ymg
Title: Re: Triangulation (re-visited)
Post by: rw2691 on December 02, 2015, 04:42:14 PM
YMG,

Very good. It did it. But there were some exterior TIN's that were not contiguous with the boundary that it did not delete. As is, it cleaned up everything else with perfection.

As for operation... The use of "NOD" with 3dpoly does not elicit a snap. The cursor is in entity mode (just a square), and no snap can be activated.

Likewise a grdraw function would be good because the screen needs to be zoomed and panned many times before you finished the boundary. It can get confusing as to where the last point was.

Also you did not have the osnapz mode activated. I plugged it in to the code (using grdmod grdval as variables)...

Code - Auto/Visual Lisp: [Select]
  1. (defun c:bound (/ sp tmp grdmod grdval) ;; could be changed to C:BND  for 3 letter convenience
  2.    (if (not csurf) (setq csurf "Natural Ground"))
  3.    (if (/= "" (setq tmp (getstring (strcat "\nCreates a Boundary for TIN <" csurf ">: "))))
  4.        (setq csurf tmp)
  5.        )  
  6.    (mk_layer (list "Boundary" 2))
  7.    
  8.    (setq grdval (getvar "elevation")) ; save preset elevation (normally 0.0)
  9.    (setq grdmod (getvar "OSNAPZ")) ; save elevation snap-mode
  10.    (setvar "OSNAPZ" 0) ; set snap to object-grade
  11.            
  12.    (setq sp (butlast (cdr (assoc 10 (entget (car (entsel "\nSelect Start Point of Boundary: ")))))))
  13.           ;; butlast, Returns the list with last item removed.                       ;
  14.    (command "_3DPOLY" sp) ;; was (command "_3DPOLY" "NOD" sp)
  15.    (while (setq en (car (entsel "\nNext point on Boundary: ")))
  16.           (if (= (cdr (assoc 0 (setq ent (entget en)))) "POINT")
  17.               (command (cdr (assoc 10 ent)))
  18.               )
  19.           )  
  20.    (command "_c")    
  21.    (setq *bounden* (entlast))
  22.    
  23.    (setvar "OSNAPZ" grdmod) ; restore elevation snap-mode
  24.    (setvar "elevation" grdval) ; restore preset-elevation (normally 0.0)
  25.    
  26.    (princ)
  27. ) ;; end BOUND

If the user messes up it would be nice to have a function for manually selecting multiple 3dpoly's, merge and close them, move it to the correct layer, and set the *bounden* variable... as if it had been done by BOUND. I can see people clicking a wrong thing and having to start over from the start (maybe several times).

It certainly got the job done. Thanks.


EDIT: Added Code tags. - John
Title: Re: Triangulation (re-visited)
Post by: ymg on December 02, 2015, 04:56:48 PM
Rick,

I do have a function to merge join 3dpoly, although it is not in the proggie.

Right now, it is a fast hack. Where we set global variable *bounden* to
the entity name of the external boundary.

This will most probably cause trouble if we want to have more than one TIN
in a drawing.

An alternate way, would be to draw external's boundary clockwise
and island's boundary counterclockwise.  Any other closed poly with
points inside would be a breaklines.

Not too enthusiastic on grdraw to pick the points.

Same feelings about non-contiguous TIN

ymg
Title: Re: Triangulation (re-visited)
Post by: rw2691 on December 03, 2015, 07:51:07 AM
YMG,

I agree that the exterior island TIN's are a non issue. They can be handled manually. I got them in my selection because I was purposely being sloppy.

The clock and counter boundaries sound like a reasonable and beneficial addition.

But on the grdraw, implementing the same method as FLBL would be an advantage. The Undo option would keep a user from busting his poly and restarting. Furthermore there wouldn't be a need to patch broken poly's together, which I now think would not be a great idea. Drawing discipline is a better notion.

Rick
Title: Re: Triangulation (re-visited)
Post by: rw2691 on December 03, 2015, 10:58:26 AM
YMG,

Try the following. I have named it BND to differ from yours, and I have added (MK_BND) to facilitate a closed poly. It lets you snap to nodes, and it does the grdraw. It senses if the poly is closed, and closes if not. I haven't included an *error* routine however, and it might need some help. The errors were getting in my way.

Code - Auto/Visual Lisp: [Select]
  1. ;; begin patch
  2. (defun mk_bnd (L / x)
  3.    (if (equal (car L) (last L) 0.001)
  4.        () ;; do nothing
  5.        (setq L (append L (list (car L)))) ;; close the poly
  6.        )          
  7.    (en2obj
  8.       (if (and (> (length L) 1)
  9.                (entmakex (list '(0 . "POLYLINE") '(10 0. 0. 0.) '(70 . 8)))
  10.                (foreach x L (entmakex (list '(0 . "VERTEX") (cons 10 x) '(70 . 32)))) ;; was (70 . 32)
  11.           )
  12.          (cdr (assoc 330 (entget (entmakex '((0 . "SEQEND"))))))
  13.       )
  14.    )
  15. )
  16.  
  17. (defun c:bnd (/ sp tmp grdmod grdval plst get_bnd) ;; was c:bound
  18.    (if (not csurf) (setq csurf "Natural Ground"))
  19.    (if (/= "" (setq tmp (getstring (strcat "\nCreate a Boundary for TIN <" csurf ">: "))))
  20.        (setq csurf tmp)
  21.        )  
  22.    (mk_layer (list "Boundary" 2))
  23.    
  24.    (setq grdval (getvar "elevation")) ; save preset elevation (normally 0.0)
  25.    (setq grdmod (getvar "OSNAPZ")) ; save elevation snap-mode
  26.    (setvar "OSNAPZ" 0) ; set snap to object-grade
  27.            
  28.    (defun get_bnd (/ lst pt)
  29.       (if (car (setq lst (list (getpoint "\nSpecify first Boundary point: ")))) ;; if test
  30.           (progn
  31.              (while (setq pt
  32.                                 (if (> (length lst) 1)
  33.                         (progn
  34.                                           (initget "Undo")
  35.                                           (getpoint (car lst) "\nSpecify next Boundary point [Undo]: ")
  36.                                       ) ;; end if=yes
  37.                         (getpoint (car lst) "\nSpecify next Boundary point: ")
  38.                         ) ;; end if length
  39.                     ) ;; end while test
  40.                     (redraw)
  41.                     (mapcar '(lambda (a b) (grdraw a b 1 1)) (setq lst (if (eq pt "Undo") (cdr lst) (cons pt lst))) (cdr lst))
  42.               ) ;; end while
  43.             (cond ((> (length lst) 1) lst))                    
  44.             ) ;; end progn if=yes
  45.            ) ; end if
  46.       ) ;; end _getpoints  
  47.  
  48.    (if (setq plst (get_bnd)) ;; use _getpoints
  49.        (progn (mk_bnd plst)
  50.                   (setq *bounden* (entlast))
  51.                           (redraw)
  52.                           )
  53.            )
  54.  
  55.    (setvar "OSNAPZ" grdmod) ; restore elevation snap-mode
  56.    (setvar "elevation" grdval) ; restore preset-elevation (normally 0.0)
  57.  
  58.    (princ)
  59. ) ;; end BND
  60. ;; end *upgrade patch*


EDIT: Added code tags. - John
Title: Re: Triangulation (re-visited)
Post by: rw2691 on December 03, 2015, 11:02:28 AM
YMG,

The smiley face in the above is an 8. I'm not smart about forum stuff.

Rick
Title: Re: Triangulation (re-visited)
Post by: rw2691 on December 03, 2015, 02:41:40 PM
YMG,

I think I found what was creating *errors*. I assume it was due to MK_BND trying to create VLAX objects.

This is my former code (renamed as mk_bnd_old)...

Code - Auto/Visual Lisp: [Select]
  1. (defun mk_bnd_old (L / x)
  2.    (if (equal (car L) (last L) 0.001)
  3.        () ;; do nothing
  4.            (setq L (append L (list (car L)))) ;; close the poly
  5.        )          
  6.    (en2obj
  7.       (if (and (> (length L) 1)
  8.                (entmakex (list '(0 . "POLYLINE") '(10 0. 0. 0.) '(70 . 8)))
  9.                (foreach x L (entmakex (list '(0 . "VERTEX") (cons 10 x) '(70 . 32)))) ;; was (70 . 32)
  10.           )
  11.          (cdr (assoc 330 (entget (entmakex '((0 . "SEQEND"))))))
  12.       )
  13.    )
  14. )

This is with the VLAX functions removed...

Code - Auto/Visual Lisp: [Select]
  1. (defun mk_bnd (L / x)
  2.    (if (equal (car L) (last L) 0.001)
  3.        () ;; do nothing
  4.            (setq L (append L (list (car L)))) ;; close the poly
  5.        )          
  6.    (if (and (> (length L) 1)
  7.             (entmake (list '(0 . "POLYLINE") '(10 0. 0. 0.) '(70 . 8)))
  8.             (foreach x L (entmake (list '(0 . "VERTEX") (cons 10 x) '(70 . 32))))
  9.             )
  10.        (entmake '((0 . "SEQEND")))
  11.        )
  12. )

Both create the 3d polyline, but I am assuming the latter is better. Everything I have done is simply to refit your own codes to this situation.

Rick

EDIT: Added code tags. - John
Title: Re: Triangulation (re-visited)
Post by: ronjonp on December 03, 2015, 02:44:23 PM
RW2691,

Please read this (http://www.theswamp.org/index.php?topic=48309.msg533832#msg533832) thread about formatting code in your posts.
Title: Re: Triangulation (re-visited)
Post by: ymg on December 03, 2015, 02:46:15 PM
Rick,

In "Triang", there is already a subroutine "mk_3dp" that does the same as your "mk_bnd"

Code - Auto/Visual Lisp: [Select]
  1. ;;                                                                            ;
  2. ;; mk_3dp    by Alan J Thompson                                               ;
  3. ;;                                                                            ;
  4. ;; Argument: l, A list of points (2d or 3d)                                   ;
  5. ;;                                                                            ;
  6. ;; Create an LWPolyline at Elevation 0, on Current Layer.                     ;
  7. ;; Return: Polyline Object                                                    ;
  8. ;;                                                                            ;
  9.  
  10. (defun mk_3dp (l / x)
  11.    (en2obj
  12.       (if (and (> (length l) 1)
  13.                (entmakex (list '(0 . "POLYLINE") '(10 0. 0. 0.) '(70 . 8)))
  14.                (foreach x l (entmakex (list '(0 . "VERTEX") (cons 10 x) '(70 . 32))))
  15.           )
  16.         (cdr (assoc 330 (entget (entmakex '((0 . "SEQEND"))))))
  17.       )
  18.    )
  19. )
  20.  

Closing the poly should be a task done in the main.

This way we keep the routine a little more generic.

ymg
Title: Re: Triangulation (re-visited)
Post by: rw2691 on December 04, 2015, 09:53:01 AM
YMG,

Thanks for telling me how to create the code windows... I had been wondering.

I had tried to use mk_3dp before I did the mk_bnd. It wasn't closing, so in the interest of simply demonstrating the code, I made mk_bnd. I now see how to close a poly and still use mk_3dp.

Code: [Select]
;; begin patch
(defun c:bnd (/ tmp grdmod grdval plst get_bnd) ;; was c:bound
   (if (not csurf) (setq csurf "Natural Ground"))
   (if (/= "" (setq tmp (getstring (strcat "\nCreate a Boundary for TIN <" csurf ">: "))))
       (setq csurf tmp)
       )   
   (mk_layer (list "Boundary" 2))
   
   (setq grdval (getvar "elevation")) ; save preset elevation (normally 0.0)
   (setq grdmod (getvar "OSNAPZ")) ; save elevation snap-mode
   (setvar "OSNAPZ" 0) ; set snap to object-grade

   (defun get_bnd (/ lst pt OK)
      (if (car (setq lst (list (getpoint "\nFirst clockwise Boundary point: ")))) ;; if test
          (progn
             (while (setq pt
        (if (> (length lst) 1)
                        (progn
          (initget "Undo")
          (getpoint (car lst) "\nNext clockwise Boundary point [Undo]: ")
              ) ;; end if=yes
                        (getpoint (car lst) "\nNext clockwise Boundary point: ")
                        ) ;; end if length
                    ) ;; end while test
                    (redraw)
                    (mapcar '(lambda (a b) (grdraw a b 1 1)) (setq lst (if (eq pt "Undo") (cdr lst) (cons pt lst))) (cdr lst))
              ) ;; end while
            (cond ((> (length lst) 1) lst)) ;; post list
            ) ;; end progn if=yes
           ) ; end if
      ) ;; end _getpoints   

   (if (and (setq plst (get_bnd))
            (if (> (length plst) 2)
    (setq OK 1) ;; valid list
    (alert "Boundary must exceed 2 points")
)
) ;; end test
       (progn (if (equal (car plst) (last plst) 0.001)
                  (setq OK 1) ;; valid loop
              (setq plst (append plst (list (car plst)))) ;; close loop
                  )  
          (mk_3dp plst)
  (setq *bounden* (entlast))
  (redraw)
  ) ;; end progn
   ) ;; end if
 
   (setvar "OSNAPZ" grdmod) ; restore elevation snap-mode
   (setvar "elevation" grdval) ; restore preset-elevation (normally 0.0)
   ;;(*error* nil) ;; no error catch implemented (I don't know what parameters should be used)
   (princ)
) ;; end BND
;; end *upgrade patch*

I have kept the BND name so you can compare operation with BOUND. I haven't done the *error* catch because I don't know what parameters should be used with this type of poly.

I have done some testing on making boundaries that most user's would never do. They cut across where natural TIN's would be built, and in particular, through breaklines. The result is that it did not delete any TIN's that are contiguous to a breakline. I think that is proper.

But (still with the sloppy Boundary that I made) it appeared as if holes were left in the TIN in certain places against the Boundary. I couldn't get a TIN to highlight when I hovered over where I expected one to be. So I set the Boundary under the TIN's and the "hole TIN's" were there. The Boundary just overrode the object highlighting.

It seems that everything is proper. The contours built well.

Rick

Title: Re: Triangulation (re-visited)
Post by: TopoWAR on December 08, 2015, 12:30:06 PM
hello, the function "TIN" works well :-D, the "CONT" does not work :-(, see DWG. thanks

I used autocad 2007 and 2015, win 7 ultimate x86
I get the error 40%

Code: [Select]
autocad 2007/2015 x86 win7 ultimate
Error: bad argument type: 2D/3D point: nil

;;funcion lisp
(defun ratiopoint (a b r) (polar a (angle a b) (* (distance a b) r)))

---> error ( b ) = nil


argument a = (5148.52 2400.0)
argument b = nil
argument r = 0.5

ERROR!!
CHECKING. Here the Vertex 2 EQUALS 3 SEE PICTURE
Title: Re: Triangulation (re-visited)
Post by: rw2691 on December 09, 2015, 07:42:33 AM
TopoWar,

I tried the file. CONT appears to work on my machine. There aren't very many contours.

Rick
Title: Re: Triangulation (re-visited)
Post by: TopoWAR on December 09, 2015, 10:32:04 AM
my not work for me :-(
It is very strange, just give me error if I make a single selection of everything, but if I do I work in 2 parts !!
Title: Re: Triangulation (re-visited)
Post by: pedroantonio on December 09, 2015, 03:59:31 PM
Hi ymg. Can you put the Depression Contour in a new layer or give as an option if we want to draw it or not because in close contours is very ugly and became a mess.

Thanks
Title: Re: Triangulation (re-visited)
Post by: TopoWAR on December 10, 2015, 02:54:12 PM
by the time I managed to avoid the error by adding a condition in the variables that cause the error (A1 and A3)

Code: [Select]
(t (setq cn1 (list (/ (+ (car p1) (car p2) (car p3)) 3) (/ (+ (cadr p1) (cadr p2) (cadr p3)) 3))
        cn2 (list (/ (+ (car p1) (car p3) (car p4)) 3) (/ (+ (cadr p1) (cadr p3) (cadr p4)) 3))
         a1 (cond
       ((inters cn1 p1 v1 v2))
       ((inters cn1 p3 v1 v2))    
    )
                         a3 (cond
       ((inters cn2 p1 v2 v3))
       ((inters cn2 p3 v2 v3))
    )          
   
                  )
;;;;;modification
(if (and a1 a3)
  (progn
    (setq b1 (ratiopoint a1 v2 hfac)
  b2 (ratiopoint v2 a3 hfac)
  c1 (midpoint b1 b2)
  ps (list (list a1 b1 c1) (list c1 b2 a3)))
  )
)

for some reason the value of v1 v2 v3 were the same, I hope to find the error background, Greetings
Title: Re: Triangulation (re-visited)
Post by: ymg on December 10, 2015, 05:39:35 PM
All the error in Contour are still related to contours being
smack on a triangle.

Thought I had covered every base but it seems I didn't

Will post a revision when I have a solution.

@topographer

If you use qselect and select according to linetype, you can
isolate the depression contour.

ymg
Title: Re: Triangulation (re-visited)
Post by: TopoWAR on December 10, 2015, 05:46:01 PM
ymg , Thanks for the answer, a question may be used without modification problem I did?
Title: Re: Triangulation (re-visited)
Post by: pedroantonio on December 10, 2015, 06:24:45 PM
Quote
If you use qselect and select according to linetype, you can
isolate the depression contour.

Hi ymg . I thought if you can add an option in the dcl file to choose if want to draw them or not.
Title: Re: Triangulation (re-visited)
Post by: ymg on December 11, 2015, 08:05:43 PM
topographer,

It can be done quite easily.

However the Dialog Box is getting a little overloaded.

Will put a checkbox for it in next version.

ymg
Title: Re: Triangulation (re-visited)
Post by: pedroantonio on December 12, 2015, 02:13:39 AM
Thank you ymg
Title: Re: Triangulation (re-visited)
Post by: rw2691 on December 26, 2015, 04:18:49 PM
YMG,

When I first tested the TOPOWAR drawing I hadn't selected all the TINS. It appeared to work fine.

I have tried some scenarios to isolate where the error occurs. It only happens after you have selected a certain number of TINS.

I selected from the top down until I found the error. Then I selected from the bottom up, overlapping the error area. No error.

I selected an area between them that overlaps the error. No error.

I don't think it is a division by zero problem. I think it is how many objects are being processed.

Whether I select the top portion or bottom, if I get too many TINS it has an error.

Rick
Title: Re: Triangulation (re-visited)
Post by: ymg on December 26, 2015, 08:33:27 PM
Rick,

I believe I have located the error.

It is all related to points of the 3dface being at the same elevation as the contour.

Will need to add a test there and everything should be OK.

ay take a little while as I am quite busy at the moment.

ymg
Title: Re: Triangulation (re-visited)
Post by: rw2691 on December 28, 2015, 09:02:50 AM
YMG,

In DEMOZ, either the value "p" or "pnt" is not assigned a value...

(setq p (cadr pnt) tn (triloc p))

It crashes after the above code... Error: bad argument type: consp nil

Rick

*** I just realized that part of this could possibly be from an out of session use.

I inserted the following code before (chglayer '("TIN" ... code
(if (not csurf) (setq csurf "Natural Ground")) ;; *** fix for out of session use ***

I also noticed that (chglayer '("Points" needs to be "Point"

These changes eliminated random crashes, but not the "consp nil" problem.
I am assuming that you can't use DEMOZ out of session. Too bad. It would be nice.

Rick

Works great within a TIN session.
Title: Re: Triangulation (re-visited)
Post by: ymg on December 30, 2015, 10:30:27 PM
Rick,

What do you mean by out of session ?

If you mean working from a set of 3dfaces, it would simply
be a matter of calling get_tin at the beginning of demoz.

This builds the necessary list: pl, tl and 3dfl at the cost of having
to select the 3dfaces forming your triangulation.

For the bug, I could not replicate the behaviour you are describing.

ymg
Title: Re: Triangulation (re-visited)
Post by: rw2691 on January 01, 2016, 08:54:58 AM
YMG,

Yes, that is what I noticed. You have to do the TIN and DEMOZ while the drawing is still active... in session. It is the same for FLIP. I had considered setting every variable, but I wondered if the TIN order (which might end up different) could become an issue. I also didn't know that get_tin would simply get a TIN by a recalled drawing. I assumed that might have to be in session as well. Likewise, I didn't want to go too deep with making changes. I might really mess things up.

Rick
Title: Re: Triangulation (re-visited)
Post by: rw2691 on January 01, 2016, 09:14:51 AM
YMG,

As a second thought... is there a way, and do you think it would be profitable, to embed pl, tl and 3dfl as invisible DOC objects (being saved with the drawing file)? That way they could always be recalled without having to reselect or rebuild the TIN.

Rick
Title: Re: Triangulation (re-visited)
Post by: ymg on January 01, 2016, 09:27:59 AM
Rick,

I don't think keeping the data is worth it.

The 3dfaces contains all that is necessary.  Does not not take long
to rebuild the necessary list.

ymg
Title: Re: Triangulation (re-visited)
Post by: rw2691 on January 04, 2016, 11:35:30 AM
YMG,

I have been testing the latest version of GSTAR. It does not support the PRAGMA function. I presume it is too old of a code. Since GSTAR is supposed to be modeled after the latest version of Autocad, I am wondering if anyone has tested Triangulation on any of the newer versions? My own Autocad is 2006.

Rick
Title: Re: Triangulation (re-visited)
Post by: ymg on January 05, 2016, 12:45:00 PM
Rick,

Not sure I follow you there, but the pragma function is simply directive
to the vlide so that the functions and constants defined in there are protected and
show in blue in the vlide.

If you keep the function and constant definition part, you can remove
the pragma-assign and pragma-unassign and the program will work
as usual.

ymg
Title: Re: Triangulation (re-visited)
Post by: rw2691 on January 05, 2016, 01:12:46 PM
YMG,

Removing PRAGMA allowed it to load. Then I tried to build a TIN. It reported... Error: no function definition: ACET-UI-PROGRESS.

Rick
Title: Re: Triangulation (re-visited)
Post by: Lee Mac on January 05, 2016, 01:36:39 PM
Removing PRAGMA allowed it to load. Then I tried to build a TIN. It reported... Error: no function definition: ACET-UI-PROGRESS.

acet-* functions are AutoCAD Express Tools functions.
Title: Re: Triangulation (re-visited)
Post by: rw2691 on January 06, 2016, 07:51:10 AM
Lee,

Thanks for the reply. GstarCAD has what they call Express Tools, but apparently by this, it does not have the same command set as Autocad's. I have to give them credit, however, since of all the different CAD programs that I have tested it has the least of such discrepancies. Their LISP is certainly good, and the program is very peppy, yet their OLE for external access has some problems. Unfortunately, there isn't any development documentation, and I cannot gain direct contact with their engineers to resolve any issues. Only salesmen, and they have very short attention spans... and don't have a clue to what I am talking about. Outside of that it is 'hot' software, and inexpensive.

Rick
Title: Re: Triangulation (re-visited)
Post by: pumdee123 on January 07, 2016, 07:58:48 AM
can use for autocad c3d 2015?
Title: Re: Triangulation (re-visited)
Post by: rw2691 on January 08, 2016, 04:32:41 PM
Mosquito,

I am only a user like yourself, but if you refer to Triangulation... it is experimental and presently at no cost. So give it a try and let everyone know how it works for you. Tester's appear to be welcome.

Rick
Title: Re: Triangulation (re-visited)
Post by: pedroantonio on January 28, 2016, 01:45:29 AM
Hi ymg. Any new update ?  :-)
Title: Re: Triangulation (re-visited)
Post by: ymg on January 28, 2016, 11:54:02 AM
topographer,

No new update  at the moment, I need to complete another project.

So I hve little time for this one.

ymg
Title: Re: Triangulation (re-visited)
Post by: d.valkanov on February 14, 2016, 01:07:57 PM
Hi, ymg
How about boundaries and holes?
Title: Re: Triangulation (re-visited)
Post by: ymg on February 14, 2016, 06:49:43 PM
Holes and boundaries are implemented.

Read the thread.

ymg
Title: Re: Triangulation (re-visited)
Post by: rw2691 on February 15, 2016, 08:55:44 AM
I wanted to test my idea that the former TopoWar crash was by too many tins. I took some points that did not have any whole contour elevations and copied them over and over to build a big topo. Then I built a TIN and CONTOURS at the same time...
******************************************************
Select objects: Specify opposite corner: 7786 found

Select objects:
; error: Exception occurred: 0xC0000005 (Access Violation)
; warning: unwind skipped on exception
******************************************************
I repeated the selection without doing the CONTOURS and had the same results.

Then I did a partial segment and had success at building a TIN...
******************************************************
Select objects: Specify opposite corner: 554 found

Select objects:

       TIN V0.6.7 - Elapsed time: 0.469 secs, 1087 3DFACES
******************************************************

I also tried selecting half of the points, and again had success...
******************************************************
Select objects: Specify opposite corner: 3822 found

Select objects:

       TIN V0.6.7 - Elapsed time: 5.954 secs, 7625 3DFACES
******************************************************

Then I drew several break lines across the points at a 650' elevation. No crash.
******************************************************
Select objects: Specify opposite corner: 560 found

Select objects:

       TIN V0.6.7 - Elapsed time: 0.469 secs, 1110 3DFACES
     CDT V0.6.7 - Elapsed time: 1.360 secs, 3 Constraints
******************************************************

Then I drew contours on the same group with the 650 break lines. No crash...
******************************************************
Select 3DFACES
Select objects: Specify opposite corner: 1110 found

Select objects:

   CONTOUR V0.6.7 - Elapsed time: 12.766 secs, 1375 LWPOLY, 18241 Vertices.
DEPRESSION V0.6.7 - Elapsed time: 2.781 secs, 1354 Closed Poly
******************************************************

Lastly I selected a larger group that included the 650 break lines. It crashed...
******************************************************
Select 3DFACES
Select objects: Specify opposite corner: 14426 found

Select objects:

Error: bad argument type: 2D/3D point: nil
******************************************************

Conclude what you will, but it looks like the 650 break lines are not the problem. It looks like too many TIN's to me.
Title: Re: Triangulation (re-visited)
Post by: schoeller on February 15, 2016, 10:12:46 AM
Hello YMG,

thanks for letting me try your code. I loaded version 0.6.5.5 with Bricscad version 15.3.05 ( (x64) revision 39062). When calling the TIN command from the command line I receive the error:

***
tinV0.6.5.5.dcl 371: context error - invalid attribute value 'Left'
***

Any assistance would be appreciated in order to be able to go further.

Best wishes

Sebastian
Title: Re: Triangulation (re-visited)
Post by: ymg on February 15, 2016, 12:12:04 PM
schoeller,

Try by removing line 895 and 907 in the lisp and see If you can load.

Make sure you remove the file tin6.5.5.dcl from the temp directory
before running.

Maybe Briscad is more rigid when parsing dcl than autocad

ymg
Title: Re: Triangulation (re-visited)
Post by: ymg on February 15, 2016, 01:43:56 PM
Rick,

Just checked with topowar's dwg and Version 6.7 and could not reproduce
what you are describing.

The triangulation comes out OK, however the contour do crash.

ymg
Title: Re: Triangulation (re-visited)
Post by: roy_043 on February 15, 2016, 02:10:45 PM
Maybe Briscad is more rigid when parsing dcl than autocad
FWIW: BricsCAD only accepts values in lower case here. In general DCL is case-sensitive.
Title: Re: Triangulation (re-visited)
Post by: ymg on February 15, 2016, 02:21:45 PM
Roy,

Quote
FWIW: BricsCAD only accepts values in lower case here. In general DCL is case-sensitive.

Thanks, seems to be the problem as the line were reading:

Code: [Select]
(write-line "              alignment = Left;                             "f)
should be changed to:

Code: [Select]
(write-line "              alignment = left;                             "f)
ymg
Title: Re: Triangulation (re-visited)
Post by: roy_043 on February 16, 2016, 03:56:42 AM
@ ymg:
Yes that is correct. After changing the values as you have indicated, BricsCAD will accept the dcl. Because BC uses its own DCL engine there are some minor alignment issues. But I don't think these are very important.
Title: Re: Triangulation (re-visited)
Post by: schoeller on February 16, 2016, 04:14:18 AM

Code: [Select]
(write-line "              alignment = Left;                             "f)
should be changed to:

Code: [Select]
(write-line "              alignment = left;                             "f)

Thanks YMG,

after updating either 0.6.5.5 or 0.6.7 work for triangulation.

Best

Sebastian
Title: Re: Triangulation (re-visited)
Post by: ribarm on February 16, 2016, 05:38:57 AM
I've modified my versions of Convex Hull triangulations...
Links :
https://www.theswamp.org/index.php?topic=9042.msg543147#msg543147
https://www.theswamp.org/index.php?topic=9042.msg544655#msg544655
https://www.theswamp.org/index.php?topic=9042.msg544856#msg544856

And here attached lsp file...
https://www.theswamp.org/index.php?topic=48721.msg545704#msg545704

Regards, M.R.
Title: Re: Triangulation (re-visited)
Post by: rw2691 on February 18, 2016, 09:31:25 AM
YMG,

I didn't use TopoWar's drawing because I wanted control over the contour elevations. So I created my own where only the break lines have contour grades. I have attached the drawing.

Rick
Title: Re: Triangulation (re-visited)
Post by: ymg on February 19, 2016, 10:31:21 PM
Rick,

I've explained many times that there is still a problem
when triangle lays exactly on the contours level.

Inserting your break line at exact elevation 655 pretty
much insure that it will not work, at least pending that
I find a solution to that bug.

If you change the elevation of your breaklines by raising it
1 cm, program completes normally.

I find your example not very useful.

Look at the following image of a Tin formed with 3 square breaklines
at elevation 0  5 and 0

The tin is correct but the contour even though they did not crash
are incorrect.  I should end up with squares at 0 5 and 0



ymg
Title: Re: Triangulation (re-visited)
Post by: rw2691 on February 20, 2016, 03:57:05 PM
YMG,

Sorry it wasn't helpful. I thought it demonstrated that the contours don't crash until there is a large number TIN's. Maybe I can be helpful at another time. Thanks for considering it.

Rick
Title: Re: Triangulation (re-visited)
Post by: ymg on February 21, 2016, 11:59:40 AM
Rick,

In other word what I am saying is that the number of triangles
is not the culprit here except for increasing the chances of having
a crash.

The real reason is that the routine threading through the 3dfaces
following a given level gets lost when one or more of the points
forming the faces have a z value equal to the contour being threaded.

I've try many different ways to resolve it, but so far still haven't find
the correct one.

ymg
Title: Re: Triangulation (re-visited)
Post by: rw2691 on February 23, 2016, 02:46:03 PM
YMG,

Don't get mad at me.

I edited my point list to insure there are no decimal 0's. There were a couple were that "x.004". That may have entered your round out tolerance. Just for perspective... the topo area is at about 140 acres.

I did not insert any break lines. Built the TIN and it was fine. But when doing contours I noticed sticks everywhere. Contours were busted with throw outs... the sticks. I looked closer and they were all depression contours. Additionally, the depression contours weren't depressions. Something is wrong.

So I took the depression code out of the lisp. Rebuilt the TIN, and built the contours. The contours built perfectly.

To go a little further, I inserted the 650' break lines, rebuilt the TIN, then did the contours again. It did not crash, and again, it built the contours perfectly... giving full respect to the break lines. No sticks anywhere.

My conclusion is that the depression code has the fault, and is causing the crash.

By the way... and it is just my opinion, but I would like the depression lines to be optional. I wouldn't usually want them.

Rick.

Title: Re: Triangulation (re-visited)
Post by: ymg on February 24, 2016, 01:18:39 PM
Rick,

If there are no points that are exactly on the contours. Yes it builds correctly.

The depression contours could be at fault in your particular case, I will have to check.

For making it optionnal, I agreed that we would in the next version.

However having a restriction on the point level is not acceptable.  Means that we must find a solution
to the point equal to contour level.

I am traveling at the moment, so progress is slow.

By the way where do you get the notion that I am mad at you ? 



ymg
Title: Re: Triangulation (re-visited)
Post by: rw2691 on February 26, 2016, 11:01:51 AM
YMG,

Attached are the 2 drawings.

Looking at the depression lines I suppose I have the wrong idea about what they are. My take is that the highest crest and lowest swale would be marked. You are marking the entire ascent and descent. Consequently I had thought that was a misfunction.

My guess on the sticks is that you are failing to pick up on an elevation. Perhaps grabbing a latitude or departure coordinate as an elevation. If so, that could be why all the previous tests had encountered a crash.

Some time back I had looked through the contour codes. I never saw where you weren't protecting against division by zero. That is why I had previously thought it might be an out of memory issue with the array. The sticks make me suspect that it is mismatched data that happens in the depression code. That everything works perfectly without the depression code encourages my opinion.

As to your getting angry (or maybe frustrated)... consider it a misread on my part from Reply #550.

Rick
Title: Re: Triangulation (re-visited)
Post by: ymg on February 26, 2016, 06:44:17 PM
Rick,

Just change your linetype scale to 1 instead of 30.

Another way is to set variable sc in the depression handling
section to 1.0

Code - Auto/Visual Lisp: [Select]
  1. ; New Section to Handle Depression Contour           June 2015             ;
  2.    (if (= godep "1")
  3.       (progn
  4.          (setq ti (time))
  5.  
  6.          (or
  7.             (tblsearch "ltype" "Depression")
  8.             (mk_linetype
  9.                "Depression"
  10.                "____|____|____|____|____|____|__"
  11.                "A,.5,-.005,[\"|\",STANDARD,S=.06,R=0.0,X=-0.01125,Y=-.0725],-.005"
  12.             )
  13.          )
  14.  
  15.          (setq lt        (cons 6 "Depression")
  16.                sc        (cons 48 1.0)
  17.                majdepcol (cons 62 majdepcolor)
  18.                mindepcol (cons 62 mindepcolor)
  19.                lgclosed  (length ccont)
  20.          )
  21.  

What you call sticks are actually tick mark on the downslope side
of contours that wil retain water.

This is standard way on topograhical map.

Here's a sample of what you will get.

ymg
Title: Re: Triangulation (re-visited)
Post by: geobid on February 28, 2016, 04:44:03 AM
Hi

I following this post for some time. Because I want to use it, let me make a few comments:
1) Is:
   (prompt "\nSelect a Linear Entity: ")           
   (if (setq s (ssget "+.:L:S" '((0 . "*LINE")))) 
      (progn                                       
         (setq en (ssname s 0)                     
              ent (entget en)                     
         )...

Should be:
   (prompt "\nSelect a Linear Entity: ")           
   (if (setq s (ssget "_+.:L:S" '((0 . "*LINE")))) 
      (progn                                       
         (setq en (ssname s 0)                     
              ent (entget en)                     
         )...

2) In your procedures you use global variables, it causes some problems when they are not reset it to the default values.

3) Depression should be optional

4) PROF should be able to determine the location of the beginning and the end of line.

I made my own DCL because the original are not optimal for me. I can share it but in Polish language.

I am impressed yours work you've put in here.
Regards
Title: Re: Triangulation (re-visited)
Post by: ymg on February 28, 2016, 06:29:38 AM
geobid,

Will modify item 1 Thanks!

Agree that global variable can cause problems,
but I have many c: function that would need
you to do a selection otherwise.  Still the program
needs a lot of clean-up, this is why version number
is still at 0.xx (beta)

On item 3 I've already change the dcl and the program
to make depression optionnal. (Not published yet)

Item 4, I do not understand your comment there.
As it is, 0+000 is at beginning of line.  However you
can change that value in the dcl.

Thanks for your praises and constructive comments.

ymg

Title: Re: Triangulation (re-visited)
Post by: geobid on February 28, 2016, 08:37:35 AM
Thank you for your interest

Explain what's going on in section 4
If you generate a profile and line profile exceeds the limits of the surface
 program calculates odd values beyond the boundary. To prevent proposes
 adding the ability to indicate or give points on which you should count profile.

 In Annex is an example.


I have a suggestion
Maybe it's better to give up the command "acet-ui-progress" because it does not work best in higher versions of AutoCAD
and use something like this:

LISP:


;-------------------------------------------------------------------------------
; ProgressBar - Progress Bar
; Arguments: 3
;   Title$ = Dialog title
;   Message$ = Message to display
;   Delay~ - Percentage of *Speed# variable
; Example: (ProgressBar "Program Message" "Processing information..." 0.5)
;-------------------------------------------------------------------------------
(defun ProgressBar (Title$ Message$ Delay~)
  (setq *Delay~ Delay~)
  (if (not *Speed#) (Speed))
  (setq *Dcl_Id% (load_dialog "war.dcl"))
  (new_dialog "ProgressBar" *Dcl_Id%)
  (if (= Title$ "")(setq Title$ "AutoCAD Message"))
  (if (= Message$ "")(setq Message$ "Processing information..."))
  (set_tile "Title" (strcat " " Title$))
  (set_tile "Message" Message$)
  (setq *X# (1- (dimx_tile "ProgressBar")))
  (setq *Y# (1- (dimy_tile "ProgressBar")))
  (start_image "ProgressBar")
  (vector_image 0 2 2 0 8 )
  (vector_image 2 0 (- *X# 2) 0 8 )
  (vector_image (- *X# 2) 0 *X# 2 8 )
  (vector_image *X# 2 *X# (- *Y# 2) 8 )
  (vector_image (- *X# 2) *Y# *X# (- *Y# 2) 8 )
  (vector_image (- *X# 2) *Y# 2 *Y# 8 )
  (vector_image 2 *Y# 0 (- *Y# 2) 8 )
  (vector_image 0 (- *Y# 2) 0 2 8 )
  (end_image)
  (setq *Inc# 0 *Xpt# -4)
  (princ)
);defun ProgressBar
;-------------------------------------------------------------------------------
; Progress - Move the Progress Bar
;-------------------------------------------------------------------------------
(defun Progress (/ Complete$)
  (setq *Inc# (1+ *Inc#))
  (if (= (rem *Inc# 2) 1)
    (setq *Xpt# (+ *Xpt# 7))
  );if
  (start_image "ProgressBar")
  (if (> *Inc# 100)
    (progn
      (setq *Inc# 0 *Xpt# -4)
      (start_image "ProgressBar")
      (fill_image 3 3 (- *X# 5) (- *Y# 5) -15)
    );progn
    (progn
      (vector_image *Xpt#  3 (+ *Xpt# 4)  3 120)
      (vector_image *Xpt#  4 (+ *Xpt# 4)  4 110)
      (vector_image *Xpt#  5 (+ *Xpt# 4)  5 110)
      (vector_image *Xpt#  6 (+ *Xpt# 4)  6 100)
      (vector_image *Xpt#  7 (+ *Xpt# 4)  7 100)
      (vector_image *Xpt#  8 (+ *Xpt# 4)  8  90)
      (vector_image *Xpt#  9 (+ *Xpt# 4)  9  90)
      (vector_image *Xpt# 10 (+ *Xpt# 4) 10  90)
      (vector_image *Xpt# 11 (+ *Xpt# 4) 11  90)
      (vector_image *Xpt# 12 (+ *Xpt# 4) 12 100)
      (vector_image *Xpt# 13 (+ *Xpt# 4) 13 100)
      (vector_image *Xpt# 14 (+ *Xpt# 4) 14 110)
      (vector_image *Xpt# 15 (+ *Xpt# 4) 15 110)
      (vector_image *Xpt# 16 (+ *Xpt# 4) 16 120)
    );progn
  );if
  (end_image)
  (setq Complete$ (strcat (itoa (fix (+ *Inc# 0.5))) "% Wykonano..."))
  (set_tile "Complete" Complete$)
  (delay *Delay~)
  (action_tile "cancel" "(done_dialog)(exit)")
  (if (= *Inc# 100)(delay 10));Delay to show complete
  (princ)
);defun Progress
;-------------------------------------------------------------------------------
; EndProgressBar - Close Progress Bar dialog and clear variables
;-------------------------------------------------------------------------------
(defun EndProgressBar ( )
  (setq *Delay~ (* *Delay~ 0.5));Speed up bars remaining
  (if (and (> *Inc# 0)(< *Inc# 100))
    (repeat (- 100 *Inc#) (Progress))
  );if
  (done_dialog)
  (start_dialog)
  (unload_dialog *Dcl_Id%)
  (setq *Dcl_Id% nil *Delay~ nil *Inc# nil *X# nil *Xpt# nil *Y# nil)
  (princ)
);defun EndProgressBar
;-------------------------------------------------------------------------------
; Speed - Determines the approximate computer processing speed and sets the
; global variable *speed# which may be used in delay loops while in dialogs.
;-------------------------------------------------------------------------------
(defun Speed (/ Cdate~ Cnt# NewSecond# OldSecond#)
  (setq Cdate~ (getvar "CDATE"))
  (setq NewSecond# (fix (* (- (* (- Cdate~ (fix Cdate~)) 100000)(fix (* (- Cdate~ (fix Cdate~)) 100000))) 10)))
  (repeat 2
    (setq Cnt# 0)
    (setq OldSecond# NewSecond#)
    (while (= NewSecond# OldSecond#)
      (setq Cdate~ (getvar "CDATE"))
      (setq NewSecond# (fix (* (- (* (- Cdate~ (fix Cdate~)) 100000)(fix (* (- Cdate~ (fix Cdate~)) 100000))) 10)))
      (setq Cnt# (1+ Cnt#))
    );while
  );repeat
  (setq *Speed# Cnt#)
  (princ)
);defun Speed
;-------------------------------------------------------------------------------
; delay - time delay function
; Arguments: 1
;   Percent~ - Percentage of *Speed# variable
; Returns: time delay
;-------------------------------------------------------------------------------
(defun delay (Percent~ / Number~)
  (if (not *Speed#) (Speed))
  (repeat (fix (* *Speed# Percent~)) (setq Number~ pi))
  (princ)
);defun delay
;-------------------------------------------------------------------------------
(princ);End of ProgressBar.lsp


And DCL:

//------------------------------------------------------------------------------
// Program Name: ProgressBar.dcl [Progress Bar R3]
// Created By:   Terry Miller (Email: terrycadd@yahoo.com)
//               (URL: http://web2.airmail.net/terrycad)
// Date Created: 6-20-04
// Function:     Progress Bar dialog
//------------------------------------------------------------------------------
// Revision History
// Rev  By     Date    Description
//------------------------------------------------------------------------------
// 1    TM    6-20-04  Initial version
// 2    TM    2-20-05  Divided initial function into three functions, ProgressBar,
//                     Progress, and EndProgressBar to be used in loops.
// 3    TM    1-20-07  Updated progress bar dialog design.
//------------------------------------------------------------------------------
// ProgressBar - Progress Bar dialog
//------------------------------------------------------------------------------
ProgressBar : dialog {
  key = "Title";
  label = "";
  spacer;
  : text {
    key = "Message";
    label = "";
is_default = true;
  }
  : row {
    : column {
      : spacer { height = 0.12; fixed_height = true;}
      : image {
        key = "ProgressBar";
        width = 58.92; fixed_width = true;
        height = 1.51; fixed_height = true;
        aspect_ratio = 1;
        color = -15;
        vertical_margin = none;
is_default = false;
      }
      spacer;
    }
//    cancel_button;
  }
  : text {
    key = "Complete";
    label = "";
is_default = false;
  }
}// ProgressBar
//------------------------------------------------------------------------------

Title: Re: Triangulation (re-visited)
Post by: ymg on February 28, 2016, 09:01:18 AM
Geobid,

I see your point, but do not understand why you
would generate an alignment that is not in your TIN.

The progress bar is simply an attempt at preventing
Autocad hanging when in the middle of a long lisp.
I admit that it is not entirely successful at it.

I'll look at what you propose, but If I am to change progress bar,
I lean on the side of ElpanovEvgenyi's modemacro solution.

ymg
Title: Re: Triangulation (re-visited)
Post by: geobid on February 28, 2016, 09:14:46 AM
YMG

Of course this is just my suggestion.

Because I am a "lazy" user therefore it is easier for me to draw a line profile as in Figure 1.

This MODEMACRO of Elpanov Evgenyi's is very good :)

Thank you for your interest and best regards.
Title: Re: Triangulation (re-visited)
Post by: rw2691 on February 28, 2016, 10:00:05 AM
YMG,

Setting ltscale to 1 did make the depression linetype display, and my setting had made the sticks. I was wondering why I have never seen a depression linetype. I had tried to change celtype, which is how I typically manage independent objects, but the reach from 30 to 1 was not showing up by my normal entries for it (0.1 to 0.9).

However, I use ltscale as a global control for object, text, and line sizes. Setting it to 30 is a drafting scale of 1"=30' when printed (with lines thickened by color). All production within my system is designed to work that way. As mentioned, using celtscale for depression lines might be a better choice with the varied systems that people use.

But there is another issue I have noticed. Using the two drawings that I posted... At approximately the coordinates of (4980,4229) are some line sections that aren't supposed to be there. I have attached the depression and no depression images for that area. By my point data there are 2 TIN's near the location. They are the TIN by points 212, 213, and 224 (just below this TIN). Then also points 225, 217, and 208 (within this TIN).

Rick
Title: Re: Triangulation (re-visited)
Post by: rw2691 on February 28, 2016, 10:22:03 AM
YMG,

I might add that the points are replicated about thirty times across the drawing, and this is the only area that I noticed for having bogus lines.

I would also like to add that geobid's idea is one that I am sympathetic toward. It may not be good design practice to just slash a line across the TIN's, but that is what a lot of people will do. How he is suggesting to handle it is forcing them into good practice.

Rick
Title: Re: Triangulation (re-visited)
Post by: ymg on February 28, 2016, 11:27:49 AM
Rick,

The two extra lines should not be there. So I don't know, currently revisiting
the contour generating routine.  Might be a bit early to claim victory, but so
far I found a simple way to handle the dreaded even contour.

Also in the process of revising c:flip to handle contours and update them as
you flip an edge.  Good progress there but still some bugs.

I did find that insertion of constraint could creates under some condition some
clockwise 3dfaces which could cause problems. (All 3dfaces should wind CCW.

For the linetype scale, you could adjust it in the code as I proposed.  This way
you could keep your global settings.

Also done some progress in the generation of cross section.

For the alignment, if peoples want to slash a line, they may.
They will however get a section of their profile dropping to zero
when they are outside the tin.

ymg
Title: Re: Triangulation (re-visited)
Post by: rw2691 on February 28, 2016, 12:01:14 PM
YMG,

I have assumed that the code in Reply #556 is missing some parenthesis. Is the following a correct way to patch it in?

Code: [Select]
; New Section to Handle Depression Contour           June 2015             ;
       (if (= godep "1")
          (progn
             (setq ti (time))
     
             (or
                (tblsearch "ltype" "Depression")
                (mk_linetype
                   "Depression"
                   "____|____|____|____|____|____|__"
                   "A,.5,-.005,[\"|\",STANDARD,S=.06,R=0.0,X=-0.01125,Y=-.0725],-.005"
                )
             )
     
             (setq lt        (cons 6 "Depression")
                   sc        (cons 48 1.0)
                   majdepcol (cons 62 majdepcolor)
                   mindepcol (cons 62 mindepcolor)
                   lgclosed  (length ccont)
             )
          )
       )
       
   ;; the above replaces the below...
   
   ;; New Section to Handle Depression Contour           June 2015             ;

   ;;(setq ti (time))
   
   ;;(or (tblsearch "ltype" "Depression")
   ;;    (mk_linetype "Depression" "____|____|____|____|____|____|__"
   ;;                 "A,.5,-.005,[\"|\",STANDARD,S=.06,R=0.0,X=-0.01125,Y=-.0725],-.005"
   ;;    )
   ;;)


Rick
Title: Re: Triangulation (re-visited)
Post by: rw2691 on February 28, 2016, 12:33:10 PM
YMG,

I inserted geobid's modification to the depression linetype, and your code (as I posted) for an sc variable.

I also used my new points that have elevations above x.004', but with no 650' break lines.

It all computed properly. No crash, and none of the orphaned contour segments.

However, the sc variable did not remedy the ltscale = 30 issue. I had to set it to 1.

Rick
Title: Re: Triangulation (re-visited)
Post by: rw2691 on February 28, 2016, 12:55:06 PM
YMG,

I rebuilt everything again, but inserting the 650' break lines. Same results. No "nil" crash. Depressions all normal.

So is it the x.004' fix to the point data, or something to do with the linetype command, or your patch to try and remedy the ltscale problem?

It didn't have a problem with the 650' break line, so expect that the x.004' fix wasn't necessary as well.

I have noticed one thing however... between selecting the TIN's and the start of producing contours is a lengthy time period that does not have a progress bar.

Rick.
Title: Re: Triangulation (re-visited)
Post by: ymg on February 28, 2016, 01:52:11 PM
Rick,

The Depression linetype gets created only if it is not already
in the drawing.

So before running the code make sure you unload that linetype
from the drawing.  In order to do that you need to erase all the
contours then run.

Then you will see the effect of changing the value of sc.

Your patching is ok, all you need is to change the value of sc.
I believe originally it was set at 48.0, but with a global ltscale of 30
you might need to go even lower than 1.0


ymg
sc.
Title: Re: Triangulation (re-visited)
Post by: rw2691 on February 28, 2016, 01:58:26 PM
YMG,

I noticed that I had better remove...

(setq lt (cons 6 "Depression") sc (cons 48 48.0) majdepcol (cons 62 majdepcolor) mindepcol (cons 62 mindepcolor))

I also realized that the parenthesis that I added were too early. I moved them to include the entire depression code.

I also included a (set godep "1") since godep isn't implemented in the dcl yet.

Now it works. ltscale can be anything.

Don't know if everything is fixed... but for now it all works.

Rick
   
Title: Re: Triangulation (re-visited)
Post by: ymg on February 28, 2016, 02:19:17 PM
Rick,

I am afraid that you need the following:

Code - Auto/Visual Lisp: [Select]
  1. (setq lt        (cons 6 "Depression")
  2.                sc        (cons 48 0.5) ;only this line needed to be changed
  3.                majdepcol (cons 62 majdepcolor)
  4.                mindepcol (cons 62 mindepcolor)
  5.                lgclosed  (length ccont)
  6.          )
  7.  

For the godep you either remove the (if  (= godep "1") and the progn
or do as you did setting it to "1".

Variable godep will be used to make the depression processing optionnal.

ymg
Title: Re: Triangulation (re-visited)
Post by: d.valkanov on February 29, 2016, 08:40:36 AM
Here is an implementation of Sloan algorithm. I am still working on it, but but for nor now it works quite fast. It work in 2016. Boundaries, holes and breaklines are implemented. Use SMOOTH command to smooth contours. Point on edge of triangulation is also implemented. There is no command for labeling of contours for now, but it will be ready in couple of days. Profiles, cross sections and alingment tools are under development for now. Any suggestions are welcome.
Title: Re: Triangulation (re-visited)
Post by: ymg on February 29, 2016, 10:02:29 AM
d.valkanov,

Quote
Command: NETLOAD
Cannot load assembly. Error details: System.IO.FileLoadException: Could not
load file or assembly 'file:///C:\Users\ymg\Downloads\CDT2015.dll' or one of
its dependencies. Operation is not supported. (Exception from HRESULT:
0x80131515)
File name: 'file:///C:\Users\ymg\Downloads\CDT2015.dll' --->
System.NotSupportedException: An attempt was made to load an assembly from a
network location which would have caused the assembly to be sandboxed in
previous versions of the .NET Framework. This release of the .NET Framework
does not enable CAS policy by default, so this load may be dangerous. If this
load is not intended to sandbox the assembly, please enable the
loadFromRemoteSources switch. See http://go.microsoft.com/fwlink/?LinkId=155569
for more information.
   at System.Reflection.RuntimeAssembly._nLoad(AssemblyName fileName, String
codeBase, Evidence assemblySecurity, RuntimeAssembly locationHint,
StackCrawlMark& stackMark, IntPtr pPrivHostBinder, Boolean throwOnFileNotFound,
Boolean forIntrospection, Boolean suppressSecurityChecks)
   at System.Reflection.RuntimeAssembly.InternalLoadAssemblyName(AssemblyName
assemblyRef, Evidence assemblySecurity, RuntimeAssembly reqAssembly,
StackCrawlMark& stackMark, IntPtr pPrivHostBinder, Boolean throwOnFileNotFound,
Boolean forIntrospection, Boolean suppressSecurityChecks)
   at System.Reflection.RuntimeAssembly.InternalLoadAssemblyName(AssemblyName
assemblyRef, Evidence assemblySecurity, RuntimeAssembly reqAssembly,
StackCrawlMark& stackMark, Boolean throwOnFileNotFound, Boolean
forIntrospection, Boolean suppressSecurityChecks)
   at System.Reflection.RuntimeAssembly.InternalLoadFrom(String assemblyFile,
Evidence securityEvidence, Byte[] hashValue, AssemblyHashAlgorithm
hashAlgorithm, Boolean forIntrospection, Boolean suppressSecurityChecks,
StackCrawlMark& stackMark)
   at System.Reflection.Assembly.LoadFrom(String assemblyFile)
   at Autodesk.AutoCAD.Runtime.ExtensionLoader.Load(String fileName)
   at loadmgd()



Did not work for me as I am on acad 2012.

Would I've liked to see it run.

I did implement sloan in Autolisp, but it was too slow
to be usable.

ymg
Title: Re: Triangulation (re-visited)
Post by: d.valkanov on February 29, 2016, 11:58:42 AM
Well, it it takes  about 7 secs. for 1 000 000 points, 23 secs for saving TIN binary file and 87 secs. for contouring. It is actually C# application, but it is developed for 2016. I saw your work and I was  really impressed. It is really great and may be the fastest written in Lisp. I could not find how to implement boundary and holes. There is a command like XSHAPE or something like that, but I am not sure it is for boundary or holes. What is the algorithm in your application? What command should I use for boundary and holes? About smoothing I will suggest Bezier curves. See http://www.antigrain.com/research/bezier_interpolation/
https://en.wikipedia.org/wiki/B%C3%A9zier_curve
It looks much more natural.
Cheers

Title: Re: Triangulation (re-visited)
Post by: d.valkanov on February 29, 2016, 12:04:34 PM
No way to run on Acad2012. It is written for 2016. I can upload you the source code. CDT to start
Title: Re: Triangulation (re-visited)
Post by: ymg on February 29, 2016, 12:18:54 PM
d. valkanov,

Isn't it possible to compile it for the earlier versions ?

I understand that it will certainly be much faster,
however at the price of having to recompile at every new versions.

For big triangulation you certainly need to go that route. Either Sloan
or Triangle by Shewchuk.

Still prefer autolisp for my needs.

Xshape is simply to draw a boundary around a point cloud .

For island clean-up you use a closed boundaries (Breaklines), and clean the one
that goes ccw or have no points inside.  Depends on your convention
The outside boundary would need to go clockwise, If you have island
ccw.

ymg
Title: Re: Triangulation (re-visited)
Post by: geobid on March 01, 2016, 10:42:30 AM
Hi
I have a proposal for a small modification of your procedure:

(defun get_extcont ( / i l r)

(defun LsDiff ( l1 l2)
  (vl-remove-if '(lambda ( x ) (member x l2)) l1)
)
   
   (setq i 0  l nil)
   (foreach n nl
      (if (not (car   n)) (setq l (cons (nth i el) l)))
      (if (not (cadr  n)) (setq l (cons (nth (1+ i) el) l)))
      (if (not (caddr n)) (setq l (cons (nth (+ 2 i) el) l)))
      (setq i (+ 3 i))
   )   
       
   (setq l (reverse l))
   (setq r (reverse (car l)))
   (while (setq a (assoc (car r) (cdr l)))
      (setq r (cons (cadr a) r)
            l (lsDiff l (list a))
      )
   )
   (reverse r)
)


It seems to me that there will be more stable and more resistant to errors.
Of course, the decision is yours.
Title: Re: Triangulation (re-visited)
Post by: ymg on March 01, 2016, 01:08:45 PM
Geobid,

Your method is about 70% slower.

See below, on a 500 points tin with 984 3dfaces.

Quote
(benchmark '((get_extcont) (get_extcont1)))
Benchmarking .............Elapsed milliseconds / relative speed for 1024 iteration(s):

    (GET_EXTCONT)......1934 / 1.69 <fastest>
    (GET_EXTCONT1).....3260 / 1.00 <slowest>
 

However as the list grows the speed penalty gets smaller

For  5000 points and  9980 3DFACES:

Quote
(benchmark '((get_extcont) (get_extcont1)))
Benchmarking .........Elapsed milliseconds / relative speed for 64 iteration(s):

    (GET_EXTCONT)......1185 / 1.36 <fastest>
    (GET_EXTCONT1).....1607 / 1.00 <slowest>


One thing I did not check is If the ECO routine by VVA or a the similar one
by Lee Mac would be faster.

Generating the Neighbour List is actually quite lenghty.

ymg
Title: Re: Triangulation (re-visited)
Post by: d.valkanov on March 02, 2016, 03:48:38 AM
OK. It will be soon. I found ObjectARX 2012, but there some differences in functions for registries, so I have to fix it. May be next week. I am on holiday for now. My question is how to select outer boundary or inner hole as a polyline* or I have to clear triangles manually?
Title: Re: Triangulation (re-visited)
Post by: ymg on March 02, 2016, 08:36:19 AM
d.valkanov,

Currently, island are defined by closed polylines breaklines that have no points inside.
I use the breakline as a window polygon and do a selection for points or blocks.
These island are cleaned of triangle inside of it.

For the external boundaries we could also do the same, that is if a closed breakline contains
all the points, it would means that we would delete all the triangles which have edges outside
of it.

A small added difficulty is that sometimes a breakline introduce new points which are not
physically there but are part of the point list pl.  We could work around this by keeping a
separate list of the additionnal point or simply how many there are when we creates the point list.

The outside boundary is not currently implemented, but I lean on the above definition.

ymg
Title: Re: Triangulation (re-visited)
Post by: rw2691 on March 02, 2016, 10:04:47 AM
YMG,

Formerly the depression code was hanging or crashing.

In it you evaluate (< zb za) and (> za zb).

What happens with (= zb za) situations?

Could that hang a repeat or while, or mismatch data?

Rick
Title: Re: Triangulation (re-visited)
Post by: d.valkanov on March 02, 2016, 10:34:21 AM
d.valkanov,


Have a look at this code:

        private void MarkTriangle(int pa, int pb, int tNum, Polygon boundary, RemoveTriangles In_Or_Out)
        {
            if (tNum != -1)
            {
                // Current triangle
                Triangle t = triangles[tNum];

                // Find which edge passes through points pa and pb
                int pc = t.GetThirdVertex(pa, pb);

                // Centre of gravity
                Point mc = ONE_THIRD * (points[pa] + points[pb] + points[pc]);

                // If current triangle is not marked and ...
                if (!t.ToBeDeleted)
                {
                    bool inside; // Point is inside or outside of polygon

                    if (In_Or_Out == RemoveTriangles.Inside)     // If In_Or_Out is true it is a hole in the mesh
                        inside = boundary.InPolygon(mc);         // mc MUST be inside of hole
                    else           // otherwise it is a outer boundary.
                        inside = !boundary.InPolygon(mc);

                    // centre of gravity is outside of boubdary
                    if (inside)
                    {
                        // Mark triangle to be deleted.
                        t.ToBeDeleted = true;

                        // Get opposed triangle of pa
                        int tOpp = t.OpposedTriangle(pa);

                        // Recursively mark neighbour.
                        MarkTriangle(pb, pc, tOpp, boundary, In_Or_Out);

                        // Get opposed triangle of pb
                        tOpp = t.OpposedTriangle(pb);

                        // Recursively mark neighbour.
                        MarkTriangle(pc, pa, tOpp, boundary, In_Or_Out);
                    }

                }
            }
        }
Title: Re: Triangulation (re-visited)
Post by: ymg on March 02, 2016, 10:56:50 AM
d.valkanov,

Not sure your code accounts for a closed breaklines with point inside
that is simply a breakline which we do not wnt to clean ?

ymg
Title: Re: Triangulation (re-visited)
Post by: ymg on March 02, 2016, 11:07:47 AM
Rick,

I check for closed polyline that are lower only and change them to depression.

When a polyline does not contain any polyline, we check if there are points in it. if the z of selecting entity is higher we got a sink else it is a peak.

On my side I've never crash in the depression checking so I cannot duplicate
the behaviour you describe.

But maybe the code you have is different from the latest ?

Code - Auto/Visual Lisp: [Select]
  1. (if (= godep "1")
  2.       (progn
  3.          (setq ti (time))
  4.  
  5.          (or
  6.             (tblsearch "ltype" "Depression")
  7.             (mk_linetype
  8.                "Depression"
  9.                "____|____|____|____|____|____|__"
  10.                "A,.5,-.005,[\"|\",STANDARD,S=.06,R=0.0,X=-0.01125,Y=-.0725],-.005"
  11.             )
  12.          )
  13.  
  14.          (setq lgclosed  (length ccont))
  15.  
  16.          (if (< lgclosed 10)
  17.             (setq div   lgclosed
  18.                   count 1
  19.             )
  20.             (setq div   (/ lgclosed 10)
  21.                   count div
  22.             )
  23.          )
  24.          (acet-ui-progress "Depression Processing:"
  25.                            (if (< lgclosed 10)
  26.                               lgclosed
  27.                               10
  28.                            )
  29.          )
  30.  
  31.          (while (setq ena (caar ccont))
  32.             (setq za      (cadar ccont)
  33.                   enta    (entget ena)
  34.                   fence   (distinct (caddar ccont))
  35.                   aisdepr t
  36.                   ccont  (cdr ccont)
  37.             )
  38.             (if (setq ssb (ssget "_WP" fence '((0 . "LWPOLYLINE"))))
  39.                
  40.                (repeat (setq i (sslength ssb))
  41.                   (setq enb  (ssname ssb (setq i (1- i)))
  42.                         entb (entget enb)
  43.                         zb   (cdr (assoc 38 entb))
  44.                   )
  45.                   (if (< zb za)
  46.                      (progn
  47.                         ;(or first (setq first t ** (chg2depr enta)))
  48.                         (chg2depr entb)
  49.                         (vl-remove (assoc enb ccont) ccont)
  50.                      )
  51.                      (setq aisdepr nil)
  52.                   )
  53.                )
  54.  
  55.          ;                                                                    ;
  56.          ; Else Contour Had No Other Contour Inside, then Need to Check       ;
  57.          ; If Contour Contains Only Points or Blocks that Are Lower than      ;
  58.          ; Itself, Then It is a Depression Contour Else It is a Peak          ;
  59.          ; In a next revision I might add some kind of report about the       ;
  60.          ; Volume of the Depression. sink is lowest point in a depression,    ;
  61.          ; peak could be used to mark spot elevation on Contour map.          ;
  62.          ;                                                                    ;
  63.  
  64.                (progn
  65.  
  66.                   (if (setq ssb (ssget "_WP"
  67.                                        fence
  68.                                        '((-4 . "<OR")
  69.                                          (0 . "POINT")
  70.                                          (0 . "INSERT")
  71.                                          (-4 . "OR>")
  72.                                         )
  73.                                 )
  74.                       )
  75.                      (progn
  76.                         (setq ps nil)
  77.                         (repeat (setq i (sslength ssb))
  78.                            (setq enb  (ssname ssb (setq i (1- i)))
  79.                                  entb (entget enb)
  80.                                  ps   (cons (cdr (assoc 10 entb)) ps)
  81.                            )
  82.                         )
  83.                         (setq ps (vl-sort ps '(lambda (a b) (< (caddr a) (caddr b))))
  84.                               zb (caddar ps)
  85.                         )
  86.                         (if (> za zb)
  87.                            (setq sink (car ps))
  88.                       ; Else we have a Peak                                   ;
  89.                            (setq peak (last ps) aisdepr nil)
  90.                         )
  91.                      )
  92.                   )
  93.                )
  94.             )
  95.             (if aisdepr (chg2depr enta))
  96.             (progress)
  97.          )
  98.          (acet-ui-progress)
  99.  
  100.          (princ (strcat "\nDEPRESSION " version " - Elapsed time: " (rtos (- (time) ti) 2 3) " secs, " (itoa lgclosed) " Closed Poly\n" ))        
  101.       )
  102.  

ymg
Title: Re: Triangulation (re-visited)
Post by: d.valkanov on March 02, 2016, 11:16:37 AM


It is exactly for holes and boundary

private void ClearTriangles(Polygon polygon, RemoveTriangles InOut)
        {
            if (polygon.Count > 0)
            {
                // Start point of boundary
                Point a = polygon.polygonPoints[0];
                int pa = points.IndexOf(a);

                // Find the closest triangle
                int tStart = ChooseStartingTriangle(a);

                // Triangle that contains point pa.
                TriangleEdge edge;
                BarycentricWalk(ref tStart, a); //, out edge);

                int bc = polygon.Count;

                for (int i = 1; i < bc; i++)
                {
                    Point b = polygon.polygonPoints;

                    int pb = points.IndexOf(b);

                    int pc, tOpp;     // Third vertex of triangle

                    Triangle t = triangles[tStart];     // Current triangle

                    // Find triangle containing both points pa and pb.

                    if (!t.Contains(pb))
                    {
                        int r, l;

                        if (pa == t.a)          // pa is vertex a of triangle
                        {
                            r = t.b; l = t.c;   // CCW order
                        }
                        else if (pa == t.b)     // pa is vertex b
                        {
                            r = t.c; l = t.a;   // CCW order
                        }
                        else                    // pa is vertex c
                        {
                            r = t.a; l = t.b;   // CCW order
                        }

                        int tOld = tStart;

                        int tmp;

                        while (!t.Contains(pb))
                        {
                            GetNextCW(triangles[tOld], l, pa, out tStart, out tmp);

                            r = l;
                            t = triangles[tStart];
                            l = tmp;
                            tOld = tStart;
                        }
                        // Now tStart points to the one of triangles passing through pa and pb.
                    }

                    edge = t.GetEdge(pa, pb);

                    // Get third vertex of triangle
                    if (edge == TriangleEdge.ab)
                    {
                        pc = t.c; tOpp = t.ab;
                    }
                    else if (edge == TriangleEdge.bc)
                    {
                        pc = t.a; tOpp = t.bc;
                    }
                    else
                    {
                        pc = t.b; tOpp = t.ca;
                    }

                    if (CommonTools.Orient2D(a, b, points[pc]) == Orientation.CCW)    // pc is on the left side of the boundary
                    {
                        if (tOpp != -1)
                            MarkTriangle(pb, pa, tOpp, polygon, InOut);
                    }
                    else
                        MarkTriangle(pb, pa, tStart, polygon, InOut);

                    // a = b;
                    pa = pb;
                }
            }
        }
Title: Re: Triangulation (re-visited)
Post by: d.valkanov on March 02, 2016, 11:17:26 AM


I will write this one in Lisp
Title: Re: Triangulation (re-visited)
Post by: ymg on March 02, 2016, 11:51:41 AM
d.valkanov,

Now bear with me, I am somewhat challenged with C code.

The last one as far as I can tell remove triangle either inside or
outside depending on the calling parameter InOut.

Seems to be OK for me.

But what I am saying in the previous post is about determining
in the set of closed breaklines which one are holes and which one
is the outside boundary.

In other word the user simply creates breaklines.

When the program runs, If is a closed breakline with no point in
it knows it must clean the inside.

If the closed breakline contains all the point, any triangle outside
gets cleaned.

ymg
Title: Re: Triangulation (re-visited)
Post by: rw2691 on March 03, 2016, 01:25:07 PM
YMG,

Yes, your depression code has several sections changed in it from mine.

I have version Triang V0.6.7.

Is there a later version?

Rick

Title: Re: Triangulation (re-visited)
Post by: ymg on March 04, 2016, 03:20:04 AM
Rick,

Not published yet, except for  little snips in the thread.

Will publish once I have the even contour settled
hopefully.  As of now it looks good.

ymg
Title: Re: Triangulation (re-visited)
Post by: rw2691 on March 31, 2016, 02:16:46 PM
YMG,

I found the error in Profile... at around line 3919 (I have done some formatting and comments that change your line numbers) there is...
Code: [Select]
(setq temp (list (list (car disl) (caar entl))))
       
   (setq entl (mapcar '(lambda (a)
                                   (setq i -1)
                           (while (< (caddr (nth (setq i (1+ i)) entl)) a))
                                   (list a (car (nth (1- i) entl)))
                               )
                       (cdr disl)
                           )
         )
   (setq entl (append temp entl))      ;;;;   temp -was- tmp ... tmp is a typo

Changing TMP to TEMP causes the function to include the 0+00 station in the profile.

Then at around line 3939...
Code: [Select]
;; Var prof now contains the list of the profile sorted.           ;
   
           (setq chal (mapcar '(lambda (a) (rtosta (+ chbeg (car  a)) 1 prec)) prof) ;; 1 prec -was- 2 prec

It might be only a preference, but using "1" instead of "2" changes the station format from 0+180 to 1+80, as in 180'. 0+180 might be valid for somewhere, but I have never seen it before. Perhaps there should be an option for choosing the preferred format.
Title: Re: Triangulation (re-visited)
Post by: rw2691 on March 31, 2016, 03:23:08 PM
YMG,

After posting I remembered another item. I think it would be good to include break stations to the grade. As is, high and low points are ignored, and intermediate changes by ditches are absent. With break stations, critical slopes can also be better evaluated.

Rick
Title: Re: Triangulation (re-visited)
Post by: ymg on April 04, 2016, 03:55:41 AM
Rick,

Sorry about late reply, I am travelling so not doing much
on the program.

I will certainly consider your suggestions.

ymg
Title: Re: Triangulation (re-visited)
Post by: rw2691 on April 06, 2016, 10:28:57 AM
YMG,

I don't think that the break stations (at the TIN breaks) need to be marked on the grid... only included in the profile line. There could be many breaks, and that would clutter the grid. But if they are drawn on the profile line, the user can snap and draw to the grid to manually have the station and elevation of anything important.

Another option for automation would be to have a routine for snapping to the profile line, and have it report its station and elevation. You could also include a print option, where you click yes/no, and it could draw the notation for Sta & Elv with a drag line to the snapped position as a leader. It would keep the user from having to calculate the elevation by the vertical scaling.

If you want... I have a similar routine that I have made for Horizontal Sta & Ofs. It could be easily modified to make the Sta & Elv function.

Rick
Title: Re: Triangulation (re-visited)
Post by: rw2691 on April 10, 2016, 11:33:18 AM
YMG,

I managed to modify the PROF code so it draws the slope line breaking at each edge of the TIN, and it still grids the stations at selected intervals (ie. 20' or 40').

What I did, however, is a hack and probably very ugly coding. Nevertheless, if you want it I can post it.

Rick
Title: Re: Triangulation (re-visited)
Post by: ymg on April 10, 2016, 02:55:31 PM
Rick,

Post it I'll take a look at it.

But as I told you, I am not working on it at the moment.

ymg
Title: Re: Triangulation (re-visited)
Post by: rw2691 on April 12, 2016, 03:42:16 PM
YMG,

The following is a patch to draw profile lines by TIN breaks while also drawing increment stations by assigned intervals.

The following is to declare local variables that are new...

Code: [Select]
(defun c:prof (/ *acdoc* *acspc* *hinc* *en* *entl* pstart pclose
                cntz ofsy ydatum x1 x2 y1 y2 z1 z2 g1 g2)

Then adding assignments for *en* and *entl* at an early section of the PROF code,

  (setq entl (getproftin en)
          prof (distinctfuzz

was modified to be...

Code: [Select]
;;>>>>>> begin patch by RLW
 (setq  *en* en     
      *entl* (getproftin en)
        entl (getproftin en)
        prof (distinctfuzz
;;>>>>>> end patch by RLW

Then later at...   

Code: [Select]
(if (= opt 1)
      (progn
;;>>>>>>>>>>>>>>>>>>>>>> begin RLW patch
        ;; now updating *hinc* and reassigning hinc, en, and entl           
       (setq *hinc* hinc hinc 0 en *en* entl *entl*)  ;; setup to fool the product   
                 
   (setq disl (mapcar '(lambda (a) (vlax-curve-getDistAtPoint en (vlax-curve-getClosestPointTo en a))) pol))
       (if (> hinc 0) ; We have a profile at selected interval  ie hrz increment          ;
       (setq dist (- hinc (rem chbeg hinc))
             disl (vl-sort (append disl (in_range dist dtot hinc)) '<)
             )
       ; Else Points Every of Intersection 3dfaces   ie at every break in TIN   ;
       (setq disl (vl-sort (distinct (append disl (mapcar 'caddr entl))) '<))
       )
           
   (setq temp (list (list (car disl) (caar entl))))
       
   (setq entl (mapcar '(lambda (a)
                                   (setq i -1)
                           (while (< (caddr (nth (setq i (1+ i)) entl)) a))
                                   (list a (car (nth (1- i) entl)))
                               )
                       (cdr disl)
                           )
         )
   (setq entl (append temp entl)) ;; temp -was- tmp ...I think tmp is a typo
       
   (setq prof0 (mapcar '(lambda (a)
                               (setq  p (vlax-curve-getPointAtDist en (car a))
                 ps (get_3dfpts (cadr a))
                     )     
               (list (car a) (caddr (getz p (car ps) (cadr ps) (caddr ps))))
                             )
               entl
                   )
         )
             
   (if copyen  ;  If we had a 3dpoly, erase the temporary entity.     ;
       (setq ** (entdel en)
         en copyen copyen nil
             )
       ) 
;;>>>>>>>>>>>>>>>>>>>>>> 
;; now redoing the above with new assignments...
;;>>>>>>>>>>>>>>>>>>>>>>
;; reassigning hinc, en, and entl
       (setq hinc *hinc* en *en* entl *entl*)
       
   (setq disl (mapcar '(lambda (a) (vlax-curve-getDistAtPoint en (vlax-curve-getClosestPointTo en a))) pol))
       (if (> hinc 0) ; We have a profile at selected interval  ie hrz increment          ;
       (setq dist (- hinc (rem chbeg hinc))
             disl (vl-sort (append disl (in_range dist dtot hinc)) '<)
             )
       ; Else Points Every of Intersection 3dfaces   ie at every break in TIN   ;
       (setq disl (vl-sort (distinct (append disl (mapcar 'caddr entl))) '<))
       )
         
   (setq temp (list (list (car disl) (caar entl))))
       
   (setq entl (mapcar '(lambda (a)
                                   (setq i -1)
                           (while (< (caddr (nth (setq i (1+ i)) entl)) a))
                                   (list a (car (nth (1- i) entl)))
                               )
                       (cdr disl)
                           )
         )
   (setq entl (append temp entl)) ;; temp -was- tmp ...I think tmp is a typo
       
   (setq prof (mapcar '(lambda (a)
                               (setq  p (vlax-curve-getPointAtDist en (car a))
                 ps (get_3dfpts (cadr a))
                     )     
               (list (car a) (caddr (getz p (car ps) (cadr ps) (caddr ps))))
                             )
               entl
                   )
         )
             
   (if copyen  ;  If we had a 3dpoly, erase the temporary entity.     ;
       (setq ** (entdel en)
         en copyen copyen nil
             )
       ) 
;;>>>>>>>>>>>>>>>>>>>>>> close RLW patch
       
           ;; Var prof now contains the list of the profile sorted.           ; 
           (setq chal (mapcar '(lambda (a) (rtosta (+ chbeg (car  a)) 1 prec)) prof) ;; 1 IMPERIAL, 2 METRIC
         elvl (mapcar '(lambda (a) (rtos (cadr a) 2 prec)) prof)

Then at the bottom, and just above where it says, "Moving the profile where we want it"
I added the following for drawing and labeling horizontal grid lines for the Profile.

Code: [Select]
           
           (mk_layer (list "Profile Grid" gridcolor))
           (foreach p prof
              (ssadd (entmakex (list '(0 . "LINE") (cons 10 (list (car p) ylinc)) (cons 11 (list (car p) yline)))) ssp)
              (ssadd (entmakex (list '(0 . "LINE") (cons 10 (list (car p) yline)) (cons 11 p))) ssp)
          )
             
;;>>>>>>>> start patch by RLW
           ;; draw horizontal grid and label their elevations
           (setq pstart (car prof) pclose (last prof) cntz zmin)
           (setq ydatum (- (cadr pstart) (* vexag (- (atof (car elvl)) zmin))))     
           (while (< cntz zmax)
                  (setq cntz (+ cntz vinc))
                  (setq ofsy (* (- cntz zmin) vexag))
                  (setq x1 (car pstart)
                        y1 (+ ydatum ofsy)
                        z1 0                       
                        x2 (car pclose)
                        y2 y1
                        z2 0                       
                        g1 (list x1 y1 z1)
                        g2 (list x2 y2 z2)
                        )
                  (ssadd (entmakex (list '(0 . "LINE") (cons 10 g1) (cons 11 g2))) ssp)
                  (ssadd (mk_mtext (polar g1 pi txth) (rtos cntz 2 2) 6 txth 0) ssp)
                  )
           (ssadd (entmakex (list '(0 . "LINE") (cons 10 g1) (cons 11 pstart))) ssp)   ;; recent addition
           (ssadd (entmakex (list '(0 . "LINE") (cons 10 g2) (cons 11 pclose))) ssp)   ;; recent addition
             
           ;; delete the grid data profile line
           (vl-cmdf "._erase" ssx "")
;;>>>>>>> end patch by RLW

           ;; Moving the profile where we want it.                             ;
           (vl-cmdf "._MOVE" ssp "" org pause)
 
         

I have had to add some provisions that make it conform to your code. So if it doesn't work, let me know. It all works very well at my end. The horizontal grid lines at the bottom are recent. They need a some dressing up to look professional, but they do utilize the vinc variable and are nearly there.

Note: Just made a recent addition at the bottom of building the horizontal grid lines.
          I also changed (while (<= cntz zmax) to (while (< cntz zmax) so that the hrz grid
          will stop at zmax.
           
Rick
Title: Re: Triangulation (re-visited)
Post by: rw2691 on April 18, 2016, 09:27:46 AM
YMG,

I believe I may have found a problem with the REMDUPPOINT function. Since it is using BUTLAST to create a 2d point, it returns a horizontal distance instead of a slope distance.

Nevertheless, if two points were the bottom and top of a wall, it is possible that only the z value would separate them, and having the same xy values would be valid for a TIN... but REMDUPPOINT is deleting one of the points from the list.

Rick
Title: Re: Triangulation (re-visited)
Post by: rw2691 on April 19, 2016, 07:35:05 AM
YMG,

Consider the following to allow for elevation separation of equal 2d points...

Code: [Select]
;; remduppoint       by Joe Burke                                             ;
;; Remove Duplicate Adjacent Points from Point List with Fuzz Factor          ;
;; Point List Needs to be Sorted Prior to Calling this Function               ;
;; Modified by YMG to operate on 2d points... (butlast p)                     ;
(defun remduppoint (l fuzz / rtn p)
   (repeat (1- (length l))
           (setq p (car l))
           (if (> (distance (butlast p) (cadr l)) fuzz) ;; butlast for 2d
                   (setq rtn (cons p rtn))
                   (if (> (distance p (cadr l)) (* 2 fuzz)) ;; 3d & double fuzz
                       (setq rtn (cons p rtn))
                       )
                   )
               )
           (setq l (cdr l))
           )
   (reverse (cons (car l) rtn))
)

But if you do this you might also want to consider a sortxyz function, since the next z needs to be the nearest z...

Code: [Select]
(defun sortxyz (a / b c e1 e2)  ;;  a: list of points
       (setq b (vl-sort a (function (lambda (e1 e2) (< (caddr e1) (caddr e2)) ) )))  ;; by z
       (setq c (vl-sort b (function (lambda (e1 e2) (< (cadr e1) (cadr e2)) ) )))  ;; by y
       (setq a (vl-sort c (function (lambda (e1 e2) (< (car e1) (car e2)) ) )))  ;; by x             
       )

The above sortxyz was found and herewith modified from an anonymous forum example.

Note: I have edited my posting for REMDUPPOINT. I placed the code in the wrong place. I hope this fixes it.
Title: Re: Triangulation (re-visited)
Post by: squirreldip on April 19, 2016, 06:15:49 PM
I've been following this thread for quite some time and amazed by the progress and usefulness if this tool.

An improvement for me would be that Triangulation be broken down into separate functions that can be utilized/called within new routines.  For example, I would like to return the elevation at a given point...

I've attached a rework of the latest Triangulation and divided/added the following routines:

(TIN:GETPOINTSLIST <entset>) ;; Returns a list of points
Code: [Select]
(setq PLIST (TIN:GETPOINTSLIST (ssget)))
(TIN:GETBREAKLINELIST <entset>) ;; Returns a list of point pairs
Code: [Select]
(setq BLIST (TIN:GETBREAKLINELIST (ssget)))
(TIN:TRIANGULATE <plist> <blist>) ;; Returns a list of triangles
Code: [Select]
(setq TLIST (TIN:TRIANGULATE PLIST BLIST))
(TIN:DRAW <tlist>) ;; Creates an anonymous block on the current layer with the 3DFace triangles
Code: [Select]
(TIN:DRAW TLIST)
(TIN:GET <ent>) ;; Returns the list of triangles for the selected block drawn by TIN:DRAW
Code: [Select]
(setq TLIST (TIN:GET (car (entsel)))
(TIN:READ <filename>) ;; Returns the list of triangles as read from the file name provided
Code: [Select]
(setq TLIST (TIN:READ FILENAME))
(TIN:WRITE <filename> <tlist>) ;; Writes the triangle list to file name provided
Code: [Select]
(TIN:WRITE FILENAME TLIST)
(TIN:ELEVATIONATPOINT <point> <tlist>) ;; Returns the elevation of the point on the provided triangles
Code: [Select]
(setq Z (TIN:ELEVATIONATPOINT (getpoint) TLIST)

The last was a bit of a brute force to try to get what my thoughts are.  I've tried to keep all variables local.  There is so much time spent on this and so I'm sure this can be improved on.

Next steps would be to define a routine to return a section between two points, generate contours, include some of the other features that have been included in the original (such as boundaries).

If I'm way off base with what I've done here please let me know - if anyone agrees with this direction please also comment.


Edit - Link to updated file:
https://www.theswamp.org/index.php?topic=9042.msg564291#msg564291 (https://www.theswamp.org/index.php?topic=9042.msg564291#msg564291)
(fixed issue reported/solved by rw2691)
Title: Re: Triangulation (re-visited)
Post by: rw2691 on April 22, 2016, 04:30:57 PM
squirreldip,

I like the idea of getting an elevation at any position within the TIN.

I also like having utility functions that can be used for longer ranged goals.

Rick
Title: Re: Triangulation (re-visited)
Post by: ymg on April 23, 2016, 04:57:32 AM
Rick,

The triangulation is 2.5d , so it means that it cannot handle point with same x and y.

In order to be capable to separate on Z, you would need a 3d triangulation and
this is bound to be way too slow for Autolisp.

ymg
Title: Re: Triangulation (re-visited)
Post by: rw2691 on April 23, 2016, 10:01:00 AM
YMG,

So how will we deal with design models? The probability of field work having the same xy is slight, but designing a wall or building would usually have the same xy's. Likewise, topography volumes might be based on the same.

Rick
Title: Re: Triangulation (re-visited)
Post by: lamarn on April 23, 2016, 12:23:23 PM
Hi Rick i tried parts of the coding. Marko Ribar (i believe it was him) made the triangulation work in <current ucs>. To triangulate a wall you 'just' need to use this codimg after you set ucs the right way. (so that top view would be the view TO the wall). Check the treat ealier..

It is a great deal of handwork to make a real 3d triangulation for e.g. A bridge construction from multiple scans. I don't have the right workaround amd tools to do this in a fast matter. Most of the times some triangulation fo a detail is just what i need..
Title: Re: Triangulation (re-visited)
Post by: ymg on April 23, 2016, 12:35:44 PM
Rick,

In order to handle a wall, what could work would be to have a closed breakline
follow the top and bottom of the wall.

This way the invalid triangle would be purged.

Just an idea, never really tried it.

Just the same no triangulation that I know of can
handle an overhanged section.

ymg
Title: Re: Triangulation (re-visited)
Post by: squirreldip on April 23, 2016, 12:54:22 PM
Vertical faces are generally handled by adding breaklines at very minor offsets (I usually use 0.5 to 1.0mm).

Another advantage of what I'm proposing above is that you would be able to deal with multiple surfaces - say you had a rock layer or water table under the ground, you would be able to cut cross sections and show multiple layers.

I'm hoping that the master Triangulation can be reworked to include a separate TIN: module.

I've added a screen capture : (had to revise FUZZ in triangulate to be smaller than 0.001 so it didn't remove the wall points)
Title: Re: Triangulation (re-visited)
Post by: rw2691 on April 23, 2016, 02:11:20 PM
squirreldip,

I have tested your revision. All but one of the functions worked well. The TIN:READ has a few problems. I am a VL challenged person, so I rewrote the code with plain LISP. As such it also works well. In doing so I also had to add a function to replace the VL routines. It is TIN:GETSTRPOS.

I am glad you have done this because I have been wanting to have a READ/WRITE to files for the TIN's. Having that inclusion will allow the system to be more flexible and repeatable. I have also wanted a PICK ELEVATION function for design purposes.

Whether your entire concept should be adopted, however, I can't speak to... except that it looks like a lot of code changes and debugging to pull it off. Nevertheless, I can say that reviewing your code has caused me to have a better grasp of the TRIANGULATION program.

Code: [Select]
; find a string in a string - returns position of first letter - zero if none
(defun TIN:GETSTRPOS (ssub sall / lsub lall i n ret)
       (setq lall (strlen sall)
             lsub (strlen ssub)
             )
       (setq ssub (strcase ssub))
       (setq sall (strcase sall))
       (setq ret nil)
       (cond ((> lsub lall) 0)
             ((<= lsub lall) (setq i 1 n (1+ (- lall lsub)))
                             (while (and (not ret) (<= i n))
                                    (if (= ssub (substr sall i lsub))
                                        (setq ret i)
                                        (setq i (1+ i))
                                        )
                                    )
                             (if (= ret nil) (setq ret 0))
                             ret
                             )
             (T (if (= ssub sall) 1))
             )
       )
       

; TIN:READ reads the input file and returns a triangle list (lists of 3 3dpoint lists)
(defun TIN:READ (DiskFileName / DataFile DataLine P1 P2 P3 TL TLF X Y Z pos1 dat)
 (setq TLF nil dat 0)
 (if (setq DataFile (open DiskFileName "r"))
  (progn
   (while (setq DataLine (read-line DataFile))
          (setq dat (+ dat 1))
         
          (setq pos1 (TIN:GETSTRPOS "," DataLine))
          (setq X (atof (substr DataLine 1 (- pos1 1)))) ;; get X element of point
          (setq DataLine (substr DataLine (+ pos1 1))) ;; reduce DataLine to remainder
         
          (setq pos1 (TIN:GETSTRPOS "," DataLine))
          (setq Y (atof (substr DataLine 1 (- pos1 1)))) ;; get Y element of point
          (setq DataLine (substr DataLine (+ pos1 1))) ;; reduce DataLine to remainder
         
          (setq pos1 (TIN:GETSTRPOS "," DataLine))
          (setq Z (atof (substr DataLine 1 (- pos1 1)))) ;; get Z element of point
          (setq DataLine (substr DataLine (+ pos1 1))) ;; reduce DataLine to remainder
                     
          (setq P1 (list X Y Z))
         
          (setq pos1 (TIN:GETSTRPOS "," DataLine))
          (setq X (atof (substr DataLine 1 (- pos1 1)))) ;; get X element of point
          (setq DataLine (substr DataLine (+ pos1 1))) ;; reduce DataLine to remainder
         
          (setq pos1 (TIN:GETSTRPOS "," DataLine))
          (setq Y (atof (substr DataLine 1 (- pos1 1)))) ;; get Y element of point
          (setq DataLine (substr DataLine (+ pos1 1))) ;; reduce DataLine to remainder
         
          (setq pos1 (TIN:GETSTRPOS "," DataLine))
          (setq Z (atof (substr DataLine 1 (- pos1 1)))) ;; get Z element of point
          (setq DataLine (substr DataLine (+ pos1 1))) ;; reduce DataLine to remainder
                     
          (setq P2 (list X Y Z))
         
          (setq pos1 (TIN:GETSTRPOS "," DataLine))
          (setq X (atof (substr DataLine 1 (- pos1 1)))) ;; get X element of point
          (setq DataLine (substr DataLine (+ pos1 1))) ;; reduce DataLine to remainder
         
          (setq pos1 (TIN:GETSTRPOS "," DataLine))
          (setq Y (atof (substr DataLine 1 (- pos1 1)))) ;; get Y element of point
          (setq DataLine (substr DataLine (+ pos1 1))) ;; reduce DataLine to remainder
         
          (setq Z (atof DataLine)) ;; DataLine no longer has a delimiter
                     
          (setq P3 (list X Y Z))
         
          (setq TL (list P1 P2 P3))
          (setq TLF (append TLF (list TL)))
          ) ;; end while   
    (close DataFile)
  ) ; end progn
 ) ; end if
 (alert (strcat (itoa dat) " TIN's are imported."))
 TLF
) ; end TIN:READ

Thanks again for the new functions. They are important to me.

Rick.
Title: Re: Triangulation (re-visited)
Post by: rw2691 on April 23, 2016, 02:32:21 PM
To all,

I have tested my routine for retaining same xy with different z's. I see that it does hang. Previously I had only tested it where there are no same xy's. Since it didn't break the system I assumed it would just keep a wall TIN and work.

Thanks for you patience.

Rick
Title: Re: Triangulation (re-visited)
Post by: ymg on April 23, 2016, 02:35:58 PM
Robert,

So I tested with offset of 0.005 and yes it works.
A fuzz smaller than 0.001 will creates problem
in contours.

However it will not work for an overhang section.

The below image was done with program triang.

Title: Re: Triangulation (re-visited)
Post by: pedroantonio on April 24, 2016, 04:56:31 AM
Hi ymg. Any new update ?  :-)
Title: Re: Triangulation (re-visited)
Post by: ymg on April 25, 2016, 04:49:17 AM
Topographer,

No, not at the moment, I am still traveling in Europe

ymg
Title: Re: Triangulation (re-visited)
Post by: squirreldip on April 26, 2016, 12:50:58 PM
@Rick:  Here's an update using your code.  VL isn't an issue for myself but if it is for others it's likely best to remove dependence on it.  I believe your subroutine would only be needed within the TIN:READ routine so I added it as a local function.

Also, I also probably have a similar grasp to the program as yourself - I really want to weed out any unnecessary code within each TIN:* routine.

@ymg:  I understand about the FUZZ.  Maybe FUZZ should be a local variable to the contouring - having something smaller is necessary for trying to emulate vertical walls (it's nice to have dimensions accurate to mm).

Edit:  Update to Triang2016...  Added TIN:PROG making it 'global' and added an (entmake) in TIN:DRAW to clear buffer.

Note - revised here:
https://www.theswamp.org/index.php?topic=9042.msg564324#msg564324 (https://www.theswamp.org/index.php?topic=9042.msg564324#msg564324)
Title: Re: Triangulation (re-visited)
Post by: squirreldip on April 26, 2016, 07:15:05 PM
Revised Triang2016.lsp...

New routine (TIN:SECTIONPOINTTOPOINT P1 P2 TLIST), returns list of 2D distances (to P1) and elevations

Had to make a couple of local routines global:  TIN:REMDUPPOINT and TIN:BUTLAST

Edit - Link to latest:
https://www.theswamp.org/index.php?topic=9042.msg564537#msg564537 (https://www.theswamp.org/index.php?topic=9042.msg564537#msg564537)
Title: Re: Triangulation (re-visited)
Post by: rw2691 on April 27, 2016, 04:35:20 PM
squirreldip,

Here are some possible addon's ... NET, IMP, and ELV

They include some server functions to retain the User's active preferences for drafting

Code: [Select]
(defun c:net () ;; select an existing TIN network from drawing
       (princ "\nSelect TIN/3D-FACES")
       (alert "Choose existing 3DFACES")
       (setq ss (ssget '((0 . "3DFACE"))))
       (if ss
           (get_tin ss)
           (alert "No 3DFACES found.")
           )
       (princ)
       )

(defun c:imp () ;; import TIN network from disk file
       (setq TIN-NAME (getvar 'dwgname))
       (setq pos1 (TIN:GETSTRPOS ".dwg" TIN-NAME))
       (setq TIN-NAME (substr TIN-NAME 1 (- pos1 1)))
       (setq TIN-LIST (TIN:READ (strcat (getvar 'dwgprefix) TIN-NAME ".tin")))
       (if TIN-LIST
           (TIN:DRAW TIN-LIST)
           (alert "No TIN file found.")
           )
       (princ)
       )
       
(defun rw-disablesnap ()
       (setq actvsnap (getvar "osmode"))
       (setvar "osmode" 0)
       )

(defun rw-enablesnap ()
       (setvar "osmode" actvsnap)
       )

(defun rw-StoColor ()
       (setq olddrwcolor (getvar "cecolor"))
       (if (= setdrwcolor 0)
           (command "-color" "BYLAYER")
           (command "-color" setdrwcolor)
           )
       )

(defun rw-RclColor ()
       (setvar "cecolor" olddrwcolor)
       )
       
; save text size and style
(defun rw-AlterFont ()
       (setq saved_txtstyle (getvar "textstyle"))
       (setq saved_txtsize (getvar "textsize"))
       (setvar "textstyle" fntdsptyp)
       (princ)
       )

; restore text size and style
(defun rw-ResetFont ()
      (setvar "textstyle" saved_txtstyle)
      (setvar "textsize" saved_txtsize)
      (princ)
      )       
       
(defun c:elv ( / z pnt azm brg lstdir str1 hgtstr) ;; elevation... post the TIN elevation at cursor position
      (if (not TIN-LIST) (c:net))
      (if (not TIN-LIST) (c:imp))
      (if TIN-LIST
          (progn (alert "Select an elevation point")
                 
                 (rw-StoColor)
                 (rw-disablesnap)
                 (rw-AlterFont)
                 
                 (setq hgtstr (* 0.06 (getvar "ltscale")))
                 (setvar "cecolor" "1")
                 
                 (setq lstdir 0 z nil azm nil)
                 (mk_layer (list ".SRF-LBL" 1))
                       
                 (while (setq pnt (getpoint "\nPick elevation-point... "))
                        (setq Z (TIN:ELEVATIONATPOINT pnt TIN-LIST))     
                        (if z
                           (progn (setq str1 (rtos z))
                                  (if (setq azm (getangle pnt "\nDrag-direction for Label <def=last>... "))
                                      (setq brg (angtos azm 4 4))
                                      (setq brg lstdir)
                                      )
                                  (if (= brg "E") (setq brg 0.0))
                                  (command "-style" fntdsptyp fntdspshp hgtstr "1.00" fntobldeg "n" "n" "n")
                                  (command "-TEXT" "J" "MC" pnt brg str1)
                                  (setq lstdir brg)
                                  ) ; end progn                     
                           (alert "No TIN found at location. ") ; no z
                           ) ; end if
                        ) ; end while
             
                 (rw-ResetFont)
                 (rw-enablesnap)
                 (rw-RclColor)
                 
                 (princ)
                 ) ; end progn
          (alert "No TIN found nor any file to import. ")
          ) ; end if         
      ) ; end elv

These are codes that I have depended on for my work. It's a pain when software wrecks how you work. I try to program for the least impact on a user's sensibilities. One caution however... I program for US Feet and Degrees. No Metric in my area of the woods.

**********************************

An after thought and edit... the codes above are what I did to make Triang2016 compatible with TriangV0.6.7.0. They are prior to your recent improvements. To make my codes for NET and IMP I had added the following code to the very bottom of the GET_TIN function...

Code: [Select]
   ;; added for TIN:WRITE
   ;;==========================================   
   (acet-ui-progress "Finding triangles :" (/ (length tl) (setq count 10))) ;; starts acet-ui-progress bar
   (setq TIN-LIST nil) ; Initiate list of faces
   (foreach tr tl
     (setq TIN-LIST (append TIN-LIST (list (list (nth (car tr) pl)
                                                 (nth (cadr tr) pl)
                                                 (nth (caddr tr) pl)
                                                 )
                                           )
                            )
         )
     (prog count) ;; updates acet-ui-progress
     ) ; end foreach
   (acet-ui-progress) ;; ends acet-ui-progress bar
   (setq TIN-NAME (getvar 'dwgname))
   (setq pos1 (TIN:GETSTRPOS ".dwg" TIN-NAME))
   (setq TIN-NAME (substr TIN-NAME 1 (- pos1 1))) ;; get X element of point
   (TIN:WRITE (strcat (getvar 'dwgprefix) TIN-NAME ".tin") TIN-LIST) ;; save to disk
   ;;==========================================   
) ; end get_tin

It and the IMP codes are simply creating default name for the TIN-LIST, which is name of the active drawing with a ".tin" extension.

Rick
Title: Re: Triangulation (re-visited)
Post by: rw2691 on April 28, 2016, 09:31:29 AM

I have tested TIN:SECTIONPOINTTOPOINT. Below is the station and elevation output that it gave. Am I right to think that it should remove duplicates?

(
(9.09495e-013 655.968)
(4.82322 655.825) (4.82322 655.825)
(7.16779 656.057) (7.16779 656.057)
(8.54808 656.179) (8.54808 656.179)
(9.70276 655.841)
(10.0535 655.94) (10.0535 655.94)
(10.2378 656.041) (10.2378 656.041)
(13.0985 655.765) (13.0985 655.765)
(14.3455 655.156) (14.3455 655.156)
(20.8435 655.219)
(22.7677 655.213) (22.7677 655.213)
(23.3764 655.234) (23.3764 655.234)
(24.4665 655.195)
(34.6615 654.343) (34.6615 654.343)
(42.6784 653.661) (42.6784 653.661)
(46.4816 653.536)
(50.5878 653.314) (50.5878 653.314)
(54.2639 652.772) (54.2639 652.772)
(57.991 651.973) (57.991 651.973)
(72.7575 650.857)
(94.1628 649.526) (94.1628 649.526)
(106.853 649.14) (106.853 649.14)
(115.254 648.518) (115.254 648.518)
(116.036 648.46) (116.036 648.46)
(123.034 646.986) (123.034 646.986)
(138.04 645.694) (138.04 645.694)
(157.051 644.23) (157.051 644.23)
(168.358 643.21) (168.358 643.21)
(194.807 640.797)
)

Rick
Title: Re: Triangulation (re-visited)
Post by: squirreldip on April 28, 2016, 12:52:40 PM
Rick,

Little busy at work today (and a while) but I thought I removed the duplicates.  I'll recheck and if you can post your tin and section line I'll confirm what I'm getting.
Title: Re: Triangulation (re-visited)
Post by: squirreldip on April 28, 2016, 01:49:31 PM
Okay, found the issue...  The list has to be sorted prior to removing duplicates (guess I shouldn't skim so much when reading notes...)

Also, Made TIN:SORTXY a global function

Here's the update:

Edit - Latest here:
https://www.theswamp.org/index.php?topic=9042.msg564613#msg564613 (https://www.theswamp.org/index.php?topic=9042.msg564613#msg564613)
Title: Re: Triangulation (re-visited)
Post by: rw2691 on April 29, 2016, 07:58:04 AM
squirreldip,

Using FUZZ 0.001 for REMDUPPOINT is too small with TIN:SECTIONPOINTTOPOINT.

If P1 and P2 have elevations, then the REMDUPPOINT doesn't work on the initial point in the list...

Typical set with P1 & P2 @ elevations
(chose points by snapping to TIN)
(
(0.0 655.039)
(0.0 655.039)
(5.86765 653.97)
(7.69841 653.776)
(11.0488 653.818)
)

(another by snapping to TIN)
(
(0.0 654.68)
(1.81899e-012 654.68)
(1.19423 654.517)
(11.2871 653.697)
(12.5041 653.709)
)

(another by snapping to TIN)
(
(0.0 652.71)
(2.03369e-012 652.71)
(7.47364 652.762)
(24.7252 652.254)
(30.5482 652.05)
)

Typical set with P1 & P2 without elevations
(chose points in open space beyond TIN)
One byproduct is to not have a 0.0 point
(
(25.929 652.712)
(33.341 652.814)
(46.9912 652.499)
)

The "No Elevation" would always produce a similar list... as did the "With Elevation."

This is probably an issue that has always existed with REMDUPPOINT, but the larger FUZZ value had eliminated it.

Rick
Title: Re: Triangulation (re-visited)
Post by: rw2691 on April 29, 2016, 11:27:16 AM
YMG,

I found this code at www.augi.com. It deletes entities outside a closed polyline, and trims objects that cross the polyline. I thought it could be tweaked and used for the Boundary routine.

Code: [Select]
; Required Express tools
; OutSide Contour Delete with Extrim
; Found at http://forums.augi.com/showthread.php?t=55056
(defun C:OCD (  / en ss lst ssall bbox)
(vl-load-com)
  (if (and (setq en (car(entsel "\nSelect contour (polyline): ")))
           (wcmatch (cdr(assoc 0 (entget en))) "*POLYLINE"))
    (progn
      (setq bbox (ACET-ENT-GEOMEXTENTS en))
      (setq bbox (mapcar '(lambda(x)(trans x 0 1)) bbox))
      (setq lst (ACET-GEOM-OBJECT-POINT-LIST en 1e-3))
      (ACET-SS-ZOOM-EXTENTS (ACET-LIST-TO-SS (list en)))
      (command "_.Zoom" "0.95x")
      (if (null etrim)(load "extrim.lsp"))
      (etrim en (polar
                  (car bbox)
                  (angle (car bbox)(cadr bbox))
                  (* (distance (car bbox)(cadr bbox)) 1.1)))
      (if (and
            (setq ss (ssget "_CP" lst))
            (setq ssall (ssget "_X" (list (assoc 410 (entget en)))))
           )
        (progn
          (setq lst (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
          (foreach e1 lst (ssdel e1 ssall))
          (ACET-SS-ENTDEL ssall)
          )
        )
      )
    )
  )
(princ "\nType OCD to start")
(princ)

Rick
Title: Re: Triangulation (re-visited)
Post by: squirreldip on April 29, 2016, 01:33:18 PM
YMG, Rick:

I think I may have found a bug in remduppoint...

Shouldn't the line:
Code: [Select]
(if (> (distance (butlast p) (cadr l)) fuzz)
Actually be:
Code: [Select]
(if (> (distance (butlast p) (butlast (cadr l))) fuzz)
If p is a 3D point then (butlast p) is a 2D...  (cadr l) is a 3D point so shouldn't it need to be converted to 2D?

Code seems to work with this change:

Edit - Latest here:
https://www.theswamp.org/index.php?topic=9042.msg564730#msg564730 (https://www.theswamp.org/index.php?topic=9042.msg564730#msg564730)
Title: Re: Triangulation (re-visited)
Post by: rw2691 on April 29, 2016, 01:58:43 PM
YMG,

As to the Boundary filtering, I have modified the code I presented and it has worked to perfection. I removed all the EXTRIM code, and changed the SS selections to _WP and _X.

Code: [Select]
; Required Express tools
; OutSide Contour Delete with Extrim
; Found at http://forums.augi.com/showthread.php?t=55056
(defun C:OCD (  / en ss lst ssall bbox)
(vl-load-com)
  (if (and (setq en (car(entsel "\nSelect contour (polyline): ")))
           (wcmatch (cdr(assoc 0 (entget en))) "*POLYLINE"))
    (progn
      ;; *** commented out ***
      ;;(setq bbox (ACET-ENT-GEOMEXTENTS en))
      ;;(setq bbox (mapcar '(lambda(x)(trans x 0 1)) bbox))
     
      (setq lst (ACET-GEOM-OBJECT-POINT-LIST en 1e-3))
      (ACET-SS-ZOOM-EXTENTS (ACET-LIST-TO-SS (list en)))
      (command "_.Zoom" "0.95x")
     
      ;; *** commented out ***
      ; (if (null etrim)(load "extrim.lsp"))
      ; (etrim en (polar
                  ; (car bbox)
                  ; (angle (car bbox)(cadr bbox))
                  ; (* (distance (car bbox)(cadr bbox)) 1.1))
                  ; )

       ;; changed selections to _WP and _X,  and added 3DFACE filtering           
      (if (and   
            (setq ss (ssget "_WP" lst '((0 . "3DFACE")))) ;; select TINs inside polygon
            (setq ssall (ssget "_X" (list (cons 0 "3DFACE")))) ;; select all TINs in drawing
           )
        (progn
          (setq lst (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
          (foreach e1 lst (ssdel e1 ssall))
          (ACET-SS-ENTDEL ssall)
          )
        ) ; end if
      ) ; end progn
    )
  )

Afterward however, I had to modify the Boundary Polyline to a 2d Polyline. Then I used the OFFSET function to expand the Poly by 0.01 feet. When I activated OCD it cleaned out all 3dFaces that were outside my selected area... with no fault.

I imagine that the manual parts can be automated by creating a copied Polyline, as a new entity, and reducing it to a 2dPoly. Then its first point can be used to inverse to the second and last points.

Since the Boundary was created in a clockwise direction, those angles (added by right-perpendicular to the first, and left-perpendicular to the second) can be averaged, then their result may be reversed to create a selection point that is outside the Boundary. I don't remember if LISP will allow this, but the averaged angle could be used "as-is" with the distance being negative (-0.01).

Then use the OFFSET function, give it the 2dPoly and the point that was created. Then the 2dPoly can be erased and the OFFSET poly can be selected for the OCD routine.

Lastly, the OFFSET poly can be erased... the original Boundary line is still intact.

This method works better than selecting by FENCE, because it deletes the detached external 3dFaces as well as the Fenced.

Rick
Title: Re: Triangulation (re-visited)
Post by: rw2691 on April 29, 2016, 02:23:34 PM
squirreldip,

I made your change and did not get your results... first and second with elevation snapped are duplications.

(
(0.0 654.65)
(9.09495e-013 654.65)
(9.58188 654.45)
(20.1528 654.003)
(23.2885 653.668)
)

I don't think you need to do your change. When using the DISTANCE function it defaults to the lowest denominator, which is a 2d solution because only one element is 2d. Both have to be 3d to get sloped distances.

Rick
Title: Re: Triangulation (re-visited)
Post by: rw2691 on April 29, 2016, 03:48:52 PM
YMG,

This doesn't appear to be reliable in my opinion, but there is a "human nature" method for determining the outside of a closed polyline...

I read this from a book, Autocad Developer's  Guide to Visual LISP: When using the EntSel function a person normally selects the object by its outside position... due to the box-aperture by the mouse. So you might assume its click point as outside, and in particular if its elevation is 0.0.

For instance (setq es1 (entsel "Select object: ")) returns (Entity name: 14a9960>(301.791 138.438 0.0))

The name can be retrieved from the list with the CAR function, and its coordinates provide your outside element.

Just the same it can be resolved by asking the user to select the Boundary line, and then again, select a position outside the Boundary.

Rick
Title: Re: Triangulation (re-visited)
Post by: ymg on April 30, 2016, 04:01:18 AM
Squirreldip,

Quote
(distance '(10 10) '(10 15 100)) -->  5.0
(distance '(10 10 100) '(10 15)) --> 5.0

So 2d point with 3d point results with plane distance.

As for the discussion on fuzz,  We are talking about topographic survey
accuracy is on the order of centimeters not millimeters.

The fact that modern instruments returns a resolution of mm does
not make it accurate to mm.  Resolution and accuracy are two different thing.

For the vertical wall workaround offsetting 4 mm will hardly make a difference.

But it is a workaround.  Should you be taking point from a cliff, the point on the
face would not be ok.  You have to treat them separately on a different UCS

ymg
Title: Re: Triangulation (re-visited)
Post by: rw2691 on April 30, 2016, 09:59:14 AM
YMG,

I have worked out the Boundary and extraneous TIN's code...

After the (setq *bounden* (entlast)) code line within C:BOUND function, paste the following patch...

Code: [Select]
              (mk_3dp plst)             
              (setq *bounden* (entlast))

;;==========start patch             
              ;; *bounden* (3dPloyline) is used as a TIN limit and a BREAKLINE
              ;; *limiten* (2dPloyline) is created to facilitate deletion of extraneous TIN's
              ;; *limiten* is built at an outside offset of 0.0003 to *bounden*
              (mk_lwp plst)  ;(mk_2dp plst)
              (setq tmpen (entlast))
              (setq tmppt (list (- 0 99999999) (- 0 99999999) 0)) ;; a negative 100 million feet away
              (command "_offset" 0.0003 tmpen tmppt "") ; 0.0003             
              (setq *limiten* (entlast))             
              (entdel tmpen)
;;==========close patch 
             
              (redraw)
              )

Within the C:TIN function you replace the Boundary Deletion code with a call to OCD as follows, (AUGI:OCD *limiten*).

AUGI:OCD (now modified) is defined as follows...

Code: [Select]
; Required Express tools
; OutSide Contour Delete
; Found at http://forums.augi.com/showthread.php?t=55056
; modified by RW2691 (aka. Rick)
(defun AUGI:OCD (TIN-LIMIT / ss lst ssall e1 lst)
(vl-load-com)
  (if TIN-LIMIT
    (progn
      (setq lst (ACET-GEOM-OBJECT-POINT-LIST TIN-LIMIT 1e-3))
      (ACET-SS-ZOOM-EXTENTS (ACET-LIST-TO-SS (list TIN-LIMIT)))
      (command "_.Zoom" "0.95x")                 
      (if (and
            (setq ss (ssget "_WP" lst '((0 . "3DFACE")))) ;; select TINs inside polygon
            (setq ssall (ssget "_X" (list (cons 0 "3DFACE")))) ;; select all TINs in drawing
           )
        (progn
          (setq lst (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
          (foreach e1 lst (ssdel e1 ssall))
          (ACET-SS-ENTDEL ssall)
          )
        ) ; end if
      ) ; end progn
    )
  )

I have tested this arrangement by using the BOUND function, then moving the BOUNDEN and LIMITEN lines away from the Topo area, and building a TIN network (without them) with extraneous TIN's. Then I moved the BOUNDEN and LIMITEN lines back to their proper place, and made the following call from the keyboard commandline... (AUGI:OCD *limiten*). It worked without any fault.

Unfortunately, at this point, I do not know what sections within the C:TIN code should be replaced by the (AUGI:OCD *limiten*) call. I am also debating whether the LIMITEN line should then be deleted as well.

Perhaps you can help me with that?

Rick
Title: Re: Triangulation (re-visited)
Post by: ymg on April 30, 2016, 03:31:36 PM
Rick,

I had OCD in the code in prior version but never used it.

Right now, I am processing the outside boundary as well as
the holes with the following code:

Code - Auto/Visual Lisp: [Select]
  1.  ;;                                                             ;
  2.                ;; Erasing Triangles in Holes of Triangulation, and those      ;
  3.                ;; Outside of the boundary. Adjusting Triangle List.           ;
  4.                ;;                                                             ;
  5.                ;; Notes: This is a fast hack where we select 3Dfaces with a   ;
  6.                ;;        Crossing Polygon then Computes their Centroid and    ;
  7.                ;;        remove those whose centroid is inside the poly.      ;
  8.                ;;                                                             ;
  9.                ;;        Will change it eventually to offset the polyline     ;
  10.                ;;        to the outside by a few millimeters, and make the    ;
  11.                ;;        Selection by Window Polygon.                         ;
  12.                ;;                                                             ;
  13.                ;; Modified to handle external boundary   November 2015        ;
  14.                ;;                                                             ;
  15.  
  16.                (vl-cmdf "_ZOOM" "_E")
  17.                (if *bounden*
  18.                   (setq bp (distinct (mapcar '(lambda (a) (list (car a) (cadr a))) (listpol *bounden*))))
  19.                )
  20.                (foreach wp wpl
  21.                   (setq  ss (ssget "_CP" wp '((0 . "3DFACE"))))
  22.                   (repeat (setq i (sslength ss))
  23.                      (setq  en (ssname ss (setq i (1- i)))
  24.                            ent (entget en)
  25.                             tp (list (cdr (assoc 11 ent))
  26.                                      (cdr (assoc 12 ent))
  27.                                      (cdr (assoc 13 ent))
  28.                                )
  29.                             ct (centroid tp)
  30.                             in (ptinpoly_p ct (cons (last wp) wp))
  31.                      )
  32.                      (if (or
  33.                              (and in (not (equal wp bp)))
  34.                              (and (not in) (equal wp bp))
  35.                           )
  36.                          (setq tr (list (vl-position  (car   tp) pl)
  37.                                         (vl-position  (cadr  tp) pl)
  38.                                         (vl-position  (caddr tp) pl)
  39.                                   )
  40.                                tl (vl-remove tr tl)
  41.                              3dfl (vl-remove en 3dfl)
  42.                                ** (entdel en)
  43.                          )
  44.                      )
  45.                   )
  46.  
  47.  
Title: Re: Triangulation (re-visited)
Post by: rw2691 on April 30, 2016, 03:51:07 PM
YMG,

I would like you to look at how I modified the OCD code. It virtually clips all 3dfaces that are outside the Boundary. Nothing is missed. It also is not using a Centroid model, which can fall outside the body of the Boundary. It is work your examination. Please test it.

Rick
Title: Re: Triangulation (re-visited)
Post by: ymg on April 30, 2016, 04:21:48 PM
Rick,

I will look at it.  But the centroid of a triangle
is guaranteed to be inside.

The routine to check if that centroid is in the
polyline is ptinpoly_p and I've checked it quite
extensively.

A simplification of this would be to check if the
biggest polyline in bp contains all the point of the
triangulation. If so we would trim the exterior,
else if it has no point within we trim the inside.

This way we remove the necessity to assign the
outside boundary to a layer in order to recognize it.

Now I look at your modification.  To make it work with TIN
you simply need to update tl by removing any triangle that you
are deleting.  You do the same with 3dfl removing the ENAME
of  any 3DFACES you delete.

This snippet does it:

Code - Auto/Visual Lisp: [Select]
  1. (setq tr (list
  2.                    (vl-position  (car   tp) pl)
  3.                    (vl-position  (cadr  tp) pl)
  4.                    (vl-position  (caddr tp) pl)
  5.             )
  6.          tl (vl-remove tr tl)
  7.       3dfl (vl-remove en 3dfl)
  8.        ** (entdel en)
  9. )
  10.  



ymg
Title: Re: Triangulation (re-visited)
Post by: rw2691 on April 30, 2016, 05:13:52 PM
YMG,

When I use your current Centroid routine it does not delete external TIN's that have only one corner touching the Boundary, and it does not delete any TIN's that are detached and beyond the Boundary. Leaving the user to manually delete them one by one.

The OCD does delete them. It doesn't miss any TIN that is outside, and it protects all that are inside.

Rick
Title: Re: Triangulation (re-visited)
Post by: ymg on April 30, 2016, 05:20:52 PM
Rick,

Could be a bug as this was put together quite fast.

But as I told you, I am only using centroid of triangles
and ptinpoly_p to check if the centroid is inside the polyline

I will have a look at it.

ymg
Title: Re: Triangulation (re-visited)
Post by: ymg on April 30, 2016, 06:40:46 PM
Rick,

I did a few test and I could not replicate the behaviour
you are experiencing.

However if your boundary is not exactly on the nodes
you will have something like what you describe.

As it is the bound function is not too good, the following is
a little better.

Code - Auto/Visual Lisp: [Select]
  1. (defun c:bound (/ sp tmp)
  2.    (setq oldosm (getvar 'OSMODE))
  3.    (if (not csurf) (setq csurf "Natural Ground"))
  4.    (if (/= "" (setq tmp (getstring (strcat "\nCreates a Boundary for TIN <" csurf ">: "))))
  5.      (setq csurf tmp)
  6.    )
  7.    (mk_layer (list "Boundary" 2))
  8.    
  9.    (setvar 'OSMODE 8)
  10.    (prompt "\nSelect Points on Boundary: ")
  11.    (command "_3DPOLY"  pause )
  12.      (while (command pause))  
  13.    (setq *bounden* (entlast))
  14.    (setvar 'OSMODE oldosm)
  15.    (princ)
  16. )
  17.  
Title: Re: Triangulation (re-visited)
Post by: rw2691 on May 01, 2016, 10:37:00 AM
ymg,

Attached is a JPG of the TIN using your recent BOUND code. It did not leave any tit's touching the boundary, but it did leave the detached TIN's beyond the boundary.

Rick
Title: Re: Triangulation (re-visited)
Post by: rw2691 on May 01, 2016, 10:57:45 AM
YMG,

This is another that I did from the same drawing. It has the tit's that touch the boundary. The only thing that I did differently was to move the boundary off, and then move the boundary back, then also including a larger selection of points.

Rick
Title: Re: Triangulation (re-visited)
Post by: rw2691 on May 01, 2016, 11:08:52 AM
YMG,

I just undid everything in the drawing to the first Boundary. Then I selected the larger set of points for the TIN. It gave the identical set tits and orphans. So moving the boundary off, and then back, had not changed anything. These results are also the same as when I use your former Centroid code.

None of this happens with the OCD code as I have modified it... providing that you include the modification that I made to the BOUND code, which copies and offsets *BOUNDEN* as *LIMITEN*.

Rick
Title: Re: Triangulation (re-visited)
Post by: rw2691 on May 01, 2016, 11:27:27 AM
ymg,

Here is the same drawing, but with using the AUGI:OCD code.

Rick
Title: Re: Triangulation (re-visited)
Post by: rw2691 on May 02, 2016, 10:28:19 AM
YMG,

I have now implemented AUGI:OCD into the TIN code. It is working well.

Upon doing so I decided to review the tests that I had made. There is something that might need to be considered. I am using State Plane coordinates, which are very large. So when I use PRINC to print the LISTPOL results it returns (1.47777e+006  433888.0  0.0) as a typical coordinate. Maybe it is a fault of PRINC, but the actual coordinates for that point are "1477771.31901  433888.37054  654.73". Their difference is a severe reduction of precision. In fact, I would think that it wouldn't work at all.

Likewise when I use the PROPERTIES function it reports X=1477771.32  Y=433888.37  Z=654.73 for that same point. Which is also a reduction to precision, but probably acceptable.

But when I pick that point with a utility function that have for posting coordinates, it prints the data to five decimal places. So I know that ACAD is capable of handling large coordinates with high precision.

So maybe the above discrepancies are just a PRINC problem.

Rick
Title: Re: Triangulation (re-visited)
Post by: squirreldip on May 02, 2016, 01:01:47 PM
I understand and agree with the network not making any difference for surveyed surfaces - but having small offsets of 1mm or less is common for design surfaces.

I've updated the code slightly to use a 2D distance command and revised the TIN:SECTIONPOINTTOPOINT to remove duplicates based on the offset/elevation rather than the raw points.

I can live with this as a limitation but has there been any answer to why the remove duplicates doesn't work?  The data that Rick gave definitely falls within 0.001 or 0.003 fuzz.
Title: Re: Triangulation (re-visited)
Post by: ymg on May 04, 2016, 10:57:22 AM
@ Rick,

Please post the drawing that you used in your test.

Using large coordinates will cause problems with the vlax-curve function.
Might also be a problem with the iscw_p function.

@ Robert,

As far as I know, remove duplicates works if your point list is sorted.

ymg
Title: Re: Triangulation (re-visited)
Post by: rw2691 on May 04, 2016, 03:56:53 PM
YMG,

The drawing is attached. It is an ACAD 2004 format. I work with different layers than your code operates with. The point data for topography is in ".TOP-*", and the Surface layers are ".SRF-*". This drawing is compiled by using my AUGI:OCD code. Since I recently deleted all of my test files, I had to construct this one for you. It has a Boundary Line, but I did not include the break lines. I didn't think they were necessary for the demonstration. But maybe they will be... let me know.

If large coordinates actually turns out to be the issue, AUGI:OCD can handle them. This drawing is State Plane coordinates. It is actually very small in comparison to UTM coordinates, which is becoming more popular because it covers multiple States at a time. A fair number of practitioners are currently working across wide regions of the country, and they like having a single database for coordinates.

The following are my edits to the AUGI:OCD code to integrate with C:TIN, and then my edits to C:TIN to work with AUGI:OCD.

AUGI:OCD ...
Code: [Select]
; Required Express tools
; OutSide Contour Delete
; Found at http://forums.augi.com/showthread.php?t=55056
; modified by RW2691 (aka. Rick)
(defun AUGI:OCD (TIN-LIMIT / ss ssall e1 lst ent tp tr)   ;;  Global: tl 3dfl
(vl-load-com)
  (if TIN-LIMIT
    (progn ; 1
      (setq lst (ACET-GEOM-OBJECT-POINT-LIST TIN-LIMIT 1e-3))
      (ACET-SS-ZOOM-EXTENTS (ACET-LIST-TO-SS (list TIN-LIMIT)))
      (command "_.Zoom" "0.95x")                 
      (if (and (setq ss (ssget "_WP" lst '((0 . "3DFACE")))) ;; select TINs inside polygon
               (setq ssall (ssget "_X" (list (cons 0 "3DFACE")))) ;; select all TINs in drawing
               )
          (progn ; 2
          (setq lst (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))) ;; lst is save-group
          (foreach e1 lst (ssdel e1 ssall))  ;; removes save-group from entity list
         
          (repeat (setq i (sslength ssall))   ;; repeat to update tl and 3dfl
                  (setq  en (ssname ssall (setq i (1- i)))
                        ent (entget en)
                         tp (list (cdr (assoc 11 ent))  ;; translate to point
                                  (cdr (assoc 12 ent))
                                  (cdr (assoc 13 ent))
                                  )
                         tr (list (vl-position (car tp) pl)  ;; query point info ;; pl was tl was lst
                                  (vl-position (cadr tp) pl)
                                  (vl-position (caddr tp) pl)
                                  )
                         tl (vl-remove tr tl)  ;; erase TIN-Set from TIN list
                       3dfl (vl-remove en 3dfl)  ;; erase TIN-object from 3DFACE list
                       ) ; end setq
                  ) ;; end repeat
         
          (ACET-SS-ENTDEL ssall)  ;; deletes all remaining entities
          ) ; end progn 2
        ) ; end if
      ) ; end progn 1
    )
  ) ;; end AUGI:OCD

C:TIN ...
Code: [Select]
                      (acet-ui-progress) ;; ends acet-ui-progress bar
                      (if *LIMITEN* (AUGI:OCD *LIMITEN*))  ;; erase extraneous TIN's by LIMITEN patch-insert
           
;;************* start LIMITEN patch-cut
                      ;; Erasing Triangles in Holes of Triangulation, and those     ;
                      ;;         outside of the boundary. Adjusting Triangle List.  ;
                      ;; Notes: This is a fast hack where we select 3Dfaces with a  ;
                      ;;        Crossing Polygon then Computes their Centroid and   ;
                      ;;        remove those whose centroid is inside the poly.     ;
                      ;;        (But the centroid could be outside the poly)        ;
                      ;;        Will change it eventually to offset the polyline    ;
                      ;;        to the outside by a few millimeters, and make the   ;
                      ;;        Selection by Window Polygon.                        ;             
                      ; (vl-cmdf "._ZOOM" "_E")
                      ; (if *bounden*  ;; created by BND function
                          ; (setq bp (distinct (mapcar '(lambda (a) (list (car a) (cadr a))) (listpol *bounden*))))
                          ; )
                      ; (foreach wp wpl
                            ; (setq ss (ssget "_CP" wp '((0 . "3DFACE"))))
                            ; (repeat (setq i (sslength ss))  ;; i is repeat i times
                                    ; (setq  en (ssname ss (setq i (1- i)))
                                          ; ent (entget en)
                                           ; tp (list (cdr (assoc 11 ent))
                                                    ; (cdr (assoc 12 ent))
                                                    ; (cdr (assoc 13 ent))
                                                    ; )
                                           ; ct (centroid tp) ;; get centroid
                                           ; in (ptinpoly_p ct (cons (last wp) wp))
                                           ; )
                                    ; (if (or (and in (not (equal wp bp)))
                                            ; (and (not in) (equal wp bp))
                                            ; )   
                                        ; (setq tr (list (vl-position  (car   tp) pl)
                                                       ; (vl-position  (cadr  tp) pl)
                                                       ; (vl-position  (caddr tp) pl)
                                                       ; )
                                              ; tl (vl-remove tr tl)
                                            ; 3dfl (vl-remove en 3dfl) 
                                              ; ** (entdel en)
                                             ; ) ; end setq
                                        ; ) ; end if                     
                                    ; ) ;; end repeat
                         ;    ) ;; end foreach
;;************* close LIMITEN patch-cut
           
                      ;; Processing Boundary                   
                      (vl-cmdf "._ZOOM" "_P")

Rick
Title: Re: Triangulation (re-visited)
Post by: ymg on May 04, 2016, 05:05:51 PM
Rick,

I just did a test and I believe we are talking two different things.

The boundary of the triangulation is something that encloses all the
point that are to be triangulated.  Triangles that are removed are the
one outside of that boundary.  In other word you supply tin only
the points inside or on the boundary and all the outside triangle
gets trimmed.

I believe you triangulated all the points shown on your drawing
and wanted to trim the triangulated zone with the closed breakline
shown on your drawing.

In such a case OCD or any othe Cookie Cutter routine can  and should
be used.

But you end up triangulating and contouring a zone for no reason.

ymg
Title: Re: Triangulation (re-visited)
Post by: rw2691 on May 05, 2016, 07:30:18 AM
YMG,

Yes... I plot the field points (which always include exterior traverse points), draw the breaklines and boundary, then window the points of interest for the TIN. In the process of windowing, some of the exterior and unwanted points are included in the selection.

Consequently, a TIN is built on all points chosen, but then it removes all those TIN's that lay outside the boundary. They were accidental and unwanted.

The result is that you only have TIN's that are within the boundary limits, and you haven't needed to be very picky about selecting its points... simply square-window the area.

I don't quite understand the method that you have described, and I guess you have never understood my objective as well. For myself, the purpose of a boundary is to allow a relaxed and quick selection.

I should have had a clue when, some time back, you said that you always draw your boundary after having done the contours. Where as, I was proposing that the boundary be drawn before building the TIN. I also thought it was odd that you were bothered by my referring to them as Bogus TIN's. Maybe the word "boundary" should not have been used. It is a TIN and Contours Limit-Line.

Rick

Title: Re: Triangulation (re-visited)
Post by: rw2691 on May 05, 2016, 07:51:33 AM
YMG,

I realize that I forgot to repost my alteration to BOUND. It is essential...

Code: [Select]
(mk_3dp plst)             
              (setq *bounden* (entlast))
             
              ;; *bounden* (3dPloyline) is used as a TIN limit and a BREAKLINE
              ;; *limiten* (2dPloyline) is created to facilitate deletion of extraneous TIN's
              ;; *limiten* is built at an outside offset of 0.005 to *bounden*
              (mk_lwp plst)  ;(mk_2dp plst)
              (setq tmpen (entlast))
              (setq ofspt (list (- 0 999999) (- 0 999999) 0))   ;; a negative 1 million feet past 0,0,0.
              (command "_offset" 0.005 tmpen ofspt "")   ;; 0.005             
              (setq *limiten* (entlast))             
              (entdel tmpen)
             
              (redraw)
              ) ;; end progn

The above creates the outer offset entity that is named *Limiten*.

Rick
Title: Re: Triangulation (re-visited)
Post by: ymg on May 05, 2016, 05:55:07 PM
Rick,

To select only the points that should be in the triangulation,
you can enter "cp" at the Select Objects: prompts and trace
the a rough outline of the triangulated zone excluding the
points you do not want to includes.

Another way, would be to make a simple modification to triang,
where when selecting  a single polyline, the program would then
select automatically all the entities inside.

If the selection set as a length greater than one selection is interpreted
as usual and the selection inside that polyline would be bypassed.

ymg
Title: Re: Triangulation (re-visited)
Post by: ymg on May 06, 2016, 06:42:58 AM
Rick,

If you replace the following code at the beginning of Triang,
You will be able to select a single entity, either an LWpolyline
or a 3DPOLYLINE and the triangulation will be limited to what
is inside.

If the single entity selected is a 3DPOLYLINE, it becomes the
boundary.  Otherwise the triangulation has no boundary but
the selection is limited to what is inside.

Code - Auto/Visual Lisp: [Select]
  1.  
  2. (setq ss nil ssb nil ssw nil
  3.          flt '((0 . "POINT,INSERT,LWPOLYLINE,POLYLINE,LINE"))
  4. )
  5. (if (setq proceed (setup "tins"))
  6.       (progn
  7.          (setq ss (ssget flt))
  8.          (if (and (= (sslength ss) 1)
  9.                   (setq en  (ssname ss 0))
  10.                   (setq ent (entget en))
  11.                   (setq typ (cdr (assoc 0 ent)))    
  12.                   (or (= typ "LWPOLYLINE")
  13.                       (= typ "POLYLINE")
  14.                   )
  15.               )    
  16.             (progn
  17.                (vl-cmdf "_ZOOM" "_O" en "")
  18.                (setq pol (distinct (listpol en))
  19.                      ss (ssget "_CP" pol flt)
  20.                )
  21.                (vl-cmdf "_ZOOM" "_P")
  22.                (if (= "AcDb3dPolyline" (cdr (assoc 100 (cdr (member '(100 . "AcDbEntity") ent)))))
  23.                   (setq *bounden* en) ; 3d polyline, becomes boundary         ;
  24.                   (ssdel en ss)        ; 2d polyline, remove it from selection ;
  25.                )
  26.             )
  27.            
  28.          )
  29.       )  
  30.    )
  31.  
Title: Re: Triangulation (re-visited)
Post by: rw2691 on May 06, 2016, 09:35:18 AM
YMG,

I implemented your patch. It provided a very nice way to build the TIN.

I assumed that I was supposed to disable the AUGI:OCD, and to also leave the former code that OCD replaced disabled, because I thought that only what was inside the Boundary was going to acquired.

The result was as follows... although it was limited to the boundary, it still created external TIN's by linking boundary points to boundary points.

It is nevertheless an improvement, but I would have to reactivate the OCD code to clean out the external TIN's.

BTW, there was some orphaned code by this line:  (setq typ (cdr (assoc 0 ent)))      ent (entget en)
I deleted the "ent (entget en)" at its end before I ran the test.

Rick
Title: Re: Triangulation (re-visited)
Post by: rw2691 on May 06, 2016, 09:51:38 AM
YMG,

I just tried it with a 2D LWpolyline and it did not work because it refused the poly as a selection.

Rick
Title: Re: Triangulation (re-visited)
Post by: ymg on May 06, 2016, 10:17:57 AM
Quote
I just tried it with a 2D LWpolyline and it did not work because it refused the poly as a selection.

There was a bug at (ssdel en) should be (ssdel en ss)

I corrected in the above and removed the orphan.

OCD remains an option as a standalone routine to clean
your final presentation.
Title: Re: Triangulation (re-visited)
Post by: rw2691 on May 06, 2016, 11:48:43 AM
YMG,

I don't see where FLT is being set. The only place that I find is an indirect assignment by "getfencesel", but the only place it is called by is "getproftin" for PROF.

Rick
Title: Re: Triangulation (re-visited)
Post by: rw2691 on May 06, 2016, 12:39:20 PM
YMG,

I took the liberty of assigning the FLT variable... (setq flt '((0 . "POINT,INSERT,*LINE")))

Then I reactivated your section of code that AUGI:OCD had replaced in C:TIN.

It worked flawlessly. The TIN was built internally to the boundary, and all exterior TIN's were removed.

I created contours by the same and it drew them properly.

I won't have to use the OCD code, but implementing it had taught me lot about LISP and your Triangles program.

Your new code that selects by the Boundary has made the entire system more flexible. You can load a drawing that already has the points and boundary, and build the TIN. Frequently work sessions get interrupted. This allows a user to exit and resume without any loss to what he had already done.

Rick
Title: Re: Triangulation (re-visited)
Post by: ymg on May 06, 2016, 01:45:22 PM
Rick,

I should have incluse these 2 lines in the snippet.

Code - Auto/Visual Lisp: [Select]
  1. (setq  ss nil ssb nil ssw nil
  2.       flt '((0 . "POINT,INSERT,LWPOLYLINE,POLYLINE,LINE"))
  3. )
  4.  

Note that I removed the *line from the filter as there was a
slim possibility to select "MLINE" which are not handled.

ymg
Title: Re: Triangulation (re-visited)
Post by: rw2691 on May 06, 2016, 03:26:36 PM
YMG,

ssw, though it is initialized in version 0.6.7.0, is never used.

Rick
Title: Re: Triangulation (re-visited)
Post by: rw2691 on May 08, 2016, 09:03:02 AM
YMG,

In "defun contour", and at the "foreach p xl" section, you have...
(setq isclosed nil code 0)

I think you want it to be...
(setq isclosed nil code 128)

Rick
Title: Re: Triangulation (re-visited)
Post by: rw2691 on May 12, 2016, 09:30:27 AM
YMG,

I found this mistake in your TIN patch...

                (progn
                      (vl-cmdf "_ZOOM" "_O" en)
                      (setq pol (listpol en)                  ;; was... ***  (setq pol (distinct (listpol en)) ***
                               ss (ssget "_CP" pol flt)
                               )
                      (vl-cmdf "_ZOOM" "_P")

The 3rd line should not use the DISTINCT function. It eliminates the closing points, and results with TIN's contiguous to the closing point being erased. The above code is modified to remove DISTINCT.

Rick
Title: Re: Triangulation (re-visited)
Post by: rw2691 on May 12, 2016, 09:33:43 AM
To all,

Can anyone explain to me how an INSERT might be used as a BREAK-LINE?

Rick
Title: Re: Triangulation (re-visited)
Post by: rw2691 on May 12, 2016, 09:36:05 AM
To all,

Can anyone tell me what the MAKEREADABLE function is doing?

Rick
Title: Re: Triangulation (re-visited)
Post by: ribarm on May 12, 2016, 12:25:36 PM
To all,

Can anyone tell me what the MAKEREADABLE function is doing?

Rick

Without checking, so I may be wrong, but IMO this sub function is intended to place text objects rotation to be the most acceptable for reading that text object...
Title: Re: Triangulation (re-visited)
Post by: rw2691 on May 12, 2016, 03:17:35 PM
ribarm,

That's what I had assumed. It isn't working with ViewTwist activated.

Rick
Title: Re: Triangulation (re-visited)
Post by: rw2691 on May 12, 2016, 04:20:43 PM
YMG,

MakeReadable has a problem with ViewTwist. I use ViewTwist to fit a drawing on to paper. Your routine is elegant ... and so much so, that I can't follow it. You may have trouble with my code as well. It is gritty. Nevertheless, it handles the upright scenario with or without ViewTwist being active...

Code: [Select]
(defun rw-SetTxtUpright (setazm / azmref ucsaxis azmaxs) ;; sets bearing to upright by "twist" perspective
       (if (< setazm 0)
           (setq azmref (+ setazm (* pi 2))) ; pi radians = 180 deg
           (setq azmref setazm)
           )
       (if (> azmref (* pi 2)) ; 360 deg
           (setq azmref (- azmref (* pi 2)))
           )
       (setq ucsaxs (getvar "viewtwist"))
       (if (< ucsaxs 0)
           (setq azmaxs (+ ucsaxs (* pi 2)))
           (setq azmaxs ucsaxs)
           )
       (if (> azmaxs (* pi 2))
           (setq azmaxs (- azmaxs (* pi 2)))
           )
       (setq azmref (+ azmref azmaxs)) ; rotate ref by axs
       (if (> azmref (* pi 2))
           (setq azmref (- azmref (* pi 2)))
           )
       (if (and (> azmref (/ pi 2)) ; 90 deg
                (< azmref (* (/ pi 2) 3)) ; 270 deg
                )
           (+ setazm pi) ;; report bearing righted
           setazm ;; report bearing normal
           )
       )

Rick
Title: Re: Triangulation (re-visited)
Post by: rw2691 on May 12, 2016, 04:39:27 PM
YMG,

I have written code for labeling contours by simply picking a point on the contour and writing its elevation at that spot. Drag-Lines are cool, but I rarely have an occasion where they are applicable. I am always having to dodge other data and objects on the drawing.

The following is a rework to your mk_mtext. I have simply added masking to it for my application.

Code: [Select]
;; mk_mtext  by ymg  *** modified as mk_masked_text by rw2691 for masking *** ;
;; Arguments: p,  Insertion Point.                                            ;
;;            s,  Text.                                                       ;
;;            j,  Justification:                                              ;
;;                1 = Top left; 2 = Top center; 3 = Top right;                ;
;;                4 = Middle left; 5 = Middle center; 6 = Middle right;       ;
;;                7 = Bottom left; 8 = Bottom center; 9 = Bottom right        ;
;;            h,  Text Height.                                                ;
;;            r,  Rotation.                                                   ;
;;            c,  text color                                                  ;
;;            ms,  mask state ...1=on 2=off                                   ;
;;            mc,  mask color ...1, 7, or 254 slight-gray or ash                       ;
;;            mr,  mask ratio ...typical is 1.4                               ;
;; Limitation: 255 character string for text
(defun mk_masked_text (p s j h r c ms mc mr)
   (if (= ms nil) (setq ms 2 mc 1 mr 1.4))
   (entmakex
      (list (cons 0   "MTEXT")         
            (cons 100 "AcDbEntity")         
            (cons 100 "AcDbMText")   
            (cons 10 p) ;; point
            (cons 71 j) ;; justify
            (cons 40 h) ;; height         
            (cons 50 r) ;; rotate by radians 0=right pi=left
            (cons  1 s) ;; string
            (cons 62 c) ;; color 256=bylayer 0=byblock negative=layeroff           
            (cons 90 ms) ;; mask state ;; 1 is mask-on ... 2 is mask-off
            (cons 63 mc) ;; mask color ;; 1 is red, 7 white, 254 ash, etc.
            (cons 45 mr) ;; mask ratio ;; 1.0 is text height, 1.4 is 0.4 larger than text height
      )
   )
)

Rick
Title: Re: Triangulation (re-visited)
Post by: rw2691 on May 12, 2016, 05:13:20 PM
YMG,

This is my labeling code. It uses the mk_masked_text that I posted, and the rw-SetTxtUpright as well. It has an advantage in that it will work with splines as well as all the other lines and poly's. I devised a mechanical method for finding the bearing at any position along any line type.

Code: [Select]
(defun c:lbl () ;; utility command name that can be changed
       (rw-cmdlbl)
       )

; Label contour line. Works with line, polyline, lwpolyline, 2d & 3d polyline, spline and point.
(defun rw-cmdlbl (/ en0 en1 en2 azm pnt snp i dst str1 elv) 
       (setq j 0)
       (mk_layer (list ".SRF-LBL" 1)) ;; this differs from the standard layer scheme... it can be changed
       (while (= j 0) ; 1st while
             (setq i 0)
             (while (= i 0) ; 2nd while
                     (setq oldsnap (getvar "osmode") en0 nil en1 nil en2 nil)
                     (setvar "osmode" 512)
                     (setq pnt (getpoint "\nSelect contour at label position (snap-nearest active)... "))
                     (setvar "osmode" oldsnap)
                     (if pnt (setq en0 (osnap pnt "near")))
                     (if en0 (setq en1 (car (nentselp en0))))
                     (if en1 (progn (setq ed (entget en1))
                                    (setq et (cdr (assoc 0 ed)))
                                    (if (= et "POLYLINE") (setq i 1))
                                    (if (= et "LWPOLYLINE") (setq i 2))
                                    (if (= et "2DPOLYLINE") (setq i 1))
                                    (if (= et "3DPOLYLINE") (setq i 1))
                                    (if (= et "SPLINE") (setq i 1))
                                    (if (= et "LINE") (setq i 1))
                                    (if (= et "POINT") (setq i 1))
                                    ) ;p
                             (progn (setq rsp (getstring "\nWarning - No contour found...  exit?  Y/N <Y>: "))
                                    (if (= rsp "") (setq rsp "Y"))
                                    (setq rsp (strcase rsp))
                                    (if (= rsp "Y") (setq i 9 j 9 et "EXIT")) ; i 0 was i 9
                                    ) ;p
                             ) ;i
                     (if (= i 1) (setq elv (cadddr (assoc 10 ed))))
                     (if (= i 2) (setq elv (cdr (assoc 38 ed))))
                     (if (and (= elv 0)(> i 0))
                         (progn (setq drw (getstring "\nWarning -- Contour is 0... Label? Y/N <Y>: "))
                                (if (/= drw "") (setq drw (strcase drw)))
                                (if (/= drw "N") (setq i 1) (setq i 0))
                                )
                         )
                      ) ; end 2nd while
              (if (and (< i 9) (< j 9)) ; was (and (> i 0) (< i 9))
                  (progn (setq txtscale (* (getvar "ltscale") 0.06)) ;; 0.06 hight for red's printing width
                         (setq str1 (rtos elv 2 0)) ;; 0 is precision, ie. 0, 1 or 2... etc.
                         
                         ;>>>>>=====================================================
                         ;; start process for aquiring bearing of line at snap-point
                         (setq dst (strlen str1))
                         (setq dst (/ (* dst txtscale) 200))
                         
                         (command "circle" pnt dst)
                         (setq en2 (entlast))
                                                 
                         (setq snp (osnap pnt "_app"))  ;; "_end,_int" to combine snaps for other applications
                         ;; note: it doesn't matter which INT it snaps, rw-SetTxtUpright will correct its display                         
                         (setq azm (rw-SetTxtUpright (angle pnt snp)))  ;; alternate: (setq azm (makereadable (angle pnt snp)))
                         (entdel en2)
                         ;; close process for aquiring bearing of line at snap-point
                         ;>>>>>=====================================================
                         
                         ;; (mk_masked_text point string justify height rotation color mask-state mask-color mask-ratio)
                         (mk_masked_text pnt str1 5 txtscale azm 1 1 254 1.4)
                         ) ;p
                  ) ;i
              ) ; end 1st while
       (princ)
       ) ;; end rw-cmdlbl

Rick
Title: Re: Triangulation (re-visited)
Post by: rw2691 on May 12, 2016, 05:29:41 PM
YMG,

This is an entmake for spirals... upon building contours, I additionally build a spiral from your adjusted curves, and I place them in a private layer. I do it by placing the following code at the end of the foreeach section of "defun contours"

       (setq LastLyr (getvar "CLAYER"))
       (mk_layer (list ".SRF-FIN" 7))
       (Make_Spline lp z)
       (setvar "CLAYER" LastLyr)

Afterward I can compare them and tweak the spirals where they have been too liberal. They have problems where a contour has not been rounded because it turns nearly 90 degrees to the path. The spiral swings out to smooth the turn. Yet it is easy to notice and correct by dragging nodes.

It is also something that could be fixed by placing in and out nodes to force the sharp turn. The spiral would follow that condition.

Code: [Select]
(defun Make_Spline (lst-pts z / p px py pt data closed)
      ;; Author: R. Togores (togoresr@unican.es)
      ;; Modified: R. Wills (rick.wills@mapmakers.biz)
      ;; drawing layer, lisp point-list, contour-elevation or nil
      ;; point-list can be 2d or 3d, open or closed, contour or radical
      ;; if z is specified (not nil) it creates 3d spline with uniform elevation
     
      (setq closed nil closed (equal (car lst-pts ) (last lst-pts ) 0.005)) ;; set closed or open
     
      (if z (progn
               (setq data nil)
               (foreach p lst-pts
                   (setq pt (list (car p) (cadr p) z)) ;; build contour elevation
                   (setq data (append data (list pt)))
                   ) ;f
               (setq lst-pts data)                   
               ) ;p
            ) ;i
           
      (entmake (append (list '(0 . "SPLINE")
                             '(100 . "AcDbEntity")
                             '(100 . "AcDbSpline")
                             '(44 . 1.0e-005)
                              (cons 48 0.75) ;;  celtscale... pattern scaler
                              (cons 71 (if closed    ;; bitwise 1=closed
                                           11        ;;         2=periodic; default for closed [hence 11]
                                           8         ;;         4=rational
                                           ) ;i      ;;         8=planar; default for closed [hence 11]
                                    ) ;c             ;;         16=linear
                              '(70 . 1)  ;; degree of spline: number of control-points + 1, ie. 1 is none
                              (cons 74 (if closed
                                           (1+ (length lst-pts )) ;; number of fit-points
                                           (length lst-pts )
                                           ) ;i
                                    ) ;c
                              ) ;l
                       (if closed (cons (cons 11 (last lst-pts ))
                                        (mapcar '(lambda (x) (cons 11 x)) lst-pts)  ;; closed fit-points
                                        ) ;c
                                  (mapcar '(lambda (x) (cons 11 x)) lst-pts)  ;; open fit-points
                           ) ;i
                       ) ;a
              ) ;e
       ) ;m

Rick
Title: Re: Triangulation (re-visited)
Post by: ymg on May 15, 2016, 04:50:17 AM
Rick,

Thanks ! for your contribution. 

The makereadable is indeed to keep text oriented in a readable manner,
and it does not take into account twisted view.

For the labeling, there is already 3 different way in the program:
       dlbl   -  For dynamic labeling with drag line
       flbl    -  Same as above but not dynamic
        lbl    -  Put label at a given spacing on contours.

The one you are proposing would help in completing the suite.
Incidentally they all use text mask.

However the whole program needs a revision for twist angle and /or UCS.

For Splines in Contour, I tend to stay away and do not plan to integrate any.

In closing here maybe a little better for readable text orientation.
Instead of using rem to normalize the angle we use  (atan (sin a) (cos a))
which gives an angle between -pi and pi.  Also notes that I test on 10 degrees
past the 90 to mimic the Express tool behaviour.

Need to be tested.

Code - Auto/Visual Lisp: [Select]
  1. (defun torient (a)
  2.    (setq a (atan (sin a) (cos a)))
  3.    (if (minusp a)
  4.       (if (< a -1.5708) (+ a pi) a)
  5.       (if (> a  1.7453) (+ a pi) a)      
  6.    )
  7. )
  8.  

Yet another one for direction of polyline less sensitive to
roundoff, and a little faster than what I had.

Code - Auto/Visual Lisp: [Select]
  1. ;;                                                                             ;
  2. ;; iscw_p         by ymg     (From a Routine in C++ by Dan Sunday)             ;
  3. ;;                                                                             ;
  4. ;; Predicate to Test the Orientation of a Simple Closed Polyline               ;
  5. ;;                                                                             ;
  6. ;;  Argument:  l -  List of Points (Opt. First Point Repeats at End of list)   ;
  7. ;;                                                                             ;
  8. ;;  Return:    t -  Polyline is clockwise                                      ;
  9. ;;           nil -  Polyline is counterclockwise or Degenerate (< (length l) 3);
  10. ;;                                                                             ;
  11. ;;  Note:     This algorithm is about 20% faster than computing                ;
  12. ;;            the signed area and is less subject to rounding error            ;
  13. ;;            when using large coordinates.                                    ;
  14. ;;                                                                             ;
  15.  
  16. (defun iscw_p (l / x0 y0 x1 y1 pos i p0 p2)
  17.    
  18.    (or (equal (car l) (last l)) (setq l (cons (last l) l)))
  19.    
  20.    (setq y1 1.7e308  i 0)
  21.    (mapcar
  22.       (function
  23.          (lambda (p)
  24.             (cond
  25.                ((> (cadr p) y1))
  26.                ((and (= (cadr p) y1) (<= (car p) x1)))
  27.                (t (setq pos i x1 (car p) y1 (cadr p)))
  28.             )
  29.             (setq i (1+ i))
  30.          )
  31.       )
  32.       l
  33.    )
  34.    
  35.    (if (zerop pos)
  36.       (setq p0 (cadr (reverse l))
  37.             x0 (car p0)  y0 (cadr p0)  p2 (cadr l)
  38.       )
  39.       (setq p0 (nth (1- pos) l)
  40.             x0 (car p0)  y0 (cadr p0)  p2 (nth (1+ pos) l)
  41.       )
  42.    )    
  43.    (< (* (- x1 x0) (- (cadr p2) y0)) (* (- (car p2) x0) (- y1 y0)))
  44. )
  45.  





Title: Re: Triangulation (re-visited)
Post by: rw2691 on May 15, 2016, 12:41:00 PM
YMG,

Quote
For the labeling, there is already 3 different way in the program:
       dlbl   -  For dynamic labeling with drag line
       flbl    -  Same as above but not dynamic
        lbl    -  Put label at a given spacing on contours.

The one you are proposing would help in completing the suite.
Incidentally they all use text mask.

I created the mk_masked_text function because their method for activating the background color was temperamental. It worked once and then quit. I couldn't track down what was wrong. That is one of the things that I don't like about VLAX routines. Using your mk_mtext and modifying it was very direct. It always works.

Rick
Title: Re: Triangulation (re-visited)
Post by: rw2691 on May 17, 2016, 08:47:43 AM
YMG,

I patched in torient and renamed it to MakeReadable. It functioned the same as the former MakeReadable had done. No loss to function.

I patched in iscw_p and hid the former iscw_p. It functioned well.

As to other things. I looked at the masking in FLBL. Its VLAX coloring is less than its actual mask, and the coloring is also offset slightly toward the right of the text. I compared this with the MK_MASKED_TEXT function and its mask and coloring match each other, and they are uniform (not offset) to the text body. I think its behavior is better than the VLAX code.

In looking for clockwise and counter behavior, I got things wrong at some point, thinking that your BOUND routine had to be constructed in a clockwise direction. So I drew it counterwise to make it fail. It did not. It built the TIN and removed external ones the same as a clockwise poly would have.

However, I still encountered some misbehavior by the BOUND selection and rejection of TIN's. So I have re-implemented the OCD method for removing external TIN's. Perhaps that is why a clockwise  poly doesn't matter... if it ever did?

When I went back to the OCD I also rebuilt it. It no longer needs any patch within any other routines (such as BOUND). I also renamed OCD to ERASE-OUTSIDE, and it only needs the singular call from within TIN ... (if *bounden* (erase-outside *bounden*)) ...making its nomenclature intuitive and sentence-like.

Code: [Select]
; Required Express tools
; OCD: OutSide Contour Delete, was... AUGI:OCD
; Found at http://forums.augi.com/showthread.php?t=55056
; modified by RW2691 (aka. Rick)
(defun ERASE-OUTSIDE (*3D-POLY* / ss ssall e1 lst ent tp tr blst *tmpen* *LIMIT* ofspt blst)
  (vl-load-com)
  (if *3D-POLY*
    (progn ;; #A
      ;;(setq blst (distinct (mapcar '(lambda (a) (list (car a) (cadr a))) (listpol *3D-POLY*))))
      (setq blst (listpol *3D-POLY*))
      (mk_lwp blst) ;; build 2dpoly #1
      (setq *tmpen* (entlast)) ;; select 2dpoly #1
      (setq ofspt (list (- 0 9999) (- 0 9999) 0))   ;;  point at a negative 10 thousand feet past 0,0,0.
      (command "_offset" 0.005 *tmpen* ofspt "")   ;;  build 2dpoly #2 at 0.005' offset
      (setq *LIMIT* (entlast)) ;; select 2dpoly #2
      (entdel *tmpen*) ;; erase 2dpoly #1
   
      (setq lst (ACET-GEOM-OBJECT-POINT-LIST *LIMIT* 1e-3))
      (ACET-SS-ZOOM-EXTENTS (ACET-LIST-TO-SS (list *LIMIT*)))
      (entdel *LIMIT*) ;; erase 2dpoly #2
     
      (command "_.Zoom" "0.95x")                 
      (if (and (setq ss (ssget "_WP" lst '((0 . "3DFACE")))) ;; select TINs inside polygon
               (setq ssall (ssget "_A" (list (cons 0 "3DFACE")))) ;; select all visible TINs in drawing
               )                ;; _A was _X ;; _A selects all visible items, and _X gets all drawing items
          (progn ;; #B
          (setq lst (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))) ;; lst is save-group
          (foreach e1 lst (ssdel e1 ssall))  ;; removes save-group from entity list
         
          ;;====================================================================
          ;; start repeat to update globals: TL and 3DFL per PL
          (repeat (setq i (sslength ssall))
                  (setq  en (ssname ssall (setq i (1- i)))
                        ent (entget en)
                         tp (list (cdr (assoc 11 ent))  ;; translate to point
                                  (cdr (assoc 12 ent))
                                  (cdr (assoc 13 ent))
                                  )
                         tr (list (vl-position (car tp) pl)  ;; query point info
                                  (vl-position (cadr tp) pl)
                                  (vl-position (caddr tp) pl)
                                  )
                         tl (vl-remove tr tl) ;; erase TIN-Set from TIN list
                       3dfl (vl-remove en 3dfl) ;; erase object from 3DFACE list
                       ) ; end setq
                  )                         
          ;; close repeat to update globals: TL and 3DFL per PL
          ;;====================================================================
         
          (ACET-SS-ENTDEL ssall)  ;; deletes all remaining external entities
          (vl-cmdf  "._DRAWORDER" ss "" "_BACK") ;; sets to back
          (vl-cmdf "._regen")
          ) ; end progn #B
        ) ; end if 3DFACE
      ) ; end progn #A
    ) ; end if *3D-POLY*
  (princ)
  ) ;; end ERASE-OUTSIDE

I know you don't like it, but I have posted it per chance that someone else can make use of it.

Rick
Title: Re: Triangulation (re-visited)
Post by: rw2691 on May 18, 2016, 09:25:32 AM
YMG,

In sections that change layers to draw different objects, such as in CONTOUR, it would process faster if you included the layer name within the ENTMAKE code. By doing so the active layer will never change... increasing the speed.

An example is where I plot point data from a disk file. It swaps layers for the point, a marker, a description label, an index label, and an elevation label. With a certain list it took 45 seconds. After changing the code by using ENTMAKE and assigning layers, it only took 40 seconds to process the same list. An 11% boost.

Code: [Select]
; example: for a text object with layer assigned...

(entmake
          (list (cons 0 "TEXT") ; object
                (cons 1 TxtStr) ; string
                (cons 7 "STANDARD") ; style
                (cons 8 "POINT-TEXT")  ; layer
                (cons 10 DwgPnt)  ; insert point
                (cons 11 DwgPnt)  ; custom point... not changing
                (cons 39 0.0)  ; thickness
                (cons 40 (* 0.06 (getvar "ltscale")))  ; hight by drawing scale
                (cons 50 ortang) ; rotation... using ortho-mode radians
                (cons 51 0.06981317) ; oblique radians... using slight slant
                (cons 62 256) ; color bylayer
                (cons 71 0) ; justify mirror
                (cons 72 0) ; justify left
                (cons 73 3) ; justify top
                (cons 210 (list 0.0 0.0 1.0))  ; extrusion direction               
                ) ;l
          ) ;e

; example: for a point object

(entmake
          (list (cons 0 "POINT") ; object
                (cons 6 "BYLAYER") ; linetype
                (cons 8 "POINT-MARKER") ; layer
                (cons 10 DwgPnt) ; point
                (cons 39 0.0)  ; thickness
                (cons 50 ortang) ; ortho-mode radians
                (cons 62 256) ; color bylayer
                (cons 210 (list 0.0 0.0 1.0)) ; extrusion direction
                ) ;l
          ) ;e


Additionally, by doing the above the active layer, linetype, and color are never changed. User values stay the same.

Rick.
Title: Re: Triangulation (re-visited)
Post by: ymg on May 18, 2016, 10:41:00 AM
Rick,

I'll check but honestly I doubt it.

By default the current layer is used when entmaking.
So what I do normally is to set the current layer outside
of the loop and then process the contour.

So I did a few test and not putting the layer is a little faster.
Although the gain is small this section of codes get used once
for every contours. But the gain is offset by setting the layer
when we go from major to minor.


Hovewer I noted that in your example, you are using
cons even for constant values

Did a few test on this and '(0 . "LWPOLYLINE) is faster
than (cons 0 "LWPOLYLINE")

Even a tiny bit faster is assigning those constant to a variable
as I do. (list ph1 ph2 ph3...)

In conclusion, personnally I prefer to set the current layer and
do without the (cons 8 layer), but doing it would not change
the performance by a lot.

ymg
Title: Re: Triangulation (re-visited)
Post by: rw2691 on May 18, 2016, 02:10:18 PM
YMG,

I had wondered why some will mix their methods when doing an ENTMAKE. The following is fairly common...

(list '(0 . "LWPOLYLINE")
      '(100 . "AcDbEntity")
      '(100 . "AcDbPolyline")
       (cons 8 "0")
       (cons 90 (length pt_lst))
       (cons 70 clsd)
      )

One negative I found with ENTMAKE's is that they trigger a REGEN. I had to turn REGEN's off during their screen plotting. It still makes the UCS icon flicker, and I can't get that to stop.

Rick
Title: Re: Triangulation (re-visited)
Post by: rw2691 on May 18, 2016, 03:11:34 PM
YMG,

I might add that I do most of my programming in Pascal and by the Lazarus Compiler. With it I use ActiveX or OLE methods and the same list of points and layer differentials are processed in 15 seconds with no flicker by anything.

Rick
Title: Re: Triangulation (re-visited)
Post by: rw2691 on May 20, 2016, 03:20:47 PM
To all,


Code: [Select]
(defun c:lbl ()   ;; COULD BE NAMED SLBL FOR "SPOT LABEL"
       (rw-cmdlbl)   ;; for drag-line... (setq ss (ssget "_F" plst (list '(0 . "SPLINE")(cons 8 ".SRF-FIN"))))
       )

; Label contour line.
(defun rw-cmdlbl (/ en0 en1 en2 azm pnt snp i dst str1 elv) 
       (rw-setcadunits)
       (setq jst1 "C" jst2 "M" sze 0.06 setdrwcolor 1 dstdsp 0) ;; for rw-SetupText
       (rw-SetupText)
       (setq j 0)
       (mk_layer (list ".SRF-LBL" 1))
       
       (while (= j 0) ; 1st while       
              (setq grdval (getvar "elevation")) ; save preset elevation (normally 0.0)
              (setq grdmod (getvar "OSNAPZ")) ; save elevation snap-mode
              (setvar "OSNAPZ" 0) ; set snap to object-grade
              (setq oldsnap (getvar "osmode") en0 nil en1 nil en2 nil)
              (setvar "osmode" 512) ;; snap nearest
             
              (setq i 0)
              (while (= i 0) ; 2nd while
                     (setq pnt (getpoint "\n\nSelect contour at label position (snap-nearest active)... "))
                     (if pnt (setq en0 (osnap pnt "near")))
                     (if en0 (setq en1 (car (nentselp en0))))
                     (if en1 (progn (setq ed (entget en1))
                                    (setq et (cdr (assoc 0 ed)))
                                    (if (= et "LINE") (setq i 1))
                                    (if (= et "POLYLINE") (setq i 1))
                                    (if (= et "LWPOLYLINE") (setq i 2))
                                    (if (= et "2DPOLYLINE") (setq i 1))
                                    (if (= et "3DPOLYLINE") (setq i 1))
                                    (if (= et "SPLINE") (setq i 1))  ;; for testing splines ...can have phantom snap issue
                                    )
                              )
                     (if (or (not en1) (= i 0))     
                             (progn (setq rsp (getstring "\nWarning - No contour found...  exit?  Y/N <Y>: "))
                                    (if (= rsp "") (setq rsp "Y"))
                                    (setq rsp (strcase rsp))
                                    (if (= rsp "Y") (setq i 9 j 9 et "EXIT")) ; i 0 was i 9
                                    )
                             )
                             
                     ;;(if (= i 1) (setq elv (cadddr (assoc 10 ed))))  ;;  **for when snapz is inactive
                     ;;(if (= i 2) (setq elv (cdr (assoc 38 ed))))  ;;  **for when snapz is inactive
                     
                     (setq elv (caddr pnt)) ;; **for when snapz is active ...this section activates snapz
                     
                     (if (and (= elv 0)(> i 0))
                         (progn (setq drw (getstring "\nWarning -- Contour is 0... Label? Y/N <Y>: "))
                                (if (/= drw "") (setq drw (strcase drw)))
                                (if (/= drw "N") (setq i 1) (setq i 0))
                                )
                         )
                     ) ; end 2nd while
                     
              (setvar "osmode" oldsnap)
              (setvar "OSNAPZ" grdmod) ; restore elevation snap-mode
              (setvar "elevation" grdval) ; restore preset-elevation (normally 0.0)
             
              (if (and (< i 9) (< j 9)) ; was (and (> i 0) (< i 9))
                   (progn
                     (rw-StoColor)
                     (rw-disablesnap)
                     (rw-AlterFont)
                     
                     (setq txtscale (* (getvar "ltscale") 0.06)) ;; 0.06 hight for red's printing width
                     (setq str1 (rtos elv 2 0)) ;; 0 is precision, ie. 0, 1 or 2... etc.
                     
                     ;>>>>>=====================================================
                     ;; start process for aquiring bearing of line at snap-point
                     (setq dst (strlen str1))
                     (setq dst (/ (* dst txtscale) 150))                     
                     (command "circle" pnt dst)  ;; was... dst)
                     (setq en2 (entlast))
                                             
                     (setq snp (osnap pnt "_app"))  ;; "_end,_int" to combine snaps for other applications                   
                     (setq azm (rw-SetTxtUpright (angle pnt snp)))  ;; alternate: (setq azm (makereadable (angle pnt snp)))
                     (entdel en2)
                     ;; close process for aquiring bearing of line at snap-point
                     ;>>>>>=====================================================
                   
                     ;; for plain text...  cuts the line at front and back of label
                     ;(setvar "textsize" txtscale)
                     ;(setvar "cecolor" "1") ; color red 
                     ;(setq dst (+ (strlen str1) 1.0))
                     ;(setq dst (/ (* dst hgt) 2.0))
                     ;(command "circle" pnt dst)
                     ;(setq en2 (entlast))
                     ;(command "trim" en2 "" pnt "") ;; cuts the line from each side of text
                     ;(entdel en2)
                     ;(command "-style" fntdsptyp fntdspshp hgtstr "1.00" fntobldeg "n" "n" "n")
                     ;(command "-TEXT" "J" "MC" pnt brg str1)
                     
                     ;; for mtext...
                     ; mk_masked_text point string justify hight rotation color mask-state mask-color mask-ratio
                     (mk_masked_text pnt str1 5 txtscale azm 1 1 254 1.3) ;; no need to cut line
                     
                     (rw-ResetFont)
                     (rw-enablesnap)
                     (rw-RclColor)
                     )
                  )
              ) ; end 1st while
       (rw-putcadunits)
       (princ)
       ) ;; end lbl


(defun rw-SetTxtUpright (setazm / azmref ucsaxis azmaxs)   ;;   sets bearing to upright by natural and "viewtwist" perspectives
       (if (< setazm 0)
           (setq azmref (+ setazm (* pi 2))) ; pi radians = 180 deg
           (setq azmref setazm)
           )
       (if (> azmref (* pi 2)) ; 360 deg
           (setq azmref (- azmref (* pi 2)))
           )
       (setq ucsaxs (getvar "viewtwist"))
       (if (< ucsaxs 0)
           (setq azmaxs (+ ucsaxs (* pi 2)))
           (setq azmaxs ucsaxs)
           )
       (if (> azmaxs (* pi 2))
           (setq azmaxs (- azmaxs (* pi 2)))
           )
       (setq azmref (+ azmref azmaxs)) ; rotate ref by axs
       (if (> azmref (* pi 2))
           (setq azmref (- azmref (* pi 2)))
           )
       (if (and (> azmref (/ pi 2)) ; 90 deg
                (< azmref (* (/ pi 2) 3)) ; 270 deg
                )
           (+ setazm pi) ;; report bearing righted
           setazm ;; report bearing normal
           )
       )

;; mk_mtext  by ymg  *** modified as mk_masked_text by rw2691 for masking *** ;
;; Arguments: p,  Insertion Point.                                            ;
;;            s,  Text.                                                       ;
;;            j,  Justification:                                              ;
;;                1 = Top left; 2 = Top center; 3 = Top right;                ;
;;                4 = Middle left; 5 = Middle center; 6 = Middle right;       ;
;;                7 = Bottom left; 8 = Bottom center; 9 = Bottom right        ;
;;            h,  Text Height.                                                ;
;;            r,  Rotation.                                                   ;
;;            c,  text color                                                  ;
;;            ms,  mask state ...1=on 2=off                                   ;
;;            mc,  mask color ...254 slight-gray or ash                       ;
;;            mr,  mask ratio ...typical is 1.4                               ;
;; Limitation: <s> having a maximum 2040 character string <being 8 times 255> ;
(defun mk_masked_text (p s j h r c ms mc mr / x1 ent1)
   (if (= ms nil) (setq ms 2)) ;; turns off mask
   (if (= mc nil) (setq mc 250)) ;; sets to black
   (if (= mr nil) (setq mr 1.3)) ;; better than nothing

;;==================================================================
;; the below is for testing large strings... this is 2040 characters
;; with codes like \\p, only the \p is counted... being 2 characters
;; <s> will actually process this string, but I am testing it parsed
   
(setq s "*1* xt upon text over and over again\\Ptext upon text over and over 0001*2* \\P upon text over and over again\\Ptext upon text over and over again\\Ptext upon text over and over again\\Ptext upon text over and over again\\Ptext upon text over and over again\\Ptext upon text over and over again\\Ptext upon text over and   0002*3* \\P upon text over and over again\\Ptext upon text over and over again\\Ptext upon text over and over again\\Ptext upon text over and over again\\Ptext upon text over and over again\\Ptext* *512*
*1* xt upon text over and over again\\Ptext upon text over and over 0001*2* \\P upon text over and over again\\Ptext upon text over and over again\\Ptext upon text over and over again\\Ptext upon text over and over again\\Ptext upon text over and over again\\Ptext upon text over and over again\\Ptext upon text over and   0002*3* \\P upon text over and over again\\Ptext upon text over and over again\\Ptext upon text over and over again\\Ptext upon text over and over again\\Ptext upon text over and over again\\Ptext* *512*
*1* xt upon text over and over again\\Ptext upon text over and over 0001*2* \\P upon text over and over again\\Ptext upon text over and over again\\Ptext upon text over and over again\\Ptext upon text over and over again\\Ptext upon text over and over again\\Ptext upon text over and over again\\Ptext upon text over and   0002*3* \\P upon text over and over again\\Ptext upon text over and over again\\Ptext upon text over and over again\\Ptext upon text over and over again\\Ptext upon text over and over again\\Ptext* *512*
*1* xt upon text over and over again\\Ptext upon text over and over 0001*2* \\P upon text over and over again\\Ptext upon text over and over again\\Ptext upon text over and over again\\Ptext upon text over and over again\\Ptext upon text over and over again\\Ptext upon text over and over again\\Ptext upon text over and   0002*3* \\P upon text over and over again\\Ptext upon text over and over again\\Ptext upon text over and over again\\Ptext upon text over and over again\\Ptext upon text over and over again\\Pt *508*")

;; rename the above <s> to <sk> in setq for testing by snap-line elevation
;; the below clears <sk> from memory upon switching back to <s>
(setq sk nil)
;;==================================================================

   (setq ent1 (entmakex
      (list '(0 . "MTEXT") 
            '(100 . "AcDbEntity")         
            '(100 . "AcDbMText")   
            (cons 10 p) ;; point
            (cons 71 j) ;; justify
            (cons 40 h) ;; height         
            (cons 50 r) ;; rotate by radians 0=right pi=left
            (cons 62 c) ;; color 256=bylayer 0=byblock negative=layeroff           
            (cons 90 ms) ;; mask state ;; 1 is mask-on ... 2 is mask-off
            (cons 63 mc) ;; mask color ;; 1 is red, 7 white, 254 ash, etc.
            (cons 45 mr) ;; mask ratio ;; 1.0 is text height, 1.4 is 0.4 larger than text height
           
            ; (foreach x (MakeMTlist s)            ;;  This did not work but it should have.
                     ; (cons (car x) (cdr x))      ;;  Replaced it with late binding below.
                     ; ) 
                     
            ) ;l
      ) ;e
      )
     
   (foreach x1 (MakeMTlist s)                                    ;; I think this is called late binding.
            (objmod ent1 (car x1) (cdr x1))                      ;; This doesn't work but it should have
            (princ "\n\n")                                       ;; There seems to be something wrong with the object
            (princ (cons (car x1) (cdr x1))) ;; print as test
            )
               
   ) ;d
   
(defun objmod (modent moditm modval / moddat)  ;; late binder
       (setq moddat (entget modent))           ; Sets moddat to the entity data
                                               ; for entity name moddat.                                           
       (setq moddat
             (subst (cons moditm modval)
                    (assoc moditm moddat)      ; Changes the moditm group in
                    moddat                     ; moddat to modval.
                    )
             )         
       (entmod moddat)                         ; Modifies entity value in drawing.       
       (entupd modent)                         ; updates entity object 
       )   
       
;; Function: MakeMtextLists, Steve Doman, 11-17-99
;; eMail: steved@onlinemac.com
;; modified by RLW 05/19/2016
(defun MakeMTlist (text / sl left k tempstr textlist)
       (setq sl (strlen text))
       
       (if (<= sl 250) ;; 250 is the DXF CODE maximum
           (setq textlist (list (cons 1 text)))           ;;  single block
           (progn                               
              (setq left 1 k sl textlist nil)  ;;  **copy method**
              (while (> k 250)                                            ;;  mutliple blocks
                     (setq tempstr (substr text left 250)
                           textlist (append textlist (list (cons 3 tempstr)))
                           left (+ left 250)
                           k (- k 250)
                           )
                     ) ;while
              (setq tempstr (substr text left sl)                         ;;  trailing block
                    textlist (append textlist (list (cons 1 tempstr)))
                    )
              );progn
           );if

       ;;(princ textlist)
       textlist
       ) ;;end defun

The above is where I have been trying to improve the MakeMtext routine. Mtext is assumed to be limited to a 255 character capacity unless you load it in a certain way... being 250 character blocks, each assigned  to the (3 . "your text") association. When your text is less than 250 characters it is assigned to (1 . "your text"). I say assumed because I have discovered that it can take 2040 characters without my having to parse anything.

Nevertheless, parsing is what I need to do. I have tried to accomplish this with two different methods. Neither have worked. It seems there is something wrong with the basic construction of the Mtext entity. As is, with a very long string, which my code loads into the s variable, it only records the portion that gets loaded into (1 . "your text"). It behaves the same with both of the methods that I have employed.

I am hoping that one of you can see the folly of my ways... apparently both ways, or even the enmake way.

To see the code operate normally, just rename the <s> variable to sk. Then change it back to s to work on the long string again. To know what was actually processed, just hit the F2 key on your keyboard. The data is printed in its output window.

Rick
Title: Re: Triangulation (re-visited)
Post by: roy_043 on May 20, 2016, 04:46:22 PM
I think your entmakex code should look like this:
Code - Auto/Visual Lisp: [Select]
  1. (setq ent1
  2.     (append
  3.       (list
  4.         '(0 . "MTEXT")
  5.         ...
  6.       )
  7.       (MakeMTlist s)
  8.     )
  9.   )
  10. )

Your entmod code does not work because you are trying to subst gc entries that are not present in the entity list.

Using vla-addmtext may be easier.
Title: Re: Triangulation (re-visited)
Post by: rw2691 on May 21, 2016, 07:34:49 AM
Roy,

Thank you. That made it work. But I changed it to ENTMAKE because I didn't need to do ENTMAKEX if I am not calling the OBJMOD function afterward. It now processes any volume of text.

Code: [Select]
;; mk_mtext  by ymg  *** modified as mk_masked_text by rw2691 for masking *** ;
;; Arguments: p,  Insertion Point.                                            ;
;;            s,  Text.                                                       ;
;;            j,  Justification:                                              ;
;;                1 = Top left; 2 = Top center; 3 = Top right;                ;
;;                4 = Middle left; 5 = Middle center; 6 = Middle right;       ;
;;                7 = Bottom left; 8 = Bottom center; 9 = Bottom right        ;
;;            h,  Text Height.                                                ;
;;            r,  Rotation.                                                   ;
;;            c,  text color                                                  ;
;;            ms,  mask state ...1=on 2=off                                   ;
;;            mc,  mask color ...254 slight-gray or ash                       ;
;;            mr,  mask ratio ...typical is 1.4                               ;
;; Limitation: No limitation... this can process any volume of text           ;
(defun mk_masked_text (p s j h r c ms mc mr / x1 ent1)
   (if (= ms nil) (setq ms 2)) ;; turns off mask
   (if (= mc nil) (setq mc 250)) ;; sets to black
   (if (= mr nil) (setq mr 1.3)) ;; better than nothing
   (entmake
     (append
      (list '(0 . "MTEXT") 
            '(100 . "AcDbEntity")         
            '(100 . "AcDbMText")   
            (cons 10 p) ;; point
            (cons 71 j) ;; justify
            (cons 40 h) ;; height         
            (cons 50 r) ;; rotate by radians 0=right pi=left
            (cons 62 c) ;; color 256=bylayer 0=byblock negative=layeroff           
            (cons 90 ms) ;; mask state ;; 1 is mask-on ... 2 is mask-off
            (cons 63 mc) ;; mask color ;; 1 is red, 7 white, 254 ash, etc.
            (cons 45 mr) ;; mask ratio ;; 1.0 is text height, 1.4 is 0.4 larger than text height
            ) ;l
      (MakeMTlist s)
      ) ;a
     ) ;e
   ) ;d
       
;; Function: MakeMtextLists, Steve Doman, 11-17-99
;; eMail: steved@onlinemac.com
;; modified by RLW 05/19/2016
(defun MakeMTlist (text / sl left k tempstr textlist)
       (setq sl (strlen text))       
       (if (<= sl 250) ;; 250 is the DXF CODE maximum
           (setq textlist (list (cons 1 text)))                           ;;  single block
           (progn                               
              (setq left 1 k sl textlist nil)  ;;  **copy method**
              (while (> k 250)                                            ;;  mutliple blocks
                     (setq tempstr (substr text left 250)
                           textlist (append textlist (list (cons 3 tempstr)))
                           left (+ left 250)
                           k (- k 250)
                           )
                     ) ;while
              (setq tempstr (substr text left sl)                         ;;  final block
                    textlist (append textlist (list (cons 1 tempstr)))
                    )
              );progn
           );if
       textlist
       ) ;end defun

Rick
Title: Re: Triangulation (re-visited)
Post by: ribarm on May 22, 2016, 06:26:25 AM
Ymg, I want to tell you that it's possible to solve vertex contour intersection... I created some routines based on theme of contouring and I managed to make it possible to pass problematic vertex in this way: when contour hit vertex consider situation that one of connected 3d faces will have 3 points of intersection with level plane... 2 of those 3 points will be the same: equal to vertex and 1 point will lie at the opposite edge and that point is solution for making contour continue to form shape of contour... Other not good 3d faces around vertex may have only 2 intersecting points: equal to vertex while opposite edge won't have intersecting point with plane at level of contour... I write this message from mobile phone and currently I don't have www connection with this old laptop where I wrote those routines... But in a week when I get home, I'll post my versions that are slower lisps than your Triang... But I think it's good to experiment and who knows maybe someday they'll be improved to work faster... For those that need only additions to created contouring I wrote dynamic version, but they are all without parabolic curving - like your smoothing 0... Regards and enjoy wherever you are, M.R.
Title: Re: Triangulation (re-visited)
Post by: ymg on May 23, 2016, 07:05:44 AM
Hi Marko,

The problem I had with even contour is currently solved in
version 0.7.0  (Not published yet). 

So yes you are right It can be done.

Right now trying to accelerate it.  I've also change
the contour subroutine to be called with different parameters
to enable updating contours when flipping faces.

I will certainly look into your version and , there are more than one way
to skin a cat.


ymg
Title: Re: Triangulation (re-visited)
Post by: ribarm on June 10, 2016, 09:54:35 AM
Here ymg, take a look... The swamp works now, but my archive was written 2 week ago...
Like I promised I'll post it here...

Regards, M.R.

BTW. I used your (getz) as I think it's faster than my version of intersection line plane by 3 points...
HTH.
Title: Re: Triangulation (re-visited)
Post by: ymg on June 10, 2016, 12:42:37 PM
Marko,

Will look at it when I have a chance.

Right now just came back from Europe to discover that
I had a minor flood in the house.  So I am doing some
cleaning-up and demolition

Thanks for your contribution.

ymg
Title: Re: Triangulation (re-visited)
Post by: irot on July 06, 2016, 08:41:19 AM
I've been trying to run TIN command with BricsCAD 16 and got the following error:
Quote
; ----- Error around expression -----
(VLAX-CURVE-GETENDPARAM EN)
;
Error: bad argument type <NIL> ; expected <NUMBER> at [+ ]
Any reason as to why it's not working?
Title: Re: Triangulation (re-visited)
Post by: rw2691 on July 09, 2016, 12:41:23 PM
irot,

I expect that YMG is still busy with managing flood repairs... I can only ask whether you are selecting a polyline, is it 2d or 3d, and what operation are doing when it happens?

Rick
Title: Re: Triangulation (re-visited)
Post by: irot on July 11, 2016, 01:39:23 AM
my file contains points and 3d polys as breaklines. when running TIN command, after setting up and selecting entities i get that error. another file works just fine so the problem has to do with my file, i just can't seem to find what's wrong with it. i've attached it if you care to have a look.
Title: Re: Triangulation (re-visited)
Post by: irot on July 11, 2016, 04:51:12 AM
I may have found the reason. A friend notified me that I made an error importing the breaklines from Excel to BricsCAD, which caused me to try and create some 3d polys with only one vertex in them. I don't think they were created at all, but it may still throw the lisp off. When I imported correctly TIN command ran OK and created the 3d faces. XSHAPE and CONT seem to get the program to hang though, but it could be because the file is quite huge.
Title: Re: Triangulation (re-visited)
Post by: rw2691 on July 11, 2016, 11:23:10 AM
irot,

I loaded your file and started a TIN. It contained 23,684 objects. After 25 minutes it was still processing and had not produced a TIN at that point. It may have muddled through, but I decided to not wait to see. So I closed down Autocad.

I then loaded the file again, and selected a small portion of the drawing. The top 658'. It built the TIN, and it respected all of the breaklines.

In both cases I did not get any errors.

Rick



Title: Re: Triangulation (re-visited)
Post by: rw2691 on July 11, 2016, 11:44:54 AM
irot,

I forgot to check out contouring. When I built contours it only partially developed them and hung. There had only been 7511 TINs, and it did not report any error.

Keep in mind that I am using the file where you had not made any corrections. Nevertheless, since it built the TINs and CONT only works with TINs, I was surprised to see it fail.

Rick
Title: Re: Triangulation (re-visited)
Post by: ribarm on July 11, 2016, 02:52:46 PM
irot,

OVERKILL-PTS :
Total : 1474 duplicate point entities deleted...

And you still have duplicate points, but with different Z coordinates - see *.png...

This is why TRIANGULATE can't do it...

Attached also DWG with OVERKILLED-PTS...

M.R.
Title: Re: Triangulation (re-visited)
Post by: irot on July 12, 2016, 04:22:50 AM
Thank you both for taking the time to check my file. I figure that BricsCAD's express tools engine is a little different than AutoCAD's. As i mentions, when "correctly" importing but with NO overkill I managed to get TINs however there was some error at the end and I get triangles crossing breaklines. CONT command runs only partialy. I can run it on a small number of triangles at a time to get all contours, but that takes forever on a file like this. Still haven't tried running the "overkilled" file.
As a side note, When trying my file on Civil 3D (that basicaly overkills by default) I get good looking triangles that works with CONT with no problem (just takes a while).
Title: Re: Triangulation (re-visited)
Post by: ribarm on July 12, 2016, 04:48:11 AM
Like I said, you have bad DWG... You still haven't answered on my question : What will you do with duplicate points that have different Z coordinates and same X and Y? Will you leave top one or bottom one... I hope that you understand that you must solve this problem if you want everything to go smoothly without bugs when triangulate and tincontours...
Title: Re: Triangulation (re-visited)
Post by: ribarm on July 12, 2016, 06:31:13 AM
Hi, irot, now I used different OVERKILL-PTS algorithm :
Total : 1480 duplicate point entities deleted...

Now there is no problems with duplicate points, but now appeared one different issue : when triangulate-UCS.lsp it bugged when calculating circumcircle from 3 collinear points X values the same, but 3 different Y coordinates and 3 different Z coordinates... So I had to mod triangulate-UCS.lsp, but then again it did finish quite quick, but there were errors in TIN... I'll attach my archive for YMG to investigate if he had chance cos' I did quick mod... in (getcircumcircle) at the end I've put (if (and cp rr) ... ), meaning that sub may return nil, and that nil I've removed from al - active list here :
...
      (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)
                  al (vl-remove nil al)
                  el (cdr el)
            )
        )
      )
...

OVERKILL-PTS-average-z.lsp now looks like this :

Code: [Select]
(defun c:overkill-pts-average-z ( / ss i ent entptlst k zcoords zaverage subentptlst ti )
  (prompt "\nSelect points...")
  (setq ss (ssget "_:L" '((0 . "POINT"))))
  (setq ti (car (_vl-times)))
  (repeat (setq i (sslength ss))
    (setq ent (ssname ss (setq i (1- i))))
    (setq entptlst (cons (list ent (cdr (assoc 10 (entget ent)))) entptlst))
  )
  (setq k 0)
  (foreach entpt entptlst
    (setq subentptlst (vl-remove-if-not '(lambda ( x ) (and (equal (car (cadr entpt)) (car (cadr x)) 1e-2) (equal (cadr (cadr entpt)) (cadr (cadr x)) 1e-2))) entptlst))
    (if subentptlst
      (progn
        (setq zcoords (mapcar 'caddr (mapcar 'cadr subentptlst)))
        (setq zaverage (/ (apply '+ zcoords) (float (length zcoords))))
        (setq subentptlst (vl-remove entpt subentptlst))
        (foreach subentpt subentptlst
          (if (not (vlax-erased-p (car subentpt)))
            (progn
              (setq k (1+ k))
              (entdel (car subentpt))
            )
          )
        )
        (if (vlax-erased-p (car entpt))
          (progn
            (entdel (car entpt))
            (setq k (1- k))
            (entupd (cdr (assoc -1 (entmod (subst (cons 10 (list (car (cadr entpt)) (cadr (cadr entpt)) zaverage)) (assoc 10 (entget (car entpt))) (entget (car entpt)))))))
          )
        )
      )
    )
  )
  (prompt "\nTotal : ") (princ k) (prompt " duplicate point entities deleted...")
  (prompt "\nElapsed time : ") (princ (rtos (/ (- (car (_vl-times)) ti) 1000.0) 2 50)) (prompt " seconds.")
  (princ)
)

I'll attach new DWG with points OK and my archive for YMG... You may test further with YMG's Triang and see if it's good... I am afraid I can't figure out why my TIN isn't good...

Regards, M.R.
Title: Re: Triangulation (re-visited)
Post by: irot on July 12, 2016, 06:37:09 AM
ribarm:
I really don't have an answer for you. The points were imported directly from a survey fie that was sent to me and is compatible with an external program. I can't test that program to know if it works fine with it as I don't own a copy. But as I mentioned it DOES work well on Civil 3D so I guess that at least most of the surface will be correct.
I must ask: are the duplicates all raw points or some are vertices of the polys?
Title: Re: Triangulation (re-visited)
Post by: ribarm on July 12, 2016, 12:30:06 PM
irot, I did triangulation at last... The problem was in both X and Y collinearity and duplicate points... I still leaved my version unchanged of triangulate-UCS.lsp so that I could track bugs... It did convex-hull triangulation without mistake - see DWG... Here is the code for preparation of points :

Code: [Select]
(defun c:overkill-pts-average-z-rem-X&Y-collinearity ( / LM:rand ss i ent entptlst k kk zcoords zaverage subentptlst entpt n d ti )

  ;; Rand  -  Lee Mac
  ;; PRNG implementing a linear congruential generator with
  ;; parameters derived from the book 'Numerical Recipes'

  (defun LM:rand ( / a c m )
      (setq m   4294967296.0
            a   1664525.0
            c   1013904223.0
            $xn (rem (+ c (* a (cond ($xn) ((getvar 'date))))) m)
      )
      (/ $xn m)
  )

  (prompt "\nSelect points...")
  (setq ss (ssget "_:L" '((0 . "POINT"))))
  (initget 6)
  (setq d (getdist "\nPick or specify fuzz distance for X&Y collinearity modifications <0.05> : "))
  (if (null d)
    (setq d 0.05)
  )
  (setq ti (car (_vl-times)))
  (repeat (setq i (sslength ss))
    (setq ent (ssname ss (setq i (1- i))))
    (setq entptlst (cons (list ent (cdr (assoc 10 (entget ent)))) entptlst))
  )
  (setq k 0)
  (foreach entpt entptlst
    (setq subentptlst (vl-remove-if-not '(lambda ( x ) (and (equal (car (cadr entpt)) (car (cadr x)) 1e-2) (equal (cadr (cadr entpt)) (cadr (cadr x)) 1e-2))) entptlst))
    (if subentptlst
      (progn
        (setq zcoords (mapcar 'caddr (mapcar 'cadr subentptlst)))
        (setq zaverage (/ (apply '+ zcoords) (float (length zcoords))))
        (setq subentptlst (vl-remove entpt subentptlst))
        (foreach subentpt subentptlst
          (if (not (vlax-erased-p (car subentpt)))
            (progn
              (setq k (1+ k))
              (entdel (car subentpt))
              (setq entptlst (vl-remove subentpt entptlst))
            )
          )
        )
        (if (vlax-erased-p (car entpt))
          (progn
            (entdel (car entpt))
            (setq k (1- k))
            (if (not (vl-position entpt entptlst))
              (setq entptlst (cons entpt entptlst))
            )
            (entupd (cdr (assoc -1 (entmod (subst (cons 10 (list (car (cadr entpt)) (cadr (cadr entpt)) zaverage)) (assoc 10 (entget (car entpt))) (entget (car entpt)))))))
            (setq entptlst (subst (list (car entpt) (list (car (cadr entpt)) (cadr (cadr entpt)) zaverage)) (assoc (car entpt) entptlst) entptlst))
          )
        )
      )
    )
  )
  (setq kk 0)
  (while (setq entpt (car entptlst))
    (setq entptlst (cdr entptlst))
    (setq subentptlst (vl-remove-if-not '(lambda ( x ) (equal (car (cadr entpt)) (car (cadr x)) 1e-2)) entptlst))
    (setq n 0.0)
    (setq subentptlst (vl-remove entpt subentptlst))
    (foreach subentpt subentptlst
      (setq kk (1+ kk))
      (entupd (cdr (assoc -1 (entmod (subst (cons 10 (list ((if (zerop (rem (setq n (1+ n)) 2)) + -) (car (cadr subentpt)) (* (LM:rand) (* 0.5 d))) (cadr (cadr subentpt)) (caddr (cadr subentpt)))) (assoc 10 (entget (car subentpt))) (entget (car subentpt)))))))
      (setq entptlst (subst (list (car subentpt) (cdr (assoc 10 (entget (car subentpt))))) (assoc (car subentpt) entptlst) entptlst))
    )
    (setq subentptlst (vl-remove-if-not '(lambda ( x ) (equal (cadr (cadr entpt)) (cadr (cadr x)) 1e-2)) entptlst))
    (setq n 0.0)
    (setq subentptlst (vl-remove entpt subentptlst))
    (foreach subentpt subentptlst
      (setq kk (1+ kk))
      (entupd (cdr (assoc -1 (entmod (subst (cons 10 (list (car (cadr subentpt)) ((if (zerop (rem (setq n (1+ n)) 2)) + -) (cadr (cadr subentpt)) (* (LM:rand) (* 0.5 d))) (caddr (cadr subentpt)))) (assoc 10 (entget (car subentpt))) (entget (car subentpt)))))))
      (setq entptlst (subst (list (car subentpt) (cdr (assoc 10 (entget (car subentpt))))) (assoc (car subentpt) entptlst) entptlst))
    )
  )
  (prompt "\nTotal : ") (princ k) (prompt " duplicate point entities deleted...")
  (prompt "\nTotal : ") (princ kk) (prompt " X&Y collinear point entities modifications made to apply slight X&Y collinearity...")
  (prompt "\nElapsed time : ") (princ (rtos (/ (- (car (_vl-times)) ti) 1000.0) 2 50)) (prompt " seconds.")
  (princ)
)

As you can see - preparation is now more complex and it lasts longer... I'll attach my archive and both prepared DWG and triangulated one... So it has no effect on break lines, just points are the issue, as you can see from the code... Please ignore my previous attachment... And if it's good for you in Civil3D, I must say that I don't have Civil, but just Vanilla ACAD, so I did this modifications to try to help both me and you...

[EDIT : Code changed and updated archive... Also now TIN was created without mistakes...]

Regards, M.R.
Title: Re: Triangulation (re-visited)
Post by: ribarm on July 13, 2016, 12:04:18 PM
I've updated my previous post... So read it carefully... Still I have no better option for checking collinearity then to change fuzz factor and retry process... triangulate-UCS.lsp should stay unchanged...

M.R.
Title: Re: Triangulation (re-visited)
Post by: ribarm on July 14, 2016, 04:51:44 AM
I've added this function into archive, but it's strongly recommended that be used with small number of points and only if you fail to get result with (*-rem-X&Y-collinearity.lsp + triangulate-UCS.lsp)... So if it finish it should prepare points for sure good for triangulate-UCS.lsp, but it's so slooow...

Code: [Select]
(defun c:overkill-pts-average-z-rem-collinearity-slow ( / LM:rand ss i ent entptlst k kk zcoords zaverage subentptlst entpt d z ang angl anglnth anglsrt angdltl angdnth angn p tst ti )

  ;; Rand  -  Lee Mac
  ;; PRNG implementing a linear congruential generator with
  ;; parameters derived from the book 'Numerical Recipes'

  (defun LM:rand ( / a c m )
      (setq m   4294967296.0
            a   1664525.0
            c   1013904223.0
            $xn (rem (+ c (* a (cond ($xn) ((getvar 'date))))) m)
      )
      (/ $xn m)
  )

  (prompt "\nSelect points...")
  (setq ss (ssget "_:L" '((0 . "POINT"))))
  (initget 6)
  (setq d (getdist "\nPick or specify fuzz distance for collinearity modifications <0.05> : "))
  (if (null d)
    (setq d 0.05)
  )
  (setq ti (car (_vl-times)))
  (repeat (setq i (sslength ss))
    (setq ent (ssname ss (setq i (1- i))))
    (setq entptlst (cons (list ent (cdr (assoc 10 (entget ent)))) entptlst))
  )
  (setq k 0)
  (foreach entpt entptlst
    (setq subentptlst (vl-remove-if-not '(lambda ( x ) (and (equal (car (cadr entpt)) (car (cadr x)) 1e-2) (equal (cadr (cadr entpt)) (cadr (cadr x)) 1e-2))) entptlst))
    (if subentptlst
      (progn
        (setq zcoords (mapcar 'caddr (mapcar 'cadr subentptlst)))
        (setq zaverage (/ (apply '+ zcoords) (float (length zcoords))))
        (setq subentptlst (vl-remove entpt subentptlst))
        (foreach subentpt subentptlst
          (if (not (vlax-erased-p (car subentpt)))
            (progn
              (setq k (1+ k))
              (entdel (car subentpt))
              (setq entptlst (vl-remove subentpt entptlst))
            )
          )
        )
        (if (vlax-erased-p (car entpt))
          (progn
            (entdel (car entpt))
            (setq k (1- k))
            (if (not (vl-position entpt entptlst))
              (setq entptlst (cons entpt entptlst))
            )
            (entupd (cdr (assoc -1 (entmod (subst (cons 10 (list (car (cadr entpt)) (cadr (cadr entpt)) zaverage)) (assoc 10 (entget (car entpt))) (entget (car entpt)))))))
            (setq entptlst (subst (list (car entpt) (list (car (cadr entpt)) (cadr (cadr entpt)) zaverage)) (assoc (car entpt) entptlst) entptlst))
          )
        )
      )
    )
  )
  (setq kk 0)
  (setq tst (cons nil tst))
  (while (not (eval (cons 'and tst)))
    (setq z -1 tst nil)
    (while (setq entpt (nth (setq z (1+ z)) entptlst))
      (foreach subentpt (vl-remove entpt entptlst)
        (setq ang (angle (cadr entpt) (cadr subentpt)))
        (setq angl (cons ang angl))
      )
      (setq anglnth (vl-sort-i angl '<))
      (setq anglsrt (mapcar '(lambda ( x ) (nth x angl)) anglnth))
      (setq angdltl (mapcar '(lambda ( a b ) (- b a)) anglsrt (cdr anglsrt)))
      (setq angdnth (vl-sort-i angdltl '<))
      (if (zerop (nth (car angdnth) angdltl))
        (progn
          (setq kk (1+ kk))
          (setq angn (nth (car angdnth) anglsrt))
          (setq p (polar (cadr entpt) (+ angn (* 0.5 pi)) (* (LM:rand) d)))
          (entupd (cdr (assoc -1 (entmod (subst (cons 10 p) (cons 10 (cadr entpt)) (entget (car entpt)))))))
          (setq entptlst (subst (list (car entpt) p) (assoc (car entpt) entptlst) entptlst))
          (setq tst (cons nil tst))
        )
        (setq tst (cons t tst))
      )
      (setq angl nil)
    )
  )
  (prompt "\nTotal : ") (princ k) (prompt " duplicate point entities deleted...")
  (prompt "\nTotal : ") (princ kk) (prompt " collinear point entities modifications made to apply slight collinearity...")
  (prompt "\nElapsed time : ") (princ (rtos (/ (- (car (_vl-times)) ti) 1000.0) 2 50)) (prompt " seconds.")
  (princ)
)

M.R.
Title: Re: Triangulation (re-visited)
Post by: ribarm on July 16, 2016, 05:01:58 PM
When I think more over, this is the fastest solution...

Code: [Select]
(defun c:overkill-pts-average-z-rem-collinearity-new ( / LM:rand ss i ent entptlst k zcoords zaverage subentptlst d pl plrand ti )

  ;; Rand  -  Lee Mac
  ;; PRNG implementing a linear congruential generator with
  ;; parameters derived from the book 'Numerical Recipes'

  (defun LM:rand ( / a c m )
      (setq m   4294967296.0
            a   1664525.0
            c   1013904223.0
            $xn (rem (+ c (* a (cond ($xn) ((getvar 'date))))) m)
      )
      (/ $xn m)
  )

  (prompt "\nSelect points...")
  (setq ss (ssget "_:L" '((0 . "POINT"))))
  (initget 6)
  (setq d (getdist "\nPick or specify fuzz distance for collinearity modifications <0.05> : "))
  (if (null d)
    (setq d 0.05)
  )
  (setq ti (car (_vl-times)))
  (repeat (setq i (sslength ss))
    (setq ent (ssname ss (setq i (1- i))))
    (setq entptlst (cons (list ent (cdr (assoc 10 (entget ent)))) entptlst))
  )
  (setq k 0)
  (foreach entpt entptlst
    (setq subentptlst (vl-remove-if-not '(lambda ( x ) (and (equal (car (cadr entpt)) (car (cadr x)) 1e-2) (equal (cadr (cadr entpt)) (cadr (cadr x)) 1e-2))) entptlst))
    (if subentptlst
      (progn
        (setq zcoords (mapcar 'caddr (mapcar 'cadr subentptlst)))
        (setq zaverage (/ (apply '+ zcoords) (float (length zcoords))))
        (setq subentptlst (vl-remove entpt subentptlst))
        (foreach subentpt subentptlst
          (if (not (vlax-erased-p (car subentpt)))
            (progn
              (setq k (1+ k))
              (entdel (car subentpt))
              (setq entptlst (vl-remove subentpt entptlst))
            )
          )
        )
        (if (vlax-erased-p (car entpt))
          (progn
            (entdel (car entpt))
            (setq k (1- k))
            (if (not (vl-position entpt entptlst))
              (setq entptlst (cons entpt entptlst))
            )
            (entupd (cdr (assoc -1 (entmod (subst (cons 10 (list (car (cadr entpt)) (cadr (cadr entpt)) zaverage)) (assoc 10 (entget (car entpt))) (entget (car entpt)))))))
            (setq entptlst (subst (list (car entpt) (list (car (cadr entpt)) (cadr (cadr entpt)) zaverage)) (assoc (car entpt) entptlst) entptlst))
          )
        )
      )
    )
  )
  (setq pl (mapcar 'cadr entptlst))
  (setq plrand (mapcar '(lambda ( x ) (polar x (* (LM:rand) (* 2.0 pi)) (* (LM:rand) d))) pl))
  (mapcar '(lambda ( a b / e ) (entupd (cdr (assoc -1 (entmod (subst (cons 10 b) (assoc 10 (entget (setq e (caar (vl-member-if '(lambda ( x ) (equal (cadr x) a 1e-50)) entptlst))))) (entget e))))))) pl plrand)
  (prompt "\nTotal : ") (princ k) (prompt " duplicate point entities deleted...")
  (prompt "\nTotal : ") (princ (length pl)) (prompt " collinear point entities modifications made to apply slight collinearity...")
  (prompt "\nElapsed time : ") (princ (rtos (/ (- (car (_vl-times)) ti) 1000.0) 2 50)) (prompt " seconds.")
  (princ)
)

HTH, M.R.
Title: Re: Triangulation (re-visited)
Post by: ribarm on July 17, 2016, 07:05:15 AM
I had mistake in my 3 rem-collinearity functions...

Forgot to add this lines :
            (if (not (vl-position entpt entptlst))
              (setq entptlst (cons entpt entptlst))
            )

Now fixed in attached archive... Sorry for mistake, it happens...
M.R.
Title: Re: Triangulation (re-visited)
Post by: rw2691 on July 17, 2016, 03:41:08 PM
Ribarm,

Just a consideration...

Your resolution to average the z factor seems to be flawed in my my opinion. I know that it is the premise of the current Triang approach, but the fact that data can reflect a difference to a 2d resolution is a challenge to that theory. If 2d coordinates show a zero relationship, it should imply that an elevation difference is desired.

If the TIN is vertical it should not be assumed that it is wrong.

I have used a different program, EZYsurf, to build the TIN's and it succeeded. It took a very long time to create the contours, but it also succeeded. It is using a 3d resolution.

On a 2d evaluation it might appear that the contours cross, but they do not on a 3d evaluation.

I think it is an issue that needs to be examined. It is a tough one, but it is also the reality of contours.

The drawing that is submitted may be poor, and even contrived, yet it is also a situation that can be encountered. Why not attempt to resolve the issue without compromising the data?

Rick
Title: Re: Triangulation (re-visited)
Post by: ribarm on July 18, 2016, 05:52:38 AM
Are you sure EazySurf isn't compromising the data also... Are you aware that it may be very possible that similar algorithm is used and if collinearity comes into the triangulation process it's considered buggy, thus TIN (triangular IRREGULAR network)... As for my approach I don't see anything wrong in specifying some small fuzz factor to break down collinearity by rand position of points in 2D while preserving z coordinate relations... Z average is used though I really shouldn't - the triangulation process is 2D algorithm based and therefore while triangulating in WCS no vertical triangular 3DFACES should be produced... I know this is somewhat bad (averaging z coordinates, but then you can modify it to be used only lowest coordinate thus representing the ground elevation... To me those point data that have this info (double points with different Z) are bad data and from bad data you should get and bad results... If someone seriously want to perform triangulation, one should consider providing correct data point info in the very beginning and knowing that one is to built TIN, points shouldn't be positioned collinearly in 2D projection...
Hope it's now little more clear what I wanted to say and what my latest interventions were intended to do - this was just like I said child play in order to make TIN out from .... data...
Title: Re: Triangulation (re-visited)
Post by: rw2691 on July 18, 2016, 08:13:52 AM
Ribarm,

The difference in Z that I am considering is a bottom and top of curb, wall, or cliff. Instead of averaging them by Z, it would be better to shift the XY position.

Also, if the points are deliberate, appropriate breaklines will guide the algorithmic method. The code doesn't have to be aware of a vertical sheer or inversion, and the user expects the apparent crossovers.

Rick
Title: Re: Triangulation (re-visited)
Post by: ribarm on July 18, 2016, 09:06:01 AM
I agree that points should be shifted - but look in the picture here :
https://www.theswamp.org/index.php?topic=9042.msg567692#msg567692

What is the difference between 841.75 and 841.67 ? Isn't that pair of points at least confusing bad pair... In this situation average Z is good approach, but then again like I said - maybe the best is to take bottom one - ground level... As for shifting, what if we have 3 or more duplicates - to shift them to where - in surrounding of rand angle for rand distance between 0.0 and fuzz? Isn't this all producing what's so called bad terrain... I know that there may exist cliffs and mountains with almost vertical sides, but who would model that type of ground... What's more interesting there may exist cliffs with angle of slope greater than 90 degree assuming you watched films like cliffhanger, but I am considering this not for computational approach of modelling, it should be more like 3d environment scanning of mountain terrain... In such situations like Colorado canyons and so on, computer algorithms are useless and so is triangulation...
Title: Re: Triangulation (re-visited)
Post by: rw2691 on July 19, 2016, 03:49:14 PM
Ribarm,

Yes, the drawing that we are looking at is poor practice.

Rick
Title: Re: Triangulation (re-visited)
Post by: ribarm on July 22, 2016, 02:02:54 PM
Hi, again me...

Recently I coded new version of triangulate-UCS, to try to overcome collinearity problem within triangulation process itself... I know ymg, Evgeniy and other gurus have no time for playing with this, but maybe some new fresh pair of eyes are capable to solve this issue... I confirm that you must use my first overkill-pts-average-z.lsp to make sure there are no duplicate points, but for collinearity I tried to step into and over breaking of ordinary triangulate-UCS.lsp I posted in archive... I'll highlight portions for which I think are important in this revision, so that you can understand what's going on... Sadly this code won't or shouldn't break, but triangulation is done with mistakes... Please retest irot's DWG - firstly apply c:overkill-pts-average-z and then this code - it should do it, but with triangulation mistakes... I am not able to find out why is this happening, so I am for now blind to this problem... If you have some spare time and you see it, please inform us or reply if you wish to help... Best regards, M.R.

Quote
(defun c:triangulate-UCS-new ( / LM:Rand mid 3D->2D MR:Collinear-p LM:Clockwise-p LM:ConvexHull triangulate ss i p pl ell tl z ppp lay d ti )

  ;; Rand  -  Lee Mac
  ;; PRNG implementing a linear congruential generator with
  ;; parameters derived from the book 'Numerical Recipes'

  (defun LM:rand ( / a c m )
      (setq m   4294967296.0
            a   1664525.0
            c   1013904223.0
            $xn (rem (+ c (* a (cond ($xn) ((getvar 'date))))) m)
      )
      (/ $xn m)
  )

  ;; Point between 2 points or middle list of values from 2 specified lists p1 and p2

  (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-remove p0 lst))
              (setq lst (append (list p0) lst))
              (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)))
                  )
              )
              (reverse ch)
          )
      )
  )

  ;; Triangulate - subfunction for drawing Delunay triangulation from specified list of points with provided factor for checking weather calcualted triangulation is convex hull boundary triangulation
  ;; Returns list of 2 elements - first element is list of triangles defined by 3 points forming triangle and second element is calculated factor for forming supertriangle for next call of triangulate function for gathering correct convex hull boundary of triangulation triangles

  (defun triangulate ( pl factor / tl pll getcircumcircle xmin xmax ymin ymax cs pmin pmax t1 t2 t3 al la p el tr l n m str och ich iche i all elll loop )

    (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))
      (if (and cp rr)
        (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 ;;;
        (polar p (+ (angle (car el) p) (* 0.5 pi)) (* (LM:Rand) d))
      )
    )

    (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))
      (setq m -1 all al elll el loop t)
      (while loop
        (if (vl-every '(lambda ( x ) (= 4 (length x))) al)
          (progn
            (while el ;;; el - edge list = ((a b) (b c) (c a) (d e) (e f) (f d) ... )
              (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)
                  )
              )
            )
            (if (vl-every '(lambda ( x ) (= 4 (length x))) al)
              (setq loop nil)
            )
          )
          (progn
            (while
              (and
                (setq la (vl-remove-if '(lambda ( x ) (= 4 (length x))) al))
                (nth (setq m (1+ m)) la)
                (equal p (setq p (nth m la)) 1e-8)
              )
            )
            (setq al all el elll)
            (while el ;;; el - edge list = ((a b) (b c) (c a) (d e) (e f) (f d) ... )
              (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)
                  )
              )
            )
            (if (vl-every '(lambda ( x ) (= 4 (length x))) al)
              (setq loop nil)
            )
          )
        )
      )
    )
    (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)
    ;; och - outside convex hull ring of points
    ;; ich - inside convex hull ring of points (convex hull obtained from rest of points when och was removed)
    (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 (if (null z) factor z))
  ) ;;; end of triangulate

  (prompt "\nSelect points...")
  (setq ss (ssget '((0 . "POINT"))))
  (initget 6)
  (setq d (getdist "\nPick or specify fuzz distance for collinearity modifications <0.05> : "))
  (if (null d)
    (setq d 0.05)
  )
  (setq ti (car (_vl-times)))
  (repeat (setq i (sslength ss))
    (setq p (trans (cdr (assoc 10 (entget (ssname ss (setq i (1- i)))))) 0 1))
    (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 (trans (car tr) 1 0))
        (cons 11 (trans (car tr) 1 0))
        (cons 12 (trans (cadr tr) 1 0))
        (cons 13 (trans (caddr tr) 1 0))
      )
    )
    (setq ppp (cons (trans (car tr) 1 0) ppp) ppp (cons (trans (cadr tr) 1 0) ppp) ppp (cons (trans (caddr tr) 1 0) ppp))
  )
  (setq lay (cdr (assoc 8 (entget (ssname ss 0)))))
  (command "_.ERASE" ss "")
  (while (setq p (car ppp))
    (if (not (vl-position p (setq ppp (cdr ppp))))
      (entmake
        (list (cons 0 "POINT") (cons 10 p) (cons 8 lay))
      )
    )
  )
  (prompt "\nElapsed time : ") (princ (rtos (/ (- (car (_vl-times)) ti) 1000.0) 2 50)) (prompt " seconds.")
  (princ)
)

In attached archive, this code is placed independently of "Triangulate routines by MR.lsp" which is main and have explanations for what procedures are without problems and for me correct... Still I am looking forward to solve and this ("triangulate-UCS-new - overkill-pts-average-z prior.lsp") and this routine ("overkill-pts-average-z-rem-collinearity-not good-new.lsp") which are newly added to archive and are independent... This second is little slow processing, but based on the same principle I posted here in code tags, only with it I planned to use it and then for triangulation process, just ordinary "triangulate-UCS.lsp"... It also has some issues that needs to be solved, and for some unknown reasons it's unpredictable - sometime it breaks, and some time not, but then (c:triangulate-UCS) fails or if not which is really success it makes mistakes like above mentioned code posted in tags... So see what you can do with them, of course if you have some free time...

Sincerely, M.R.
Title: Re: Triangulation (re-visited)
Post by: ribarm on July 23, 2016, 02:38:06 AM
Now I've put whole main algorithm inside (while loop ... ), but no avail... The same issue again... I really don't know what is happening, but this irot's DWG is somewhat with black magic... Here is the code :

Quote
(defun c:triangulate-UCS-new ( / LM:Rand mid 3D->2D MR:Collinear-p LM:Clockwise-p LM:ConvexHull triangulate ss i p pl ell tl z ppp lay d ti )

  ;; Rand  -  Lee Mac
  ;; PRNG implementing a linear congruential generator with
  ;; parameters derived from the book 'Numerical Recipes'

  (defun LM:rand ( / a c m )
      (setq m   4294967296.0
            a   1664525.0
            c   1013904223.0
            $xn (rem (+ c (* a (cond ($xn) ((getvar 'date))))) m)
      )
      (/ $xn m)
  )

  ;; Point between 2 points or middle list of values from 2 specified lists p1 and p2

  (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-remove p0 lst))
              (setq lst (append (list p0) lst))
              (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)))
                  )
              )
              (reverse ch)
          )
      )
  )

  ;; Triangulate - subfunction for drawing Delunay triangulation from specified list of points with provided factor for checking weather calcualted triangulation is convex hull boundary triangulation
  ;; Returns list of 2 elements - first element is list of triangles defined by 3 points forming triangle and second element is calculated factor for forming supertriangle for next call of triangulate function for gathering correct convex hull boundary of triangulation triangles

  (defun triangulate ( pl factor / tl pll getcircumcircle xmin xmax ymin ymax cs pmin pmax t1 t2 t3 al la all p el tr l n m str och ich iche i tll loop )

    (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))
      (if (and cp rr)
        (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 ;;;
        (polar p (+ (angle (car el) p) (* 0.5 pi)) (* (LM:Rand) d))
      )
    )

    (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 m -1 all al tll tl loop t)
      (while loop
        (if (vl-every '(lambda ( x ) (= 4 (length x))) al)
          (progn
            (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 ;;; el - edge list = ((a b) (b c) (c a) (d e) (e f) (f d) ... )
              (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)
                  )
              )
            )
            (if (vl-every '(lambda ( x ) (= 4 (length x))) al)
              (setq loop nil)
            )
          )
          (progn
            (while
              (and
                (setq la (vl-remove-if '(lambda ( x ) (= 4 (length x))) al))
                (nth (setq m (1+ m)) la)
                (equal p (setq p (nth m la)) 1e-8)
              )
            )
            (setq el nil al all tl tll)
            (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 ;;; el - edge list = ((a b) (b c) (c a) (d e) (e f) (f d) ... )
              (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)
                  )
              )
            )
            (if (vl-every '(lambda ( x ) (= 4 (length x))) al)
              (setq loop nil)
            )
          )
        )
      )
      (setq pll (cons p pll))
    )
    (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 pll (reverse pll) pl pll)
    ;; och - outside convex hull ring of points
    ;; ich - inside convex hull ring of points (convex hull obtained from rest of points when och was removed)
    (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 (if (null z) factor z))
  ) ;;; end of triangulate

  (prompt "\nSelect points on ulocked layer(s)...")
  (setq ss (ssget "_:L" '((0 . "POINT"))))
  (initget 6)
  (setq d (getdist "\nPick or specify fuzz distance for collinearity modifications <0.05> : "))
  (if (null d)
    (setq d 0.05)
  )
  (setq ti (car (_vl-times)))
  (if ss
    (progn
      (repeat (setq i (sslength ss))
        (setq p (trans (cdr (assoc 10 (entget (ssname ss (setq i (1- i)))))) 0 1))
        (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 (trans (car tr) 1 0))
            (cons 11 (trans (car tr) 1 0))
            (cons 12 (trans (cadr tr) 1 0))
            (cons 13 (trans (caddr tr) 1 0))
          )
        )
        (setq ppp (cons (trans (car tr) 1 0) ppp) ppp (cons (trans (cadr tr) 1 0) ppp) ppp (cons (trans (caddr tr) 1 0) ppp))
      )
      (setq lay (cdr (assoc 8 (entget (ssname ss 0)))))
      (command "_.ERASE" ss "")
      (while (setq p (car ppp))
        (if (not (vl-position p (setq ppp (cdr ppp))))
          (entmake
            (list (cons 0 "POINT") (cons 10 p) (cons 8 lay))
          )
        )
      )
      (prompt "\nElapsed time : ") (princ (rtos (/ (- (car (_vl-times)) ti) 1000.0) 2 50)) (prompt " seconds.")
    )
  )
  (princ)
)
Title: Re: Triangulation (re-visited)
Post by: pedroantonio on July 28, 2016, 09:10:44 AM
Hi ymg. Any new update ?
Title: Re: Triangulation (re-visited)
Post by: ribarm on July 29, 2016, 08:25:43 AM
Hi, me again... I decided to keep simplicity of main algorithm, but on irot's DWG it also gives bad results... Of course you must (c:overkill-pts-average-z) prior to applying this version... I don't know why on that particular DWG it makes mistakes, but there is always a hope... Maybe someone will solve it without moving and redefining points like I tried with this attempt, who knows... Anyway this version is also fast and for now it's my favorite...

ymg, is everything fine, you don't reply? Just tell us you're OK, nothing more...

Quote
(defun c:triangulate-UCS-new ( / mid 3D->2D MR:Collinear-p LM:Clockwise-p LM:ConvexHull triangulate ss i p pl ell tl z ti )

  ;; Point between 2 points or middle list of values from 2 specified lists p1 and p2

  (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-remove p0 lst))
              (setq lst (append (list p0) lst))
              (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)))
                  )
              )
              (reverse ch)
          )
      )
  )

  ;; Triangulate - subfunction for drawing Delunay triangulation from specified list of points with provided factor for checking weather calcualted triangulation is convex hull boundary triangulation
  ;; Returns list of 2 elements - first element is list of triangles defined by 3 points forming triangle and second element is calculated factor for forming supertriangle for next call of triangulate function for gathering correct convex hull boundary of triangulation triangles

  (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))
      (if (and cp rr)
        (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 ;;;
        (progn
          (cond
            ( (MR:Collinear-p (3D->2D p) (3D->2D (car el)) (3D->2D (cadr el)))
              (setq cp (list (/ (+ (car p) (car (cadr el))) 2.0) (/ (+ (cadr p) (cadr (cadr el))) 2.0)))
            )
            ( (MR:Collinear-p (3D->2D (car el)) (3D->2D p) (3D->2D (cadr el)))
              (setq cp (list (/ (+ (car (car el)) (car (cadr el))) 2.0) (/ (+ (cadr (car el)) (cadr (cadr el))) 2.0)))
            )
            ( (MR:Collinear-p (3D->2D (car el)) (3D->2D (cadr el)) (3D->2D p))
              (setq cp (list (/ (+ (car (car el)) (car p)) 2.0) (/ (+ (cadr (car el)) (cadr p)) 2.0)))
            )
          )
          (setq rr (max (distance (3D->2D p) cp) (distance (3D->2D (car el)) cp) (distance (3D->2D (cadr el)) cp)))
          (list (+ (car cp) rr) cp rr (list p (car el) (cadr el)))
        )
      )
    )

    (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 ;;; el - edge list = ((a b) (b c) (c a) (d e) (e f) (f d) ... )
        (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)
    ;; och - outside convex hull ring of points
    ;; ich - inside convex hull ring of points (convex hull obtained from rest of points when och was removed)
    (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 (if (null z) factor z))
  ) ;;; end of triangulate

  (prompt "\nSelect points...")
  (setq ss (ssget '((0 . "POINT"))))
  (setq ti (car (_vl-times)))
  (if ss
    (progn
      (repeat (setq i (sslength ss))
        (setq p (trans (cdr (assoc 10 (entget (ssname ss (setq i (1- i)))))) 0 1))
        (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 (trans (car tr) 1 0))
            (cons 11 (trans (car tr) 1 0))
            (cons 12 (trans (cadr tr) 1 0))
            (cons 13 (trans (caddr tr) 1 0))
          )
        )
      )
      (prompt "\nElapsed time : ") (princ (rtos (/ (- (car (_vl-times)) ti) 1000.0) 2 50)) (prompt " seconds.")
    )
  )
  (princ)
)

P.S. For those that downloaded archive, just add this one too, I don't want to reattach it...
Regards, M.R.
Title: Re: Triangulation (re-visited)
Post by: AARYAN on August 10, 2016, 03:00:39 AM
@YMG
Hi. Any new update ?
Eagerly waiting for you to sort the Contour bug out.

@Ribarm
Thanks for all your efforts. Highly appreciated.


Thanks
Title: Re: Triangulation (re-visited)
Post by: lamensterms on September 06, 2016, 05:38:08 AM
Awesome routine YMG.

Just wondering if someone could please link to the post containing the latest version?

I tested V0.5.5, and seems to work great.

Thanks.
Title: Re: Triangulation (re-visited)
Post by: pedroantonio on September 26, 2016, 10:02:18 AM
Hi ymg. Where are you ? Are you ok ?
Any new update ?
Title: Re: Triangulation (re-visited)
Post by: ribarm on September 26, 2016, 02:44:27 PM
Hi ymg. Where are you ? Are you ok ?
Any new update ?

I can only guess like all others, but apparently something isn't ok with ymg...
 :reallysad:
(I don't want to put the very next emoticon in smileys dialog box...)
Title: Re: Triangulation (re-visited)
Post by: pedroantonio on November 17, 2016, 02:07:06 PM
any updates?
Title: Re: Triangulation (re-visited)
Post by: ymg on November 21, 2016, 01:11:01 PM
Marko,

Everything is fine with me, just been away from CAD for the past 5 or 6 months.

Still doing renovation.

Sorry about the lack of progress.

ymg
Title: Re: Triangulation (re-visited)
Post by: ribarm on November 21, 2016, 01:48:37 PM
Marko,

Everything is fine with me, just been away from CAD for the past 5 or 6 months.

Still doing renovation.

Sorry about the lack of progress.

ymg

Yeah, damn you ymg...

Welcome back...
M.R.
Title: Re: Triangulation (re-visited)
Post by: pedroantonio on November 21, 2016, 03:20:52 PM
Welcome back ymg.  :-D
Title: Re: Triangulation (re-visited)
Post by: snownut2 on November 21, 2016, 04:38:45 PM
I don't think hes back, just letting all know he's still breathing !

Sounds like hes enjoying the renovation projects on his house....
Title: Re: Triangulation (re-visited)
Post by: pedroantonio on January 15, 2017, 05:27:40 PM
Any new update?
Title: Re: Triangulation (re-visited)
Post by: aeo000000 on February 08, 2017, 02:12:18 AM
it's whrong sometime.
sorry for my poor english

I post on , 9# :
http://bbs.mjtd.com/forum.php?mod=viewthread&tid=173392&pid=790172&page=1&extra=#pid790172


 (defun triangulate 
.......
; This triangle inactive. We store it's 3 vertex in tl      ;
        ; We also maintains a separate list of Circles Centers      ;
        ((< (car tr) (car p)) (setq tl (cons (cadddr tr) tl)
                                    cl (cons (cadr tr) cl)
                              )
        )
......
Nobody ever proved it.
Title: Re: Triangulation (re-visited)
Post by: pawcyk on February 11, 2017, 03:44:27 AM
Helo everyone.
Does anyone checkd this program in GstarCAD or ZWCad?? In my Gstarcad 2016 TIN works but not good. I have problem with:
- vl-times (I think, I dont need to know how fast this program is),
- there is no dcl window,
- no other function doesn't work,
- and the most important: I can't add breaklines to the TIN.

Is the any possibility to do the lisp which will  change the edges of two triangles??

Sorry for my english.
Title: Re: Triangulation (re-visited)
Post by: ribarm on February 11, 2017, 04:47:09 AM
@pawcyk, look into attached picture...
M.R.
Title: Re: Triangulation (re-visited)
Post by: pawcyk on February 11, 2017, 12:45:03 PM
You mean that it isn't correct for Delaunay but it is correct for me.  Thats why I use breaklines.
Maybe it wasn't good example . I'll try to find better example in my projects (I need more time).

About that lisp: I need something like breaklines but by picking two triangels.

Autodesk Civil 3d have that function.
Title: Re: Triangulation (re-visited)
Post by: rw2691 on February 11, 2017, 02:01:57 PM
pawcyk,

Picking two triangles to build breaklines would be a wrong method. Breaklines are allowed for overriding Delaunay triangles.

Rick
Title: Re: Triangulation (re-visited)
Post by: pawcyk on February 13, 2017, 11:50:26 AM
Helo.
If anyone whants to this lisp do the job in the gstarcad, he have to delete the parts with:
function pragma
vl-times
acet-ui-progress
I don't know if I may attach the lisp with this changes...
Title: Re: Triangulation (re-visited)
Post by: pawcyk on February 13, 2017, 12:35:46 PM
...to fast. There is still problem with function PROF.
Gstarcad prompt: Error: no function definition ACET-SS-ZOOM-EXTENTS

Can someone change this piece of code?
Title: Re: Triangulation (re-visited)
Post by: pawcyk on February 21, 2017, 11:56:15 AM
Hello again.
Thanks to Lee Mac from forum:
http://www.cadtutor.net/forum/showthread.php?99825-Problem-with-function-ACET-.......&p=679258
the code is working in GStarcad.
Some changes in code are mine. For example:

 (defun time () (/ (car (_vl-times)) 1000.))              =>      (defun time () (/ 1000 1))
I know... , but its working :)
And here is all code:
Title: Re: Triangulation (re-visited)
Post by: pedroantonio on February 26, 2017, 10:46:26 AM
Hi ymg any updates?
Title: Re: Triangulation (re-visited)
Post by: TopoWAR on March 01, 2017, 02:50:32 PM
Hello, there are not many updates, checking the current functions I have realized that many of the functions only run when using TIN, if one closes the drawing can no longer use other functions, since many of them use variables that when closing the Drawing left in NIL or empty, an example of TL variable, ie a function like DEMOZ does not work if not used TIN, every time we use DEMOZ we must use TIN again, it would be nice to be able to solve this, thanks
Title: Re: Triangulation (re-visited)
Post by: ribarm on March 02, 2017, 05:17:39 AM
Hello, there are not many updates, checking the current functions I have realized that many of the functions only run when using TIN, if one closes the drawing can no longer use other functions, since many of them use variables that when closing the Drawing left in NIL or empty, an example of TL variable, ie a function like DEMOZ does not work if not used TIN, every time we use DEMOZ we must use TIN again, it would be nice to be able to solve this, thanks

Why don't you use my "Triangulation routines by MR.zip" - it's composed from separate command functions - but they assume you firstly created TIN of 3DFACEs and work with tin after you select those 3DFACEs... I'll attach it again, since I've made slight mods. to triangulate-UCS.lsp... Still on some DWGs like irot's one it won't create TIN... It's about supertriangle - with ymg's version it works however - he removed duplicates during routine execution and used smaller supertriangle than mine... My version is exact and you must overkill-pts-average-z-rem-collinearity.lsp to be sure and possible to triangulate and with complex DWGs, but in fact the reason for bigger supertriangle is that I wanted to be sure triangulation is convex which will enable creation of 3DSOLID terrain model with my (c:terrain)... Unfortunately irot's DWG is too complex for my version of triangulation, but if you want to play I've put it inside reattached *.zip... Regards, M.R. (there were 8 downloads till I reattached file again...)
Title: Re: Triangulation (re-visited)
Post by: TopoWAR on March 02, 2017, 07:33:06 PM
Hi, thanks for answering, I'm going to test your routines, a question, do you happen to have a routine to exchange triangles ?? Thank you
Title: Re: Triangulation (re-visited)
Post by: ribarm on March 03, 2017, 05:22:56 AM
I don't know, do you think on swap 2 adjacent 3DFACEs (triangles)... If so, try this :

Code - Auto/Visual Lisp: [Select]
  1. (defun c:swap2adj3df ( / unique _reml ss 3df1 3df2 pl1 pl2 ppl prl )
  2.  
  3.   (defun unique ( l )
  4.     (if l (cons (car l) (unique (vl-remove-if (function (lambda ( x ) (equal x (car l) 1e-6))) l))))
  5.   )
  6.  
  7.   (defun _reml ( l1 l2 / a n ls )
  8.     (while
  9.       (setq n nil
  10.             a (car l2)
  11.       )
  12.       (while (and l1 (null n))
  13.         (if (equal a (car l1) 1e-8)
  14.           (setq l1 (cdr l1)
  15.                 n t
  16.           )
  17.           (setq ls (append ls (list (car l1)))
  18.                 l1 (cdr l1)
  19.           )
  20.         )
  21.       )
  22.       (setq l2 (cdr l2))
  23.     )
  24.     (append ls l1)
  25.   )
  26.  
  27.   (prompt "\nSelect 2 adjacent 3DFACEs...")
  28.   (setq ss (ssget "_:L" '((0 . "3DFACE"))))
  29.   (if (and ss (= (sslength ss) 2))
  30.     (progn
  31.       (setq 3df1 (ssname ss 0) 3df2 (ssname ss 1))
  32.       (setq pl1 (mapcar (function cdr) (vl-remove-if-not (function (lambda ( x ) (vl-position (car x) '(10 11 12 13)))) (entget 3df1))))
  33.       (setq pl2 (mapcar (function cdr) (vl-remove-if-not (function (lambda ( x ) (vl-position (car x) '(10 11 12 13)))) (entget 3df2))))
  34.       (setq pl1 (unique pl1) pl2 (unique pl2))
  35.       (if (= 4 (length (unique (append pl1 pl2))))
  36.         (progn
  37.           (setq ppl (_reml (append pl1 pl2) (unique (append pl1 pl2))))
  38.           (setq prl (vl-remove-if (function (lambda ( x ) (vl-position x ppl))) (append pl1 pl2)))
  39.           (entdel 3df1)
  40.           (entdel 3df2)
  41.           (if (minusp (- (* (car (mapcar '- (car prl) (car ppl))) (cadr (mapcar '- (cadr prl) (car ppl))))
  42.                          (* (cadr (mapcar '- (car prl) (car ppl))) (car (mapcar '- (cadr prl) (car ppl))))
  43.                       )
  44.               )
  45.             (entmake
  46.               (list
  47.                 '(0 . "3DFACE")
  48.                 (cons 10 (car ppl))
  49.                 (cons 11 (car ppl))
  50.                 (cons 12 (cadr prl))
  51.                 (cons 13 (car prl))
  52.               )
  53.             )
  54.             (entmake
  55.               (list
  56.                 '(0 . "3DFACE")
  57.                 (cons 10 (car ppl))
  58.                 (cons 11 (car ppl))
  59.                 (cons 12 (car prl))
  60.                 (cons 13 (cadr prl))
  61.               )
  62.             )
  63.           )
  64.           (if (minusp (- (* (car (mapcar '- (cadr prl) (cadr ppl))) (cadr (mapcar '- (car prl) (cadr ppl))))
  65.                          (* (cadr (mapcar '- (cadr prl) (cadr ppl))) (car (mapcar '- (car prl) (cadr ppl))))
  66.                       )
  67.               )
  68.             (entmake
  69.               (list
  70.                 '(0 . "3DFACE")
  71.                 (cons 10 (cadr ppl))
  72.                 (cons 11 (cadr ppl))
  73.                 (cons 12 (car prl))
  74.                 (cons 13 (cadr prl))
  75.               )
  76.             )
  77.             (entmake
  78.               (list
  79.                 '(0 . "3DFACE")
  80.                 (cons 10 (cadr ppl))
  81.                 (cons 11 (cadr ppl))
  82.                 (cons 12 (cadr prl))
  83.                 (cons 13 (car prl))
  84.               )
  85.             )
  86.           )
  87.         )
  88.         (progn
  89.           (prompt "\nSelected 2 3DFACEs not adjacent... Quitting, retry routine again with valid selection...")
  90.           (exit)
  91.         )
  92.       )
  93.     )
  94.     (prompt "\nEmpty sel. set or selected more or less than 2 3DFACEs... Retry routine again with valid selection...")
  95.   )
  96.   (princ)
  97. )
  98.  
Title: Re: Triangulation (re-visited)
Post by: TopoWAR on March 03, 2017, 12:45:08 PM
ribarm, Oh well, thanks for everything !!!
Title: Re: Triangulation (re-visited)
Post by: ribarm on March 05, 2017, 11:41:43 AM
ribarm, Oh well, thanks for everything !!!

You're welcome...
New input here :
https://www.theswamp.org/index.php?topic=9042.msg576276#msg576276

M.R.
Title: Re: Triangulation (re-visited)
Post by: mailmaverick on March 16, 2017, 07:46:31 AM
Hi All

First of all I would like to Congratulate and Thank all those who have put in so much of effort in creating this wonderful Triangulation Routine. I'm sure no other forum in the entire World Wide Web would have a LISP routine matching this capability.

My suggestion - When I used the Routine for creating Voronoi Diagrams, I found that the Voronoi Diagrams extend to a large extent outside the boundary of the project area which are difficult to trim because they are regions.

Is there a possibility that a feature can be added in Triangulation routine to limit the TIN and Voronoi regions upto a selected Closed Boundary, i.e. Trim Along the Selected Boundary.

Thanks.
Title: Re: Triangulation (re-visited)
Post by: rw2691 on March 16, 2017, 08:56:43 AM
mailmaverick,

The function BOUND builds a polyline boundary that automatically trims the TIN. It will, however, leave a few TIN's to be deleted manually. But it is also easy enough to customize the code to be more exhaustive with the process. You can search this forum thread for "BOUND" to see how it works. But I believe that the Veroni frames are not trimmed.

Rick
Title: Re: Triangulation (re-visited)
Post by: pedroantonio on March 30, 2017, 03:52:17 PM
Hi ymg . What happened with this project ? Any new update !!  :-)
Title: Re: Triangulation (re-visited)
Post by: xuanxiang on July 07, 2017, 07:16:29 AM
Thanks for the upload, I will take a look at them and revert.
Title: Re: Triangulation (re-visited)
Post by: pedroantonio on July 16, 2017, 10:32:59 AM
Any new update??
Title: Re: Triangulation (re-visited)
Post by: anhquang1989 on August 06, 2017, 05:09:10 AM
Help me!
I used lisp Triangulation v.0.6.7. But I want to create a Tin surface form Autocad like C3D.
Title: Re: Triangulation (re-visited)
Post by: pedroantonio on August 06, 2017, 05:13:56 AM
perhaps you need to add some break lines or you have a missing point !!!
Title: Re: Triangulation (re-visited)
Post by: anhquang1989 on August 06, 2017, 07:43:31 AM
I deleted some points to simplify the test so there is a difference between Test.dwg files.
You may misunderstand me. My main goal is to create Tin surface from 3d face and 3d point  same as when creating surface in civil 3d.
Title: Re: Triangulation (re-visited)
Post by: serkancavuslar on August 06, 2017, 12:36:29 PM
https://forums.autodesk.com/t5/autocad-turkiye/nodes-to-3d-design-and-2d-work-order/td-p/7221602
Title: Re: Triangulation (re-visited)
Post by: serkancavuslar on August 06, 2017, 12:41:15 PM
https://knowledge.autodesk.com/support/autocad/learn-explore/caas/screencast/Main/Details/11fb538e-dde8-4a5d-8d48-21e813d4fe78.html


Tek bir komut ile 5~6 ayda yapıla bilecek bir çok işi 2-3dk da Doğru, Eksiksiz, Kaliteli, Hızlı ... yapılmasını sağlıyor.
Yani normal AutoCAD komutları ile çalışmak yerine 1 komut kullanarak 5~6 ay kazanmış oluyorsunuz.
Yeni "Zaman Makinesi" "Time Machine" diye biliriz.
 
Noktalar "POINT" referans alınarak,
Belirtilen Aks-Cam Mesafesine,
Belirtilen İş emri ölçülendirme stiline,
Belirtilen Başlangış Poz Numarasına göre,
3d "Aks, Levha, Cam, Profil, Çelik, Referans Noktası, Poz Numarası, (Mantaj Paftası)
2d "Levha, Cam, Profil, Çelik, Poz, Antet, Detay, Referans Noktası, Ölçülendirme, açılımı ile birlikte" (İş Emri)
2-3dk da çizmekte ve CNC Step dosyalarını hazırlamaktadır.
 
Free Form veya Amorf Cephe
Dizaynı, Montajı, İş Emri En Zor ve hataların en çok yapıldığı işlerden sadece bir tanesidir.
Title: Re: Triangulation (re-visited)
Post by: anhquang1989 on August 07, 2017, 12:16:07 AM
Thank you for the information.
Title: Re: Triangulation (re-visited)
Post by: pedroantonio on September 01, 2017, 10:32:54 AM
Hi ymg . What happened with this project ? Any new update !!
Title: Re: Triangulation (re-visited)
Post by: CostinBos77 on December 20, 2017, 10:29:14 AM
Hi !

Can someone to upload the latest revision of this grate program 'Triang V0.6.7.lsp'  . I have found only 'Triang V0.6.5.5.lsp' .

Thanks in advance .
Title: Re: Triangulation (re-visited)
Post by: MatGrebe on December 20, 2017, 10:59:34 AM
It's here (in post 475)
https://www.theswamp.org/index.php?topic=9042.msg555891#msg555891
Mathias
Title: Re: Triangulation (re-visited)
Post by: CostinBos77 on December 20, 2017, 11:23:15 AM
It's here (in post 475)
https://www.theswamp.org/index.php?topic=9042.msg555891#msg555891
Mathias

Thank you very much !

It is a very grate program !
Title: Re: Triangulation (re-visited)
Post by: CostinBos77 on December 20, 2017, 03:52:34 PM
I am fighting with this challenge from 2013 .

I hope the next step will be to cut the TIN by different geometric irregular shapes like in the picture .
Title: Re: Triangulation (re-visited)
Post by: pedroantonio on January 11, 2018, 05:23:56 PM
Any news from ymg ?? I he OK ??
Title: Re: Triangulation (re-visited)
Post by: serkancavuslar on March 12, 2018, 03:37:08 PM
Tetragonal
https://youtu.be/ofuxN8uxuGU

TriAngle New
https://youtu.be/a6CdiEylOeQ
Title: Re: Triangulation (re-visited)
Post by: pawcyk on May 21, 2018, 04:46:56 AM
Hi everyone.
Can enyone check this file. In my opinion function PROF works wrong with this settings.

pawcyk
Title: Re: Triangulation (re-visited)
Post by: rw2691 on July 21, 2018, 12:50:23 PM
You have a horizontal grid increment of 0.05, and vertical increment of 0.01 --- these are not practical.

Try z min = 207.0 instead of 207.5
     vrt exageration = 10
     hrz increment = 20
     vrt increment = 1


Title: Re: Triangulation (re-visited)
Post by: pawcyk on July 24, 2018, 04:53:26 AM
Unfortunately, I need this when designing roads...
I do not understand why this is important for this program.
pawcyk
Title: Re: Triangulation (re-visited)
Post by: rw2691 on July 26, 2018, 06:54:33 AM
It hangs because the station range is across 87', and marking stations at every 0.05' (1740 lines) is literally pouring ink on the page from a bottle.

The same, the vertical range is 4', and you are setting grid lines at every 0.01' ... building 400 lines with more ink.

Likewise, if your snap is active they are all snapped to the same place.

That is why I said your parameters are not practical.

If water can shed at a 2% grade, why should you need to analyze every hundredth of a foot?

Just asking.

Title: Re: Triangulation (re-visited)
Post by: pawcyk on July 27, 2018, 01:28:45 AM
..each additional centimeter of the asphalt layer is important.
I know that it creates many lines with such settings, but it does't matter to me.
Correct mapping of the terrain is important to me.
Title: Re: Triangulation (re-visited)
Post by: BIGAL on July 29, 2018, 03:11:10 AM
Increasing density does not increase accuracy as the bottom line its based on a triangle at a time, the more dense the triangle the better the model, also this is not quite correct, the triangle direction has a big influence on the shape, in trying to explain taking points square across a road is more accurate than random points along a road. 30 years experience.
Title: Re: Triangulation (re-visited)
Post by: ribarm on February 25, 2019, 01:07:52 PM
Here are my latest routines... First (vl-some) version is working somewhat faster (unknown reasons)...

Code: [Select]
  ;;; Delaunay Triangulation ALISP by M.R. ( Marko Ribar, d.i.a. - architect )
  ;;; Example without supertriangle and with convex hull triangles - optimized as possible - using (vl-some) loops extensively...

Code: [Select]
  ;;; Delaunay Triangulation ALISP by M.R. ( Marko Ribar, d.i.a. - architect )
  ;;; Example without supertriangle and with convex hull triangles - optimized as possible - using (while) loops extensively...

Reverse link to related topic :
http://www.theswamp.org/index.php?topic=15784.msg593180#msg593180

Regards, M.R.
Title: Re: Triangulation (re-visited)
Post by: ribarm on February 26, 2019, 12:31:13 AM
I am really sorry, I had one blunder in one sub function which I thought was doing like I am showing, but it returned 3D point instead of 2D...

Quote
  ;; Evgeniy Elpanov optimized (circumcircle) sub function

  (defun circum ( 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 (mapcar '+ '(0.0 0.0) p1) p3) (sin ang) 2.0)))
           r (abs r)
      )
    )
    (list (if c (list (car c) (cadr c))) r)
  )

LISP routines reattached and I hope that now everything is fine... If you still find something, please report...
M.R.
Title: Re: Triangulation (re-visited)
Post by: ribarm on February 26, 2019, 11:01:31 AM
I've noticed one more lack in my LISP routines... I should have added tolerance in remove duplicate points sub function here :

Quote
  (defun remove-dupl-points ( l / l1 )
    (setq l (vl-sort l (function (lambda ( a b ) (< (caddr a) (caddr b))))))
    (while (car l)
      (setq l1 (cons (car l) (vl-remove-if (function (lambda ( x ) (equal (list (car x) (cadr x)) (list (caar l) (cadar l)) 1e-8))) l1)))
      (setq l (cdr l))
    )
    l1
  )

LISP routines reattached once again...
P.S. I've changed this also in (c:triangulate-UCS) posted in topic with reverse link - I used the same sub function...

M.R.
Title: Re: Triangulation (re-visited)
Post by: sanju2323 on February 26, 2019, 11:24:14 AM
ribarm,
 Can you upload revised "Triang" lisp?
Title: Re: Triangulation (re-visited)
Post by: ribarm on February 26, 2019, 11:58:00 AM
ribarm,
 Can you upload revised "Triang" lisp?

There is no need if you think on my version... Everything is the same except those minor things I pointed like in my last post... If you think on ymg's version, then I have the same as it's uploaded here and I can't help... Only ymg who is author would be able to modify his version, but I am afraid that I like most of people don't know what is with ymg... I have no info ab him, I'd like to believe that he retired from CAD and forums, but I don't know, hope that he is well... My hopes are with each new day smaller though...
Title: Re: Triangulation (re-visited)
Post by: sanju2323 on February 26, 2019, 12:15:32 PM
We are eagerly waiting for all the ymg, except this, the topic has got stuck, we hope they will come back soon...
Title: Re: Triangulation (re-visited)
Post by: ribarm on February 27, 2019, 03:39:20 AM
Had some lacks in dtr-while.html (dtr-while.lsp)... Reattached file again...
Title: Re: Triangulation (re-visited)
Post by: ribarm on February 27, 2019, 05:59:50 AM
There is even slower version of (dtr-while.lsp)... I suppose that's because of even more checks that are performed while iteration in process... I'll attach it here just for reasons of understanding of what's going on... The main problem is that (founded point inside circle can be but not necessarily point candidate for correct 3rd point of triangle with selected edge which won't find any point inside that triangles circumcircle)... So all this is just avoiding optimization in speed including all checks that are processed... But nevertheless it works - but slower than (dtr-vl-some.lsp)...

[EDIT : dtr-while-even slower more.lsp is mod. of dtr-while-even slower.lsp - latest intervention described in (dtr-vl-some.lsp) is implemented here, but strange execution occurs with even more slower timings...]

[EDIT : dtr-while-even slower more-chk pt in tiang.lsp is mod. of previous mod. - changed sub function (ptincirc) to reflect checking of point inside triangle formed by (car e) (cadr e) and x points... Then if rtn is point, this is passed to adequate processing in portion of code where point p was checking as candidate for next smaller triangle with selected edge e - candidate triangle (car e) (cadr e) p is checked and if triangle list is populated (depending on other checks) routine proceeds to next edge e from edge list el...]

P.S. This last file is reattached as I forgot one more (inters) check and also added (mapcar '+ '(0 0) pt) so that all points inside inters are treated as 2D not 3D - previously there were 3D points which may not bring desired check - inters may be nil and actually if in 2D lines cross each other check should give point (2D)... This is just for (ptincirc) sub function - Triangulation is considered 3D algorithm with 3D points picked in desired UCS...
Title: Re: Triangulation (re-visited)
Post by: ribarm on February 27, 2019, 06:04:01 AM
And dtr-vl-some.lsp for those that don't want *.html version... It's shorter so it can fit inside code tags...

Code - Auto/Visual Lisp: [Select]
  1. (defun c:dtr ( / LM:ConvexHull-ptsonHull LM:Clockwise-p remove-dupl-points circum ptincir *adoc* ss ti i pl ch el trl xx len qq ell )
  2.  
  3.   ;;; Delaunay Triangulation ALISP by M.R. ( Marko Ribar, d.i.a. - architect )
  4.   ;;; Example without supertriangle and with convex hull triangles - optimized as possible - using (vl-some) loops extensively...
  5.  
  6.  
  7.   ;; Convex Hull  -  Lee Mac
  8.   ;; Implements the Graham Scan Algorithm to return the Convex Hull of a list of points.
  9.   ;; Mod. by M.R.
  10.  
  11.   (defun LM:ConvexHull-ptsonHull ( lst / ch p0 lstl )
  12.       (cond
  13.           (   (< (length lst) 4) lst)
  14.           (   (setq p0 (car lst))
  15.               (foreach p1 (cdr lst)
  16.                   (if (or (< (cadr p1) (cadr p0))
  17.                           (and (= (cadr p1) (cadr p0)) (< (car p1) (car p0)))
  18.                       )
  19.                       (setq p0 p1)
  20.                   )
  21.               )
  22.               (setq lst (vl-remove p0 lst))
  23.               (setq lst (append (list p0) lst))
  24.               (setq lst
  25.                   (vl-sort lst
  26.                       (function
  27.                           (lambda ( a b / c d )
  28.                               (if (or (equal (setq c (angle p0 a)) (setq d (angle p0 b)) 1e-8) (and (or (equal c 0.0 1e-8) (equal c (* 2 pi) 1e-8)) (or (equal d 0.0 1e-8) (equal d (* 2 pi) 1e-8))))
  29.                                   (< (distance (list (car p0) (cadr p0)) a) (distance (list (car p0) (cadr p0)) b))
  30.                                   (< c d)
  31.                               )
  32.                           )
  33.                       )
  34.                   )
  35.               )
  36.               (setq lstl (vl-remove-if-not (function (lambda ( x ) (equal (angle p0 (last lst)) (angle p0 x) 1e-8))) lst))
  37.               (setq lst (vl-remove-if (function (lambda ( x ) (equal (angle p0 (last lst)) (angle p0 x) 1e-8))) lst))
  38.               (setq lstl (vl-sort lstl (function (lambda ( a b ) (> (distance (list (car p0) (cadr p0)) a) (distance (list (car p0) (cadr p0)) b))))))
  39.               (setq lst (append lst lstl))
  40.               (setq ch (list (cadr lst) (car lst)))
  41.               (foreach pt (cddr lst)
  42.                   (setq ch (cons pt ch))
  43.                   (while (and (caddr ch) (LM:Clockwise-p (caddr ch) (cadr ch) pt))
  44.                       (setq ch (cons pt (cddr ch)))
  45.                   )
  46.               )
  47.               (reverse ch)
  48.           )
  49.       )
  50.   )
  51.  
  52.   ;; Clockwise-p  -  Lee Mac
  53.   ;; Returns T if p1,p2,p3 are clockwise oriented or [s]collinear[/s]
  54.   ;; Mod. by M.R.
  55.  
  56.   (defun LM:Clockwise-p ( p1 p2 p3 )
  57.       (<  (-  (* (- (car  p2) (car  p1)) (- (cadr p3) (cadr p1)))
  58.               (* (- (cadr p2) (cadr p1)) (- (car  p3) (car  p1)))
  59.           )
  60.           0.0
  61.       )
  62.   )
  63.  
  64.   (defun remove-dupl-points ( l / l1 )
  65.     (setq l (vl-sort l (function (lambda ( a b ) (< (caddr a) (caddr b))))))
  66.     (while (car l)
  67.       (setq l1 (cons (car l) (vl-remove-if (function (lambda ( x ) (equal (list (car x) (cadr x)) (list (caar l) (cadar l)) 1e-8))) l1)))
  68.       (setq l (cdr l))
  69.     )
  70.     l1
  71.   )
  72.  
  73.   ;; Evgeniy Elpanov optimized (circumcircle) sub function
  74.  
  75.   (defun circum ( p1 p2 p3 / ang c r )
  76.     (if (not (zerop (setq ang (- (angle p2 p3) (angle p2 p1)))))
  77.       (setq c (polar p3 (+ -1.570796326794896 (angle p3 p1) ang) (setq r (/ (distance (mapcar '+ '(0.0 0.0) p1) p3) (sin ang) 2.0)))
  78.            r (abs r)
  79.       )
  80.     )
  81.     (list (if c (list (car c) (cadr c))) r)
  82.   )
  83.  
  84.   ;; Point inside circle sub function - returns t or nil if out of radius-fuzz range - by M.R.
  85.  
  86.   (defun ptincir ( orig rad-fuzz ptlst / rtn p )
  87.     (while (setq p (car ptlst))
  88.       (if (<= (distance orig p) rad-fuzz)
  89.         (setq rtn t ptlst nil)
  90.         (setq ptlst (cdr ptlst))
  91.       )
  92.     )
  93.     rtn
  94.   )
  95.  
  96.   (if (= 8 (logand 8 (getvar 'undoctl)))
  97.     (vla-endundomark *adoc*)
  98.   )
  99.   (vla-startundomark *adoc*)
  100.   (prompt "\nSelect points in desired UCS...")
  101.   (if (setq ss (ssget '((0 . "POINT"))))
  102.     (progn
  103.       (setq ti (car (_vl-times)))
  104.       (repeat (setq i (sslength ss))
  105.         (setq pl (cons (trans (cdr (assoc 10 (entget (ssname ss (setq i (1- i)))))) 0 1) pl))
  106.       )
  107.       (princ (strcat "\n" (itoa (length pl)) " points collected at : " (rtos (- (car (_vl-times)) ti) 2 50) " milliseconds..."))
  108.       (setq pl (remove-dupl-points pl))
  109.       (princ (strcat "\n" (itoa (length pl)) " unique points (removed duplicates) at : " (rtos (- (car (_vl-times)) ti) 2 50) " milliseconds..."))
  110.       (setq ch (LM:ConvexHull-ptsonHull pl))
  111.       (setq ch (mapcar (function (lambda ( a b ) (list a b))) ch (append (cdr ch) (list (car ch)))))
  112.       (setq el (list (car ch)) ell el)
  113.       (while
  114.         (vl-some (function (lambda ( e )
  115.           (vl-some (function (lambda ( x / q )
  116.             (if
  117.               (and
  118.                 (setq q (circum (car e) (cadr e) x))
  119.                 (car q)
  120.                 (not (ptincir (car q) (cadr q) (vl-remove (car e) (vl-remove (cadr e) (vl-remove x (append xx pl))))))
  121.                 (not (vl-some (function (lambda ( tr ) (and (vl-position (car e) tr) (vl-position (cadr e) tr) (vl-position x tr)))) trl))
  122.               )
  123.               (progn
  124.                 (setq trl (cons (list (car e) (cadr e) x) trl))
  125.                 (if (not (or (vl-position (list (cadr e) x) el) (vl-position (list x (cadr e)) el)))
  126.                   (setq el (cons (list (cadr e) x) el))
  127.                   (setq el (vl-remove-if (function (lambda ( ee ) (or (equal (list (cadr e) x) ee) (equal (list x (cadr e)) ee)))) el))
  128.                 )
  129.                 (setq ell (cons (list (cadr e) x) ell))
  130.                 (if (not (or (vl-position (list (car e) x) el) (vl-position (list x (car e)) el)))
  131.                   (setq el (cons (list (car e) x) el))
  132.                   (setq el (vl-remove-if (function (lambda ( ee ) (or (equal (list (car e) x) ee) (equal (list x (car e)) ee)))) el))
  133.                 )
  134.                 (setq ell (cons (list (car e) x) ell))
  135.                 (setq len (length xx))
  136.                 (if (not (vl-position (car e) xx))
  137.                   (setq xx (cons (car e) xx))
  138.                 )
  139.                 t
  140.               )
  141.             )
  142.             )) (vl-sort (vl-remove (car (vl-remove (car e) (vl-remove (cadr e) (vl-some (function (lambda ( tr ) (if (and (vl-position (car e) tr) (vl-position (cadr e) tr)) tr))) trl)))) (vl-remove (car e) (vl-remove (cadr e) pl))) (function (lambda ( a b ) (< (distance (list (caar e) (cadar e)) a) (distance (list (caar e) (cadar e)) b)))))
  143.           )
  144.           )) el
  145.         )
  146.         (if (and (cadr xx) (/= len (length xx)))
  147.           (setq pl (vl-remove (cadr xx) pl))
  148.         )
  149.       )
  150.       (while
  151.         (vl-some (function (lambda ( e )
  152.           (vl-some (function (lambda ( x / q )
  153.             (if
  154.               (and
  155.                 (setq q (circum (car e) (cadr e) x))
  156.                 (car q)
  157.                 (not (ptincir (car q) (cadr q) (vl-remove (car e) (vl-remove (cadr e) (vl-remove x (append xx pl))))))
  158.                 (not (vl-some (function (lambda ( tr ) (and (vl-position (car e) tr) (vl-position (cadr e) tr) (vl-position x tr)))) trl))
  159.               )
  160.               (progn
  161.                 (setq trl (cons (list (car e) (cadr e) x) trl))
  162.                 (if (not (or (vl-position (list (cadr e) x) el) (vl-position (list x (cadr e)) el)))
  163.                   (setq el (cons (list (cadr e) x) el))
  164.                   (setq el (vl-remove-if (function (lambda ( ee ) (or (equal (list (cadr e) x) ee) (equal (list x (cadr e)) ee)))) el))
  165.                 )
  166.                 (setq ell (cons (list (cadr e) x) ell))
  167.                 (if (not (or (vl-position (list (car e) x) el) (vl-position (list x (car e)) el)))
  168.                   (setq el (cons (list (car e) x) el))
  169.                   (setq el (vl-remove-if (function (lambda ( ee ) (or (equal (list (car e) x) ee) (equal (list x (car e)) ee)))) el))
  170.                 )
  171.                 (setq ell (cons (list (car e) x) ell))
  172.                 t
  173.               )
  174.             )
  175.             )) (vl-sort (vl-remove (car (vl-remove (car e) (vl-remove (cadr e) (vl-some (function (lambda ( tr ) (if (and (vl-position (car e) tr) (vl-position (cadr e) tr)) tr))) trl)))) (vl-remove (car e) (vl-remove (cadr e) (if (null qq) (setq qq (vl-remove-if (function (lambda ( y ) (vl-every (function (lambda ( ee / yy ) (and (vl-position y ee) (setq yy (car (vl-remove y ee))) (= (length (vl-remove-if (function (lambda ( eee ) (and (vl-position y eee) (vl-position yy eee)))) ell)) (- (length ell) 2))))) ell))) xx)) qq)))) (function (lambda ( a b ) (< (distance (list (caar e) (cadar e)) a) (distance (list (caar e) (cadar e)) b)))))
  176.           )
  177.           )) el
  178.         )
  179.       )
  180.       (princ (strcat "\n" (itoa (length trl)) " triangles calculated at : " (rtos (- (car (_vl-times)) ti) 2 50) " milliseconds..."))
  181.       (foreach tr trl
  182.         (entmake (list '(0 . "3DFACE") (cons 10 (trans (car tr) 1 0)) (cons 11 (trans (car tr) 1 0)) (cons 12 (trans (cadr tr) 1 0)) (cons 13 (trans (caddr tr) 1 0))))
  183.       )
  184.       (princ (strcat "\nTriangulation completed at : " (rtos (- (car (_vl-times)) ti) 2 50) " milliseconds..."))
  185.     )
  186.   )
  187.   (vla-endundomark *adoc*)
  188.   (princ)
  189. )
  190.  

Regards, M.R.
[EDIT : Code little changed from dtr-vl-some.html version... Gain in time is 1 sec. on 75 seconds...]
Change is referenced only on (vl-some) version in part where list of checking points is initiated for selected edge and now from point list both edge points and vertex (3rd triangle point) if triangle with selected edge is found are removed...
Change is highlighted in code (lines 144 and 177)...
Title: Re: Triangulation (re-visited)
Post by: sanju2323 on February 27, 2019, 06:31:09 AM
ribarm,
Thanks for the code.. :-)
Title: Re: Triangulation (re-visited)
Post by: ribarm on February 28, 2019, 09:50:34 AM
I've changed a little dtr-vl-some.lsp routine... See my previous post...

M.R.
Title: Re: Triangulation (re-visited)
Post by: ribarm on March 01, 2019, 07:26:25 AM
Some new mods. of (dtr-while.lsp) posted here :
http://www.theswamp.org/index.php?topic=9042.msg593217#msg593217

M.R.
Title: Re: Triangulation (re-visited)
Post by: ribarm on March 02, 2019, 09:49:21 AM
Now when its all written I've noticed one more blunder...

This marked red, you should cut-paste as follows :
Quote
...
            (if
              (and
                (setq q (circum (car e) (cadr e) x))
                (car q)
                (not (ptincir (car q) (cadr q) (vl-remove (car e) (vl-remove (cadr e) (vl-remove x (append xx pl))))))
                (not (vl-some (function (lambda ( tr ) (and (vl-position (car e) tr) (vl-position (cadr e) tr) (vl-position x tr)))) trl))
              )
              (progn
                (setq trl (cons (list (car e) (cadr e) x) trl))
                (if (not (or (vl-position (list (cadr e) x) el) (vl-position (list x (cadr e)) el)))
                  (setq el (cons (list (cadr e) x) el) ell (cons (list (cadr e) x) ell))
                  (setq el (vl-remove-if (function (lambda ( ee ) (or (equal (list (cadr e) x) ee) (equal (list x (cadr e)) ee)))) el))
                )
                (if (not (or (vl-position (list (car e) x) el) (vl-position (list x (car e)) el)))
                  (setq el (cons (list (car e) x) el) ell (cons (list (car e) x) ell))
                  (setq el (vl-remove-if (function (lambda ( ee ) (or (equal (list (car e) x) ee) (equal (list x (car e)) ee)))) el))
                )
...

Like this :
Quote
...
            (if
              (and
                (setq q (circum (car e) (cadr e) x))
                (car q)
                (not (ptincir (car q) (cadr q) (vl-remove (car e) (vl-remove (cadr e) (vl-remove x (append xx pl))))))
                (not (vl-some (function (lambda ( tr ) (and (vl-position (car e) tr) (vl-position (cadr e) tr) (vl-position x tr)))) trl))
              )
              (progn
                (setq trl (cons (list (car e) (cadr e) x) trl))
                (if (not (or (vl-position (list (cadr e) x) el) (vl-position (list x (cadr e)) el)))
                  (setq el (cons (list (cadr e) x) el))
                  (setq el (vl-remove-if (function (lambda ( ee ) (or (equal (list (cadr e) x) ee) (equal (list x (cadr e)) ee)))) el))
                )
                (setq ell (cons (list (cadr e) x) ell))
                (if (not (or (vl-position (list (car e) x) el) (vl-position (list x (car e)) el)))
                  (setq el (cons (list (car e) x) el))
                  (setq el (vl-remove-if (function (lambda ( ee ) (or (equal (list (car e) x) ee) (equal (list x (car e)) ee)))) el))
                )
                (setq ell (cons (list (car e) x) ell))
...

This blunder you should correct in all occurrences in all dtr.lsp posted codes by me... (dtr-while.lsp versions have more this places, so just take your patience and fix this...) Hopefully this is such mistake that is easy to correct, only thing is that you'll save just few milliseconds in routine execution which is ALISP codes that are terribly slow... But my part I did, hoping that Daniel or someone else that works in different languages will answer and reply, so I'll change just my last posted code in code tags (vl-some version) as its the fastest (best) till now...
Sorry, we are all humans and sometimes we make blunders, but in time those things are hopefully fixed over...
Regards, M.R.
Title: Re: Triangulation (re-visited)
Post by: VovKa on March 02, 2019, 03:47:49 PM
which is ALISP codes that are terribly slow...
yes it is significantly slower than compiled executables but much depends on algorithms and optimization
your code is quite long so it is not easy (especially for a stranger like me) to tell where's the flaw
but i'm sure there is a way to make the code run faster
Title: Re: Triangulation (re-visited)
Post by: ribarm on March 03, 2019, 08:09:23 AM
which is ALISP codes that are terribly slow...
yes it is significantly slower than compiled executables but much depends on algorithms and optimization
your code is quite long so it is not easy (especially for a stranger like me) to tell where's the flaw
but i'm sure there is a way to make the code run faster

Look VovKa, or anyone who is reading...
Yes, you can say always that there is for sure way to make the code run faster, but I am pretty sure that without initial sorting of points and without using supertriangle in start and as premise, that my version (vl-some) is optimized as much as possible and is running as fast as possible... My version of Deluneay is as I can say basic algorithm for it and my wish is to make that version be translated to faster executable dll/arx version as I guess that version Daniel posted here : https://www.theswamp.org/index.php?topic=28889.msg593095#msg593095  is using supertriangle - there are no convex hull triangles processed... Beside all of this there is ALISP version by Evgeniy's algorithm that uses big supertriangle and is getting convex hull triangles and all that very fast : http://www.theswamp.org/index.php?topic=15784.msg593121#msg593121 , but I still think that that method can sometime be unreliable, so I am sticking with basic version without supertriangle... I know that this is inevitably going to be much slower than already created arx by Daniel, but my intention is to collect all versions as in practice I may never face with 1000000 pts (that amount of points), but I may need to have it correctly done some reasonably smaller number of points but in correct manner with convex hull triangles processed and in relatively fast timings... My LISP (vl-some) is already doing that as I wanted, but I am pretty sure that with exact translation of code into dll/arx timings could be much better, meaning that this could cover and more complex requirements in terms of amount of points processed...

I hope you understand my intentions and beside all this I am not professional programmer, just an architect...
M.R.
Title: Re: Triangulation (re-visited)
Post by: ribarm on March 03, 2019, 11:57:41 AM
There was a lack in (LM:ConvexHull-ptsonHull) sub function... I know - modifications have to be made in all routines, but I'll leave that to you... This mod that I did in code tag where (vl-some) version is posted should be made also in all codes I posted with that sub - I mean on topic with TSP problem started by Evgeniy... Sorry, who knows what I'll catch too in future...

OK., I corrected my inputs here : http://www.theswamp.org/index.php?topic=30434.0

M.R.
Title: Re: Triangulation (re-visited)
Post by: ElpanovEvgeniy on March 04, 2019, 03:38:09 AM
What should the triangles look like for these four points?
Title: Re: Triangulation (re-visited)
Post by: ribarm on March 04, 2019, 06:22:30 AM
What should the triangles look like for these four points?

Well I assume that if circumcircle should touch only 3 points in triangle and none of other points placed inside that circumcircle, then your first png should be correct...
Title: Re: Triangulation (re-visited)
Post by: ElpanovEvgeniy on March 04, 2019, 06:57:53 AM
but:
Code - Auto/Visual Lisp: [Select]
  1. (distance '(0 0 0) '(3 3 0))    ; 4.24264
  2. (distance '(1 2 -20) '(2 1 20)) ; 40.025
Title: Re: Triangulation (re-visited)
Post by: ribarm on March 04, 2019, 07:38:14 AM
2D projection is important... No matter which solution you choose 3D model of 2 triangle 3DFACEs is the same...

Code - Auto/Visual Lisp: [Select]
  1. Command: (distance '(0 0) '(3 3))
  2. 4.24264
  3. Command: (distance '(1 2) '(2 1))
  4. 1.41421
  5.  
Title: Re: Triangulation (re-visited)
Post by: rw2691 on March 04, 2019, 11:46:33 AM
Without a breakline to dictate differently, common elevations should be directly linked. But this looks like a contrived situation. Normally, the shortest segments would be preferred. But any practitioner would have assigned a breakline. Even if the contours ended up looking the same with either.

Rick
Title: Re: Triangulation (re-visited)
Post by: Nilrac on March 06, 2019, 05:35:57 PM
I'm getting an error message when i try to run the TIN command,it says invalid attribute value left does anyone know how to resolve this?
Title: Re: Triangulation (re-visited)
Post by: rw2691 on March 07, 2019, 11:33:33 AM
You need to give more information ...

Did you plot points with elevations?

How did you select the points for the TIN?

At what stage of the queries did you get the error?

I noticed that you are using BricsCAD. Which version? I have BricsCAD Version 18.2.20, and TIN works fine.

Rick
Title: Re: Triangulation (re-visited)
Post by: roy_043 on March 07, 2019, 04:15:06 PM
@Nilrac:
On line 896 and line 908 change 'Left' to 'left' (DCL is case sensitive).
Erase the existing tinV0.6.7.dcl file before trying the revised code.
Title: Re: Triangulation (re-visited)
Post by: ribarm on March 18, 2019, 11:45:29 AM
Evgeniy, you probably thought on interpolation of existing TIN if pair of triangles have not coplanar set of points - 4 points share no common plane (in your example they share, but in practice this may not be the case almost always with 3D points in space)...

So, I wrote this code, but unfortunately amount of points may triple... So it IS desperately needed faster DTR algorithm for triangulation...

P.S. Daniel, haven't replied to my PM. Sorry, but I think he is not interested in making new *.arx...

Code - Auto/Visual Lisp: [Select]
  1. (defun c:interpolatetriangulation ( / unique vl-position-fuzz ss i 3df pl tr trl e1 e2 e3 e1tr e2tr e3tr p1 p2 ip ipp1p2 ipe1 ipe2 ipe3 )
  2.  
  3.   (defun unique ( l )
  4.     (if l
  5.       (cons (car l)
  6.         (unique (vl-remove-if '(lambda ( x ) (equal x (car l) 1e-6)) l))
  7.       )
  8.     )
  9.   )
  10.  
  11.   (defun vl-position-fuzz ( e l fuzz / car-vl-member-if )
  12.     (defun car-vl-member-if ( f l / ff r )
  13.       (setq ff '(lambda ( x ) (if (apply f (list x)) (setq r x))))
  14.       (vl-some ff l)
  15.       r
  16.     )
  17.     (vl-position (car-vl-member-if '(lambda ( x ) (equal e x fuzz)) l) l)
  18.   )
  19.  
  20.   (prompt "\nSelect TIN 3DFACE entities...")
  21.   (if (setq ss (ssget '((0 . "3DFACE"))))
  22.     (progn
  23.       (repeat (setq i (sslength ss))
  24.         (setq 3df (ssname ss (setq i (1- i))))
  25.         (setq pl (mapcar 'cdr (vl-remove-if-not '(lambda ( x ) (vl-position (car x) '(10 11 12 13))) (entget 3df))))
  26.         (setq tr (unique pl))
  27.         (setq trl (cons tr trl))
  28.       )
  29.       (setq pl nil)
  30.       (foreach tr trl
  31.         (setq e1 (list (car tr) (cadr tr)) e2 (list (cadr tr) (caddr tr)) e3 (list (caddr tr) (car tr)))
  32.         (setq e1tr (vl-some '(lambda ( tr ) (if (and (vl-position-fuzz (car e1) tr 1e-6) (vl-position-fuzz (cadr e1) tr 1e-6)) tr)) (vl-remove tr trl)))
  33.         (setq e2tr (vl-some '(lambda ( tr ) (if (and (vl-position-fuzz (car e2) tr 1e-6) (vl-position-fuzz (cadr e2) tr 1e-6)) tr)) (vl-remove tr trl)))
  34.         (setq e3tr (vl-some '(lambda ( tr ) (if (and (vl-position-fuzz (car e3) tr 1e-6) (vl-position-fuzz (cadr e3) tr 1e-6)) tr)) (vl-remove tr trl)))
  35.         (if e1tr
  36.           (progn
  37.             (setq p1 (caddr tr))
  38.             (setq p2 (car (vl-remove-if '(lambda ( x ) (equal (car e1) x 1e-6)) (vl-remove-if '(lambda ( y ) (equal (cadr e1) y 1e-6)) e1tr))))
  39.             (setq ip (inters (mapcar '+ '(0 0) p1) (mapcar '+ '(0 0) p2) (mapcar '+ '(0 0) (car e1)) (mapcar '+ '(0 0) (cadr e1))))
  40.             (if ip
  41.               (progn
  42.                 (setq ip (list (car ip) (cadr ip) 0.0))
  43.                 (setq ipp1p2 (inters p1 p2 ip (mapcar '+ ip '(0 0 1)) nil))
  44.                 (setq ipe1 (inters (car e1) (cadr e1) ip (mapcar '+ ip '(0 0 1)) nil))
  45.                 (setq pl (cons (mapcar '(lambda ( a b ) (/ (+ a b) 2.0)) ipp1p2 ipe1) pl))
  46.               )
  47.             )
  48.           )
  49.         )
  50.         (if e2tr
  51.           (progn
  52.             (setq p1 (car tr))
  53.             (setq p2 (car (vl-remove-if '(lambda ( x ) (equal (car e2) x 1e-6)) (vl-remove-if '(lambda ( y ) (equal (cadr e2) y 1e-6)) e2tr))))
  54.             (setq ip (inters (mapcar '+ '(0 0) p1) (mapcar '+ '(0 0) p2) (mapcar '+ '(0 0) (car e2)) (mapcar '+ '(0 0) (cadr e2))))
  55.             (if ip
  56.               (progn
  57.                 (setq ip (list (car ip) (cadr ip) 0.0))
  58.                 (setq ipp1p2 (inters p1 p2 ip (mapcar '+ ip '(0 0 1)) nil))
  59.                 (setq ipe2 (inters (car e2) (cadr e2) ip (mapcar '+ ip '(0 0 1)) nil))
  60.                 (setq pl (cons (mapcar '(lambda ( a b ) (/ (+ a b) 2.0)) ipp1p2 ipe2) pl))
  61.               )
  62.             )
  63.           )
  64.         )
  65.         (if e3tr
  66.           (progn
  67.             (setq p1 (cadr tr))
  68.             (setq p2 (car (vl-remove-if '(lambda ( x ) (equal (car e3) x 1e-6)) (vl-remove-if '(lambda ( y ) (equal (cadr e3) y 1e-6)) e3tr))))
  69.             (setq ip (inters (mapcar '+ '(0 0) p1) (mapcar '+ '(0 0) p2) (mapcar '+ '(0 0) (car e3)) (mapcar '+ '(0 0) (cadr e3))))
  70.             (if ip
  71.               (progn
  72.                 (setq ip (list (car ip) (cadr ip) 0.0))
  73.                 (setq ipp1p2 (inters p1 p2 ip (mapcar '+ ip '(0 0 1)) nil))
  74.                 (setq ipe3 (inters (car e3) (cadr e3) ip (mapcar '+ ip '(0 0 1)) nil))
  75.                 (setq pl (cons (mapcar '(lambda ( a b ) (/ (+ a b) 2.0)) ipp1p2 ipe3) pl))
  76.               )
  77.             )
  78.           )
  79.         )
  80.       )
  81.       (setq pl (unique pl))
  82.       (foreach p pl
  83.         (entmake (list '(0 . "POINT") (cons 10 p)))
  84.       )
  85.       (prompt "\nInterpolation points created... Please remove existing TIN and retrinagulate with new points added...")
  86.     )
  87.   )
  88.   (princ)
  89. )
  90.  

Regards, M.R.
Title: Re: Triangulation (re-visited)
Post by: ribarm on March 18, 2019, 04:48:44 PM
This is maybe better - I played with previous one and wasn't quite satisfied... Note that IMHO best is to use 1 interpolation - not many as result may be with close points and very different elevations making no smooth transitions, but very odd triangulation...

Here is revision (I used (midpt (mid1 mid2)) - mid1-middle of edge - mid2-middle of 3rd points of adjacent triangles sharing that common edge...)

Code - Auto/Visual Lisp: [Select]
  1. (defun c:interpolatetriangulation-new ( / unique vl-position-fuzz ss i 3df pl tr trl e1 e2 e3 e1tr e2tr e3tr p1 p2 ip ipp1p2 ipe1 ipe2 ipe3 )
  2.  
  3.   (defun unique ( l )
  4.     (if l
  5.       (cons (car l)
  6.         (unique (vl-remove-if '(lambda ( x ) (equal x (car l) 1e-6)) l))
  7.       )
  8.     )
  9.   )
  10.  
  11.   (defun vl-position-fuzz ( e l fuzz / car-vl-member-if )
  12.     (defun car-vl-member-if ( f l / ff r )
  13.       (setq ff '(lambda ( x ) (if (apply f (list x)) (setq r x))))
  14.       (vl-some ff l)
  15.       r
  16.     )
  17.     (vl-position (car-vl-member-if '(lambda ( x ) (equal e x fuzz)) l) l)
  18.   )
  19.  
  20.   (prompt "\nSelect TIN 3DFACE entities...")
  21.   (if (setq ss (ssget '((0 . "3DFACE"))))
  22.     (progn
  23.       (repeat (setq i (sslength ss))
  24.         (setq 3df (ssname ss (setq i (1- i))))
  25.         (setq pl (mapcar 'cdr (vl-remove-if-not '(lambda ( x ) (vl-position (car x) '(10 11 12 13))) (entget 3df))))
  26.         (setq tr (unique pl))
  27.         (setq trl (cons tr trl))
  28.       )
  29.       (setq pl nil)
  30.       (foreach tr trl
  31.         (setq e1 (list (car tr) (cadr tr)) e2 (list (cadr tr) (caddr tr)) e3 (list (caddr tr) (car tr)))
  32.         (setq e1tr (vl-some '(lambda ( tr ) (if (and (vl-position-fuzz (car e1) tr 1e-6) (vl-position-fuzz (cadr e1) tr 1e-6)) tr)) (vl-remove tr trl)))
  33.         (setq e2tr (vl-some '(lambda ( tr ) (if (and (vl-position-fuzz (car e2) tr 1e-6) (vl-position-fuzz (cadr e2) tr 1e-6)) tr)) (vl-remove tr trl)))
  34.         (setq e3tr (vl-some '(lambda ( tr ) (if (and (vl-position-fuzz (car e3) tr 1e-6) (vl-position-fuzz (cadr e3) tr 1e-6)) tr)) (vl-remove tr trl)))
  35.         (if e1tr
  36.           (progn
  37.             (setq p1 (caddr tr))
  38.             (setq p2 (car (vl-remove-if '(lambda ( x ) (equal (car e1) x 1e-6)) (vl-remove-if '(lambda ( y ) (equal (cadr e1) y 1e-6)) e1tr))))
  39.             (setq ip (inters (mapcar '+ '(0 0) p1) (mapcar '+ '(0 0) p2) (mapcar '+ '(0 0) (car e1)) (mapcar '+ '(0 0) (cadr e1))))
  40.             (if ip
  41.               (progn
  42.                 (setq ipp1p2 (mapcar '(lambda ( a b ) (/ (+ a b) 2.0)) p1 p2))
  43.                 (setq ipe1 (mapcar '(lambda ( a b ) (/ (+ a b) 2.0)) (car e1) (cadr e1)))
  44.                 (setq pl (cons (mapcar '(lambda ( a b ) (/ (+ a b) 2.0)) ipp1p2 ipe1) pl))
  45.               )
  46.             )
  47.           )
  48.         )
  49.         (if e2tr
  50.           (progn
  51.             (setq p1 (car tr))
  52.             (setq p2 (car (vl-remove-if '(lambda ( x ) (equal (car e2) x 1e-6)) (vl-remove-if '(lambda ( y ) (equal (cadr e2) y 1e-6)) e2tr))))
  53.             (setq ip (inters (mapcar '+ '(0 0) p1) (mapcar '+ '(0 0) p2) (mapcar '+ '(0 0) (car e2)) (mapcar '+ '(0 0) (cadr e2))))
  54.             (if ip
  55.               (progn
  56.                 (setq ipp1p2 (mapcar '(lambda ( a b ) (/ (+ a b) 2.0)) p1 p2))
  57.                 (setq ipe2 (mapcar '(lambda ( a b ) (/ (+ a b) 2.0)) (car e2) (cadr e2)))
  58.                 (setq pl (cons (mapcar '(lambda ( a b ) (/ (+ a b) 2.0)) ipp1p2 ipe2) pl))
  59.               )
  60.             )
  61.           )
  62.         )
  63.         (if e3tr
  64.           (progn
  65.             (setq p1 (cadr tr))
  66.             (setq p2 (car (vl-remove-if '(lambda ( x ) (equal (car e3) x 1e-6)) (vl-remove-if '(lambda ( y ) (equal (cadr e3) y 1e-6)) e3tr))))
  67.             (setq ip (inters (mapcar '+ '(0 0) p1) (mapcar '+ '(0 0) p2) (mapcar '+ '(0 0) (car e3)) (mapcar '+ '(0 0) (cadr e3))))
  68.             (if ip
  69.               (progn
  70.                 (setq ipp1p2 (mapcar '(lambda ( a b ) (/ (+ a b) 2.0)) p1 p2))
  71.                 (setq ipe3 (mapcar '(lambda ( a b ) (/ (+ a b) 2.0)) (car e3) (cadr e3)))
  72.                 (setq pl (cons (mapcar '(lambda ( a b ) (/ (+ a b) 2.0)) ipp1p2 ipe3) pl))
  73.               )
  74.             )
  75.           )
  76.         )
  77.       )
  78.       (setq pl (unique pl))
  79.       (foreach p pl
  80.         (entmake (list '(0 . "POINT") (cons 10 p)))
  81.       )
  82.       (prompt "\nInterpolation points created... Please remove existing TIN and retrinagulate with new points added...")
  83.     )
  84.   )
  85.   (princ)
  86. )
  87.  

Regards, M.R.
Title: Re: Triangulation (re-visited)
Post by: snownut2 on April 19, 2019, 12:45:41 PM
Well the absence of YMG here is definitely felt.  I had emailed with YMG in the past and sent him an email the other day, I have yet to receive any reply.  Yesterday I did a bit of googling of his name in Quebec, the results where dis-heartening.  It appears we may never see the version 7 he was working on. (I hope I'm mistaken)

I have done some editing of the Triangulation program that he had been so feverishly working on, I would like to post it here, but wanted to get a sense from others if this would be proper.  I didn't add any additional features, just cleaned up what was already there and made everything accessible via DCL, including the ability to utilize multiple TIN's, which he had started but did not fully incorporate.
Title: Re: Triangulation (re-visited)
Post by: CostinBos77 on April 20, 2019, 07:52:18 AM
Hello ,

Almoste there .

Many thanks to Mr. ElpanovEvgeniy , the brain of the engine of initial Triangulate (http://elpanov.com/index.php?id=6) lisp from 2008 .
Title: Re: Triangulation (re-visited)
Post by: anhquang1989 on April 21, 2019, 10:46:33 PM
Costibos77. Worderfull
You can share lisp. Thank you
Title: Re: Triangulation (re-visited)
Post by: CostinBos77 on April 22, 2019, 09:58:53 AM
Hello everybody and anhquang1989 ,

download the attached .rar file , unzip and read the .pdf files .

If you agree , don't hesitate to contact me .

PS :
I tested it only in AutoCAD , so I am not sure about other software !

Regards ,

Costin

Title: Re: Triangulation (re-visited)
Post by: pawcyk on April 25, 2019, 03:06:51 AM
CostinBos77, do you know if this program works with GStarCAD or ZWCAD??
Title: Re: Triangulation (re-visited)
Post by: CostinBos77 on April 25, 2019, 03:43:03 AM
Hello pawcyk ,

Should work , if commands + Auto Lisp / Visual Lisp and DCL functions are the same .

From my experience ,  when I tried on BricsCAD , don't work integrally.

Because the softwares are different !

But you can try it , is free isn't ?


Title: Re: Triangulation (re-visited)
Post by: Rod on April 25, 2019, 07:22:06 PM
Cos,
not many users are willing to run a FAS from an unknown source.

You are asking users to run a FAS
Email you with their user name, HDD serial number, PC name etc.
Run another FAS

My guess is very few will be willing to do this. You may have more luck posting the lsp if possible
Title: Re: Triangulation (re-visited)
Post by: CostinBos77 on April 26, 2019, 02:40:58 AM
Hello Rod,

Thanks for your observation.

1. For me , when I am talking about AutoCAD/ AutoLISP, I am very serious.

2. I am too busy with cutting the 3D Model , instead to hide some tricky lines as a virus.
I am considering this is not a place for jokes.
To destroy some computers , is not my goal and will not make my daily job easier.

3. Already 30 people download it . And 2 of them already use it .

4. The fas file is 1.33Mb , 31.000 compact lines . Even for me , It is very hard to find and change something . So , for somebody else will be a nightmare . I keep it as it is , because it is already used by 30 people .

5. It is nothing brilliant inside . Only commands over commands added in 15 years of work . I am not a genius , I create this from 0 , everything it is original ( except the idea for Triangulation Function from Mr. E.E. , as I said before ) , and for the necessity of achieving daily tasks.
User Functions : F1, F2,   ... , F100 .
User Programmes : P1 ( F5 , F7 , F120 ..... ) , P2 (F9 , F7 , F130 , .... ) ... P100 (...) .

6. I uploaded some demo videos to demonstrate that it can be done and to raise some questions about the difference of using between 3D Face and 3D Mesh .

7. For people who have doubts ,  can use AutoCAD Civil 3D , it is much much better than mine .

Regards,

Costin

Title: Re: Triangulation (re-visited)
Post by: PKENEWELL on April 26, 2019, 04:42:58 PM
Costin,

While I understand your concerns. Please understand respectfully; the point of this forum is for users helping users understand and write their own lisp code. compiling the code does not reflect what this forum is for.

In addition, their have been some unscrupulous people trying to use this forum for unsolicited advertising, and yes - in a few cases have tried to pawn off viruses to unsuspecting users. The folks on this forum as a result tend to be a bit gun-shy of compiled code.
Title: Re: Triangulation (re-visited)
Post by: CostinBos77 on April 27, 2019, 02:25:39 AM
Hello PKENEWELL ,

1. If my archive is against the rules of this site, the moderator can remove it with no arguments .

2. If the fas file can be a potential problem, then you can watch safely on YouTube and if you like it , then you can use it .

3.
Quote
... the point of this forum is for users helping users understand and write their own lisp code . compiling the code does not reflect what this forum is for .
I am totally agree with you . But , to copy from a lisp file , will not help anybody to learn something .

4. I am considering a west of time to discuss about a fas file inside of this important post about Triangulation
( I don't want to spoil the value of this subject with some banal / trivial comments ) , instead of to put the important questions :

- the intersection between two 3D objects , a circle / polyline and a 3D Face or 3D Mesh ;
- how to determine if a point it is inside / outside of a triangle ;
- how to calculate / interpolate Z inside of 3D triangle;
- how to calculate the volume between two 3D surfaces ;
- how to force the TIN to follow some levels ( break lines ) ;
- how to calculate the minimum border of cloud points of a 3D Model ;

and so on .

This kind of questions I expected to see . I am looking for this ensures too .

Regards ,

Costin
Title: Re: Triangulation (re-visited)
Post by: snownut2 on April 27, 2019, 10:16:01 AM
CostinBos77, do you know if this program works with GStarCAD or ZWCAD??

FAS file will only work in ACAD, BricsCAD has their own compiler that can be downloaded for free, it runs independent of BricsCAD so the person using it does not need BricsCAD on their machine.

Maybe CostinBos77 could compile lisp files with BricsCAD compiler for you.
Title: Re: Triangulation (re-visited)
Post by: CostinBos77 on April 27, 2019, 03:30:21 PM
Hello snownut2 ,

unfortunately , I don't have contact with any other software as BricsCAD or ZwCAD anymore .

Just happened in one company for what I worked , to provide me a computer with BricsCAD
( anyway , I was very frustrated about this ) . It is looking similar , but it is working differently .

Regards ,

Costin
Title: Re: Triangulation (re-visited)
Post by: BIGAL on April 28, 2019, 12:33:21 AM
The subject of compiled lisp is interesting maybe the likes of Norton, Mc Afee could look at it from a virus point of view ?

Or do we need a certification process where say open code is sent to Autodesk/theswamp compiled then you can have a  checksum etc to be checked. Autodesk apps are checked not just posted onto their site.

If I supply a Fas then my credentials would be over 10,000 posts at Cadtutor, posts at Forums/Autodesk & Augi.
Title: Re: Triangulation (re-visited)
Post by: CostinBos77 on April 29, 2019, 02:30:27 AM
Ok , I understood Mr. BigAl .

I have removed the fas file and all the external links.

Regards ,
Title: Re: Triangulation (re-visited)
Post by: sanju2323 on February 07, 2020, 08:41:26 PM
Hi,
It has been many years since this topic, but regretted that no updates have been received after Lisp triang v.0.6.7. I will request to all members please keep updating Lisp.
Title: Re: Triangulation (re-visited)
Post by: ribarm on February 08, 2020, 05:59:36 AM
Hi,
It has been many years since this topic, but regretted that no updates have been received after Lisp triang v.0.6.7. I will request to all members please keep updating Lisp.

Now even BricsCAD have decent TIN command that performs very fast and with that said lisp versions are outdated and not preferable choice for this operation because of speed of calculation...
Though TIN command does TIN surface, but without convex hull triangles, so this meigt be one of lacks, but compensation for this is that speed is very satisfactory and implementation of hull triangles would then bring only lack of performace with very small effect of final resulting surface difference...
If you are using ACAD, I suggest that you use one of It's Alive's aka Daniel's *.arx files for triangulation as it's also very fast...
Title: Re: Triangulation (re-visited)
Post by: sanju2323 on February 08, 2020, 06:42:36 AM
I don't know much about arx code and if arx is better than lisp then I would also like tin and contour to be generated from arx itself.  I think this topic should start with a new one in arx forum.
Thank for the suggestion ribarm. :-D
Title: Re: Triangulation (re-visited)
Post by: lamarn on April 22, 2020, 05:15:11 PM
Hi

Using TriangV0.6.7.lsp i'm getting this error. A small fix?

* Lisp (new_dialog) failed : DCL id = -1, dialog name 'contours'

Also, the command TIN (defun c:tin) cannot be used by default because is always starts the BricsCAD default and not this routine

Anyone else on BricsCAD to confirm and test?




Title: Re: Triangulation (re-visited)
Post by: roy_043 on April 23, 2020, 02:23:48 AM
https://www.theswamp.org/index.php?topic=9042.msg593360#msg593360
Title: Re: Triangulation (re-visited)
Post by: lamarn on April 23, 2020, 09:58:20 AM
 :straight: great!
Title: Re: Triangulation (re-visited)
Post by: takieddine on September 29, 2021, 10:29:44 AM
Hi
Can someone plz share Triang V0.6.7
I couldn't find it.
Thanks in advance
Title: Re: Triangulation (re-visited)
Post by: ronjonp on September 29, 2021, 04:28:12 PM
Hi
Can someone plz share Triang V0.6.7
I couldn't find it.
Thanks in advance
https://www.theswamp.org/index.php?topic=9042.msg555891#msg555891
Title: Re: Triangulation (re-visited)
Post by: takieddine on October 01, 2021, 10:20:09 AM
Thank you  :-D
Title: Re: Triangulation (re-visited)
Post by: ronjonp on October 01, 2021, 12:09:05 PM
Thank you  :-D
You're welcome.
Title: Re: Triangulation (re-visited)
Post by: ahsattarian on May 15, 2022, 08:27:22 AM
Help me!
I used lisp Triangulation v.0.6.7. But I want to create a Tin surface form Autocad like C3D.



Please Check this file, done by my own LISP and simplified your points.
Title: Re: Triangulation (re-visited)
Post by: ahsattarian on May 16, 2022, 06:40:20 AM
Hi everyone.
Can enyone check this file. In my opinion function PROF works wrong with this settings.

pawcyk

Have a look at this file,  Done by my own LISP and evaluated from your points every 5.00  meters  :
Title: Re: Triangulation (re-visited)
Post by: arza on July 20, 2022, 11:37:17 AM
Hi
Can someone plz share Triang V0.6.7
I couldn't find it.

narasimharaoarza0211@gmail.com
Title: Re: Triangulation (re-visited)
Post by: ronjonp on July 20, 2022, 02:45:35 PM
Hi
Can someone plz share Triang V0.6.7
I couldn't find it.

narasimharaoarza0211@gmail.com
https://www.theswamp.org/index.php?topic=9042.msg555891#msg555891
Title: Re: Triangulation (re-visited)
Post by: arza on July 21, 2022, 12:35:23 PM
 

Good morning Sir
 
 I am trying to do tin with triangv0.6.7.lsp, but it is not forming tin .
 
 I am attaching a drawing for your kind reference.
 
 Please help me in this regard.
Title: Re: Triangulation (re-visited)
Post by: Pad on July 29, 2022, 12:19:31 PM
see attached.

perhaps a bit late in the day
Title: Re: Triangulation (re-visited)
Post by: Dilan_Veras on July 30, 2022, 03:03:58 AM


Good morning Sir
 
 I am trying to do tin with triangv0.6.7.lsp, but it is not forming tin .
 
 I am attaching a drawing for your kind reference.
 
 Please help me in this regard.
Title: Re: Triangulation (re-visited)
Post by: PM on July 31, 2022, 11:12:51 AM
I can not see any 3d points. You need to add 3d points and break lines if you want to create a correct TIN.
Title: Re: Triangulation (re-visited)
Post by: rw2691 on October 12, 2023, 10:28:39 AM
Can anyone tell me where the code is handling breaklines? Both for collecting and applying them to the triangulation TIN's. I think I know where it is collecting, but I have a hard time seeing anything that actually applies them to the TIN.

The reason I need to know is that is the current version will break on the 3Dpoly for the boundary, but is ignoring all of the breaklines inside the boundary.

It may be on account of BricsCAD. They have developed their own TIN and COUNTOURS code. I have had to rename functions to get it to do anything.

Rick
Title: Re: Triangulation (re-visited)
Post by: BIGAL on October 12, 2023, 06:21:22 PM
There is 3rd party programs for Bricscad like "Ciivil Site Design" it will do way more than just make TIN's, yes breaklines supported, volumes, multi surfaces, grading and lots more. At a reasonable price.
Title: Re: Triangulation (re-visited)
Post by: rw2691 on October 13, 2023, 09:04:50 AM
I have BricsCAD-2022, and it comes with civil, but I have not found it to do things like select objects inside of a boundary line; and clip tins that are outside of the boundary line.

These features (among others) are essential because a complex topography (especially if it is large) is too prone to having mistakes due to draftsmen oversight.

So I want to get TRIANG functional again ... it had been doing everything that is important. Moreover, I want to be able to customize it for my particular needs.
Title: Re: Triangulation (re-visited)
Post by: ribarm on October 13, 2023, 09:37:25 AM
Maybe you can glean something from this posted attachment :
https://www.theswamp.org/index.php?topic=9042.msg576276#msg576276

Regards,
HTH.
M.R.
Title: Re: Triangulation (re-visited)
Post by: rw2691 on October 14, 2023, 05:07:08 AM
ribarm,

I have previously tried your system, and it is also failing to use the breaklines.

I need to know what sections of the code are handling the breaklines, so that I may examine it and fix the issue. It has to be a naming conflict with the BricsCAD system.
Title: Re: Triangulation (re-visited)
Post by: rw2691 on November 02, 2023, 01:19:53 PM
To all,

I finally found where and how YMG was handling the break lines.

But I have disturbing news about BricsCAD. Versions 22 thru 24 have produced identical conflicts with LISP and OLE construction.

1) They will not process DXF methods that relate to self made TIN constructs, and they don't post any error messages about them either.

2) You cannot name your code TIN, because their TIN construct has that name, and they ignore your LISP code.

3) I had to resort to version 21 in order to precede these conflicts.

4) I have also found BricsCAD support to be rude toward anyone that does their own LISP and OLE coding, instead of using their tools or those of an endorsed programmer. So their "maintenance contract" is useless, because they consider that their software has a malfunction.

Nevertheless, they used to produce better work, and version 21 seems to be OK. I just hate that I wasted my money by upgrading to the newer versions.

In contrast, YMG's work has been very high quality ... so we can rely on what he has given us. Moreover, we can customize his code if we want something to operate differently.

However, his code for breaklines still had a problem. He was doing the breaks correctly, but it wasn't deleting the TINs that were crossing the breaklines. So I added some code that deleted all of the TINs, and then rebuilt the TINs per his corrections. The following is what I did...

Code: [Select]
;; Insertion of Constraints                                          ;
              (if cdtl   ;; cdtl, List of Points (3d) Forming Constraints 
                  (progn
                      (setq ti (time))
                      (acet-ui-progress "Inserting Constraint:" (length cdtl))  ;; starts acet-ui-progress bar

                      (mk_layer (list ".SRF-NET" 9))  ;;   color 9: ashes
      (rw_disablesnap)
 
                      (foreach k cdtl
                          (rw_FlipEdge (car k) (cadr k)) ;; sends x & y only
                          (progress-step nil)                 ;; rw_FlipEdge is a rename for ADDEDGE
                          )                                             ;; I was avoiding a possible naming conflict
 
      (rw_RebuildNet)  ;; THIS IS HOW I REBUILT THE TIN NETWORK ... I ADMIT IT IS A HACK!
 
                      (rw_enablesnap)
                      (acet-ui-progress) ;; ends acet-ui-progress bar                     
                      (if *bounden* (erase-outside *bounden*))

Code: [Select]
(defun rw_RebuildNet ()  ;; I USED COMMAND METHOD TO AVOID THE DXF ISSUE WITH BRICSCAD
       (C:JNK)
       (foreach tr tl  
      (cond
  ((= (length tr) 3)  ;; triangle   *** CONSTRUCT TIN ***
(setq p1 (nth (car tr) pl))
(setq p2 (nth (cadr tr) pl))
(setq p3 (nth (caddr tr) pl))
(command "3dface" p1 p2 p3 "" "") 
(setq 3DFL (cons (cadddr tr) 3DFL)) ;; update 3dfl
)
  ((= (length tr) 4)  ;; rectangle  *** CONCTRUCT SHEET *** NOT USED ***
(setq p1 (nth (car tr) pl))
(setq p2 (nth (cadr tr) pl))
(setq p3 (nth (caddr tr) pl))
(setq cutlist (cdr tr))
(setq p4 (nth (caddr cutlist) pl))
(command "3dface" p1 p2 p3 p4 "")
(setq 3DFL (cons (cadddr tr) 3DFL)) ;; update 3dfl
)
  )
  )
       )

Code: [Select]
(defun C:JNK ( / Target_Lyr)   ;; Junk: deletes TIN group   ;; IMP: rebuilds the TIN group
   (setq *osm* (getvar 'osmode))

   (defun *error* (errmsg)
   (if *osm* (setvar 'osmode *osm*))
   (if (not (member msg '("Function cancelled" "quit / exit abort")))
   (princ (strcat "\nError: " msg))
   )
   (princ)
   )
;;
   (setq LstLyr (getvar 'clayer))
   
   (setq Target_Lyr ".SRF-NET")   
   (Delete_Lyr_Items Target_Lyr)
   
   (setvar 'clayer LstLyr)
   )

Rick

Title: Re: Triangulation (re-visited)
Post by: It's Alive! on November 03, 2023, 12:13:05 AM
Maybe you can you undefine/redefine BricsCAD’s TIN command?

Re BricsCAD’s support, you probably got some one that didn’t understand the problem. It’s best to provide a simple function that illustrates the issue. I.e.  like a unit test. You probably got sent to the team the developed the tin and not the API team.


Title: Re: Triangulation (re-visited)
Post by: rw2691 on November 03, 2023, 10:42:53 AM
It was the manager of the Support Team. In my experience, I have found only one support person whom I feel is capable of "thinking outside the box," and that is Torsten Moses. Unfortunately, the manager won't let him talk to me anymore. The support department has become unhealthy, and in my opinion, three versions (22, 23 & 24) are proof of that. They have never fixed their problems. Actually, it reminds me of AutoCAD.

Rick
Title: Re: Triangulation (re-visited)
Post by: It's Alive! on November 03, 2023, 08:26:39 PM
Yikes, they’re probably flooded with stuff since v24 was just released. I’m sure they didn’t mean to be rude; they’re just being crushed, Torsten is probably being stretched thin.
If you post the bug, maybe someone here at the swamp can find a workaround

Title: Re: Triangulation (re-visited)
Post by: rw2691 on November 13, 2023, 09:09:56 AM
RibArm

I tried your BUBBLE function. I think that it helped the contours, but when I looked at the code, I was surprised that you are only calculating an average between existing points. How will an average of a triangular plate create a "bubble?" Shouldn't you take the neighboring tins and project the elevation curve that a group of tins would infer?

Rick
Title: Re: Triangulation (re-visited)
Post by: rw2691 on December 25, 2023, 07:55:59 AM
Good news ...

I had changed a lot of functions in the Triangulation program which involved PLINE and POLYLINE, and fixed it so that BricsCAD version 21 would be completely compatible with Triangulation.

Now better news ... BricsCAD version 24 has been updated to function perfectly with PLINE and POLYLINE functions. They also fixed it so that LISP and external OLE apps are totally compatible.

No more problem! Moreover, I have not wasted my money on their improvements to date. That had been depressing.

Rick
Title: Re: Triangulation (re-visited)
Post by: mhy3sx on December 29, 2023, 10:44:39 AM
Hi rw2691. Can you post the new code?

Thanks
Title: Re: Triangulation (re-visited)
Post by: xdcad on December 29, 2023, 11:14:54 AM
here: https://www.theswamp.org/index.php?topic=58871.0


(http://www.theswamp.org/index.php?action=dlattach;topic=58871.0;attach=41798;image)
Title: Re: Triangulation (re-visited)
Post by: rw2691 on January 18, 2024, 01:31:47 PM
@mhy3sx

I work with a trimmed down version that only does the things that I need done. Plus, I have interfaced with my COGO code. You might not be very happy with it. So I say ... if the version that you have is not giving you any trouble, you should stay with that.

I was posting because BricsCAD had caused what used to work, to not work. But now they have fixed BricsCAD, and Triang works again. But I have not gone back to the previous version that I was using (it was also very trimmed down).

I like the changes that I had to do in order to keep working with BricsCAD. I think that my version of Triang is much healthier. To fix it for BricsCAD I had to remove the DXF codes, and replace them with standard command line objects. It is slower than DXF, but that is only significant on very large properties. On the practical side, as well, most projects are from 1 to 30 acres. I don't notice the slowing.

However, what I have cut out of the software are things that I am not Professionally allowed to do in my State and Country. They are things that Engineers have reserved for their practice. I am a Land Surveyor, and all that I need are contours. I am not even supposed to do earthwork designs ... that is also Engineering; but Engineers do not want to collect data or chop trees down. So they are happy that I will, and they hire me to do so.

Rick
Title: Re: Triangulation (re-visited)
Post by: PrinceLISPalot on January 18, 2024, 09:57:11 PM
Maybe you can you undefine/redefine BricsCAD’s TIN command?

Possibly better to create an alias for the LISP command.

Code - Auto/Visual Lisp: [Select]
  1. (defun C:TN ()(C:TIN))