points density - dense.lsp - overlapping points and speed issue

Hi all, recently I tried to make routine for making greater density of points that are to be used in generating terrain model. I know one desirable process that I've already tried (thread ab surveying points here on www.cadtutor.net) with DTM routine for 3DFACEs generation, AC (AutoCurve) routine that had small bug - line : (inters pt1 pt2 pt3 pt4) should be (inters pt1 pt2 pt3 pt4 nil) within one subfunction (I corrected this and that's now OK), LV routine for making mesh from sections over exploded polylines isohypses (equal elevation) from before used AC on 3DFACEs from DTM, and finally M2S (mesh2solid) routine for making 3D solid terrain... Anyway, my question is ab routine I made... Now it gives approximately desired results with less than 1000 points... I want to speed somehow process of calculation - code optimization and to allow more than 1000 points to be considered for routine calculations (this is even now possible but process is so slow - time consumption is greater with every single point added more for calculation consideration)... And one more thing, if process of repeating execution of routine is performed (4-5 times on starting 4 points) at the end when used command OVERKILL it removes duplicated points, and I just don't know how in the first place they have been created (look closely to code - especially line (if (not (member pp pplst)) (setq pplst (cons pp pplst)))...

Any help on these 2 issues will be very appreciated... So here is my code :

(defun nearest ( pt lst / d1 d2 p1 p2 )
 (setq lst (vl-remove pt lst))
 (setq d1 (distance pt (car lst))
       p1 (car lst)
 )
 (foreach p2 (cdr lst)
   (if (> d1 (setq d2 (distance pt p2)))
     (setq d1 d2 p1 p2)
   )
 )
 p1
)

(defun mid ( p1 p2 )
 (mapcar '(lambda (a b) (/ (+ a b) 2.0)) p1 p2)
)

(defun c:dense ( / ss n entpt pt ptlst pttlst pp pplst p2 ptt loop )
 (setq ss (ssget '((0 . "POINT"))))
 [color=red](vl-cmdf "_.osnap" "off")[/color]
 (repeat (setq n (sslength ss))
   (setq entpt (ssname ss (setq n (1- n))))
   (setq pt (cdr (assoc 10 (entget entpt))))
   (setq ptlst (cons pt ptlst))
 )
 (setq pttlst ptlst)
 (foreach pt pttlst
   (setq ptlst pttlst)
   (setq ptt nil)
   (setq loop T)
   (while loop
     (if ptt (setq ptlst (vl-remove ptt ptlst)))
     (if (not (null (vl-remove pt ptlst)))
       (progn
         (setq p2 (nearest pt ptlst))
         (setq pp (mid pt p2))
         (if (not (member pp pplst)) (setq pplst (cons pp pplst)))
         (setq ptt pt)
         (setq pt p2)
       )
       (setq loop nil)
     )
   )
 )
 (foreach pt pplst
   (entmakex (list '(0 . "POINT") '(100 . "AcDbEntity") '(100 . "AcDbPoint") (cons 10 pt)))
 )
 (princ)
)

Thanks for any reply, sincerely M.R.

I've found out what was problem with overlapping - it was OSNAP...

So I added :

(vl-cmdf "_.osnap" "off")

So now remains issue ab speed...

M.R. (Above code updated - added (vl-cmdf "_.osnap" "off"))

A good programming practice call to restore user’s environment after you changed it:

 (setq userOsnap (getvar "OSMODE"))
 (setvar "OSMODE" 0)
  
 ;;; processing
  
 (setvar "OSMODE" userOsnap) 

I've checked now with 5 points at start and repeated routine 4-5 times... It creates again overlapping points, so it isn't OSNAP the problem... Still there is issue of overlapping...

M.R.

Try

(if [color=blue][b](not (ssget "_C" pp pp))[/b][/color]
[color=blue][b](entmakex (list '(0 . "POINT") '(100 . "AcDbEntity") '(100 . "AcDbPoint") (cons 10 pp)))[/b][/color]
             )

and remove the creation of pplst and entaking the point entity on the fly rather than from a list.

or even (not (nentselp pp)) ;

pBe, your method seems to work... Thank you very much... Now only issue is is there better alternative then cycling through each point to gain a few new points that are between 2 near points... With one cycle I have almost correct result, I just don't know how to gain remaining points without these repetitions for each point... Now code looks like this :

(defun nearest ( pt lst / d1 d2 p1 p2 )
 (setq lst (vl-remove pt lst))
 (setq d1 (distance pt (car lst))
       p1 (car lst)
 )
 (foreach p2 (cdr lst)
   (if (> d1 (setq d2 (distance pt p2)))
     (setq d1 d2 p1 p2)
   )
 )
 p1
)

(defun mid ( p1 p2 )
 (mapcar '(lambda (a b) (/ (+ a b) 2.0)) p1 p2)
)

(defun c:dense ( / ss n entpt pt ptlst pttlst pp p2 ptt loop )
 (setq ss (ssget '((0 . "POINT"))))
 (vl-cmdf "_.osnap" "off")
 (repeat (setq n (sslength ss))
   (setq entpt (ssname ss (setq n (1- n))))
   (setq pt (cdr (assoc 10 (entget entpt))))
   (setq ptlst (cons pt ptlst))
 )
 (setq pttlst ptlst)
 (foreach pt pttlst
   (setq ptlst pttlst)
   (setq ptt nil)
   (setq loop T)
   (while loop
     (if ptt (setq ptlst (vl-remove ptt ptlst)))
     (if (not (null (vl-remove pt ptlst)))
       (progn
         (setq p2 (nearest pt ptlst))
         (setq pp (mid pt p2))
         (if (not (ssget "_C" pp pp)) 
           (entmakex (list '(0 . "POINT") '(100 . "AcDbEntity") '(100 . "AcDbPoint") (cons 10 pp)))
         )
         (setq ptt pt)
         (setq pt p2)
       )
       (setq loop nil)
     )
   )
 )
 (princ)
)

pBe, thanks again for your reply and solving overlapping problem...

Regards, M.R.

And here is streight forward solution from first to last point derivation in single loop...

(defun mid ( p1 p2 )
 (mapcar '(lambda (a b) (/ (+ a b) 2.0)) p1 p2)
)
(defun c:dense ( / ss n entpt ptlst pt pp p2 )
 (setq ss (ssget "_X" '((0 . "POINT"))))
 (vl-cmdf "_.osnap" "off")
 (repeat (setq n (sslength ss))
   (setq entpt (ssname ss (setq n (1- n))))
   (setq pt (cdr (assoc 10 (entget entpt))))
   (setq ptlst (cons pt ptlst))
 )
 (setq ptlst (reverse ptlst))
 (while ptlst
   (setq pt (car ptlst))
   (if (cadr ptlst) (setq p2 (cadr ptlst)) (setq p2 nil))
   (if p2
     (progn
       (entdel (ssname (ssget "_C" pt pt) 0))
       (entmakex (list '(0 . "POINT") '(100 . "AcDbEntity") '(100 . "AcDbPoint") (cons 10 pt)))
       (setq pp (mid pt p2))
       (entmakex (list '(0 . "POINT") '(100 . "AcDbEntity") '(100 . "AcDbPoint") (cons 10 pp)))
     )
     (progn
       (entdel (ssname (ssget "_C" pt pt) 0))
       (entmakex (list '(0 . "POINT") '(100 . "AcDbEntity") '(100 . "AcDbPoint") (cons 10 pt)))
     )         
   )
   (setq ptlst (cdr ptlst))
 )
 (princ)
)

M.R.

I can appreciate what you are doing but really the bottom line is how is the original survey data being captured adding extra points may not improve the model, we work the other way and ask our surveyors to change their technique, a good example is a existing road being surveyed, getting the points roughly square across yields a far better model than randomly walking the individual lines that make a road also when breaklines are added they are in true direction.

If you have a perfect grid survey no extra point will make it any better only reducing grid size will improve. The facets will not change.

Last word yes we will on occasions add some pts to individual lines to improve the mesh not a global add.

pBe, thanks again for your reply and solving overlapping problem...

Regards, M.R.

You are welcome M.R.

On your latest post, I cant say for sure I understand what its supposed to do. Cant give any advice or suggestions really.

Keep on coding

Cheers

I struggled for a while until I didn't figured out whats the catch (seen triangulate.lsp - DTM function)... The catch was to check for every 3 points circumcircle against rest of points and find those 3 for witch no other rest points are inside circumcircle... My version of DTM is I guess preciser than DTM, but it's so much slower, I strongly suggest to use DTM.vlx... So here is my version (all before posts refer to this triangulation witch I finally got wright)...

(defun averpttriang (triangle)
 (mapcar '(lambda (a b c) (/ (+ a b c) 3.0)) (car triangle) (cadr triangle) (caddr triangle))
)

(defun unique (lst)
 (if lst (cons (car lst) (unique (vl-remove (car lst) (cdr lst)))))
)

(defun uniquetriangles (triangles / lst assoctriangles uniquetriangs)
 (foreach triangle triangles
   (setq lst (cons (averpttriang triangle) lst))
 )
 (setq lst (unique lst))
 (foreach triangle triangles
   (setq assoctriangles (cons (cons (averpttriang triangle) triangle) assoctriangles))
 )
 (foreach averpt lst
   (setq uniquetriangs (cons (cdr (assoc averpt assoctriangles)) uniquetriangs))
 )
 uniquetriangs
)

(defun mid (p1 p2)
 (mapcar '(lambda (a b) (/ (+ a b) 2.0)) p1 p2)
)

(defun circumtriang (p1 p2 p3 / pp1 pp2 pp3 mp1p2 mp2p3 npmp1p2 npmp2p3 cen rad)
 (setq pp1 (list (car p1) (cadr p1)))
 (setq pp2 (list (car p2) (cadr p2)))
 (setq pp3 (list (car p3) (cadr p3)))
 (setq mp1p2 (mid pp1 pp2))
 (setq mp2p3 (mid pp2 pp3))
 (setq npmp1p2 (polar mp1p2 (+ (angle pp1 pp2) (/ pi 2.0)) 1.0))
 (setq npmp2p3 (polar mp2p3 (+ (angle pp2 pp3) (/ pi 2.0)) 1.0))
 (setq cen (inters mp1p2 npmp1p2 mp2p3 npmp2p3 nil))
 (setq rad (distance cen p1))
 (list cen rad)
)

(defun ptinsidecir (pt circle)
 (setq pt (list (car pt) (cadr pt)))
 (> (cadr circle) (distance (car circle) pt))
)

(defun c:triangulate ( / msp ss n pt ptlst pttlst p1 p2 p3 circle tst lst triangles) (vl-load-com)
 (setq msp (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))))
 (setq ss (ssget '((0 . "POINT"))))
 (repeat (setq n (sslength ss))
   (setq pt (cdr (assoc 10 (entget (ssname ss (setq n (1- n)))))))
   (setq ptlst (cons pt ptlst))
 )
 (setq pttlst ptlst)
 (while (> (length ptlst) 2)
   (setq p1 (car ptlst))
   (foreach p2 (cdr ptlst)
     (foreach p3 (vl-remove p2 (cdr ptlst))
       (setq circle (circumtriang p1 p2 p3))
       (foreach pp (vl-remove p3 (vl-remove p2 (vl-remove p1 pttlst)))
         (if (not (ptinsidecir pp circle)) (setq tst (cons T tst)) (setq tst (cons nil tst)))
       )
       (if (eval (cons 'and tst)) (setq lst (cons p1 lst) lst (cons p2 lst) lst (cons p3 lst)))
       (if lst (setq triangles (cons lst triangles)))
       (setq lst nil)
       (setq tst nil)
       (setq ptlst (vl-remove p1 ptlst))
       (setq ptlst (vl-remove p2 ptlst))
       (setq ptlst (vl-remove p3 ptlst))
       (setq ptlst (cons p3 ptlst))
       (setq ptlst (cons p2 ptlst))
     )
   )
 )
 (foreach triangle (uniquetriangles triangles)
   (vla-add3dface msp (vlax-3d-point (car triangle)) (vlax-3d-point (cadr triangle)) (vlax-3d-point (caddr triangle)) (vlax-3d-point (caddr triangle)))
 )    
 (princ)
)

BIGAL, you're wright ab interpolation of points... It's totally unnecessary as these 3dfaces represent just that...

pBe, thanks for your hidden suggestion not to suggest anything - it made me think and search for solution...

Keep coding

Regards, M.R.

pBe, thanks for your hidden suggestion not to suggest anything - it made me think and search for solution...

You catch on real fast . I knew you'll come through when push comes to shove

Cheers

Here is slightly faster 2sec on 38sec from previous code (now is 36 sec)... Tested on only 50 3D points...

(defun averpttriang (p1 p2 p3)
 (mapcar '(lambda (a b c) (/ (+ a b c) 3.0)) p1 p2 p3)
)

(defun mid (p1 p2)
 (mapcar '(lambda (a b) (/ (+ a b) 2.0)) p1 p2)
)

(defun circumtriang (p1 p2 p3 / pp1 pp2 pp3 mp1p2 mp2p3 npmp1p2 npmp2p3 cen rad)
 (setq pp1 (list (car p1) (cadr p1)))
 (setq pp2 (list (car p2) (cadr p2)))
 (setq pp3 (list (car p3) (cadr p3)))
 (setq mp1p2 (mid pp1 pp2))
 (setq mp2p3 (mid pp2 pp3))
 (setq npmp1p2 (polar mp1p2 (+ (angle pp1 pp2) (/ pi 2.0)) 1.0))
 (setq npmp2p3 (polar mp2p3 (+ (angle pp2 pp3) (/ pi 2.0)) 1.0))
 (setq cen (inters mp1p2 npmp1p2 mp2p3 npmp2p3 nil))
 (setq rad (distance cen p1))
 (list cen rad)
)

(defun ptinsidecir (pt circle)
 (setq pt (list (car pt) (cadr pt)))
 (> (cadr circle) (distance (car circle) pt))
)

(defun c:triangulate ( / ss n pt ptlst pttlst p1 p2 p3 circle tst lst avrpt avrlst triangles)
 (setq ss (ssget '((0 . "POINT"))))
 (repeat (setq n (sslength ss))
   (setq pt (cdr (assoc 10 (entget (ssname ss (setq n (1- n)))))))
   (setq ptlst (cons pt ptlst))
 )
 (setq pttlst ptlst)
 (while (> (length ptlst) 2)
   (setq p1 (car ptlst))
   (foreach p2 (cdr ptlst)
     (foreach p3 (vl-remove p2 (cdr ptlst))
       (setq circle (circumtriang p1 p2 p3))
       (foreach pp (vl-remove p3 (vl-remove p2 (vl-remove p1 pttlst)))
         (if (not (ptinsidecir pp circle)) (setq tst (cons T tst)) (setq tst (cons nil tst)))
       )
       (if (eval (cons 'and tst)) 
         (progn
           (setq lst (cons p1 lst) lst (cons p2 lst) lst (cons p3 lst))
           (setq avrpt (averpttriang p1 p2 p3))
         )
         (setq avrpt nil)
       )
       (if (and avrpt (not (member avrpt avrlst))) 
         (progn 
           (setq avrlst (cons avrpt avrlst)) 
           (setq triangles (cons lst triangles))
         )
       )
       (setq lst nil)
       (setq tst nil)
       (setq ptlst (vl-remove p1 ptlst))
       (setq ptlst (vl-remove p2 ptlst))
       (setq ptlst (vl-remove p3 ptlst))
       (setq ptlst (cons p3 ptlst))
       (setq ptlst (cons p2 ptlst))
     )
   )
 )
 (foreach triangle triangles
   (entmake (list (cons 0 "3DFACE")(cons 10 (car triangle))(cons 11 (cadr triangle))(cons 12 (caddr triangle))(cons 13 (caddr triangle))))
 )
 (princ)
)

M.R.

Just sligthly more improvement in speed - on my other PC not netbook previous code did for 50 3d pts in 10 sec... Now it did in 8 sec...

(defun nearest (pt lst / d1 d2 p1 p2)
 (setq lst (vl-remove pt lst))
 (setq d1 (distance pt (car lst))
       p1 (car lst)
 )
 (foreach p2 (cdr lst)
   (if (> d1 (setq d2 (distance pt p2)))
     (setq d1 d2 p1 p2)
   )
 )
 p1
)
(defun averpttriang (p1 p2 p3)
 (mapcar '(lambda (a b c) (/ (+ a b c) 3.0)) p1 p2 p3)
)
(defun mid (p1 p2)
 (mapcar '(lambda (a b) (/ (+ a b) 2.0)) p1 p2)
)
(defun circumtriang (p1 p2 p3 / pp1 pp2 pp3 mp1p2 mp2p3 npmp1p2 npmp2p3 cen rad)
 (setq pp1 (list (car p1) (cadr p1)))
 (setq pp2 (list (car p2) (cadr p2)))
 (setq pp3 (list (car p3) (cadr p3)))
 (setq mp1p2 (mid pp1 pp2))
 (setq mp2p3 (mid pp2 pp3))
 (setq npmp1p2 (polar mp1p2 (+ (angle pp1 pp2) (/ pi 2.0)) 1.0))
 (setq npmp2p3 (polar mp2p3 (+ (angle pp2 pp3) (/ pi 2.0)) 1.0))
 (setq cen (inters mp1p2 npmp1p2 mp2p3 npmp2p3 nil))
 (setq rad (distance cen p1))
 (list cen rad)
)
(defun ptinsidecir (pt circle)
 (setq pt (list (car pt) (cadr pt)))
 (> (cadr circle) (distance (car circle) pt))
)
(defun c:triangulate ( / ss n pt ptlst pttlst p1 p2 p3 circle pp lst avrpt avrlst triangles)
 (setq ss (ssget '((0 . "POINT"))))
 (repeat (setq n (sslength ss))
   (setq pt (cdr (assoc 10 (entget (ssname ss (setq n (1- n)))))))
   (setq ptlst (cons pt ptlst))
 )
 (setq pttlst ptlst)
 (while (> (length ptlst) 2)
   (setq p1 (car ptlst))
   (foreach p2 (cdr ptlst)
     (foreach p3 (vl-remove p2 (cdr ptlst))
       (setq circle (circumtriang p1 p2 p3))
       (setq pp (nearest (car circle) (vl-remove p1 (vl-remove p2 (vl-remove p3 pttlst)))))
       (if (not (ptinsidecir pp circle))
         (progn
           (setq lst (cons p1 lst) lst (cons p2 lst) lst (cons p3 lst))
           (setq avrpt (averpttriang p1 p2 p3))
         )
         (setq avrpt nil)
       )
       (if (and avrpt (not (member avrpt avrlst)))
         (progn 
           (setq avrlst (cons avrpt avrlst))
           (setq triangles (cons lst triangles))
         )
       )
       (setq lst nil)
       (if (equal p1 (car ptlst) 1e- (setq ptlst (cdr ptlst)))
     )
   )
 )
 (foreach triangle triangles
   (entmake (list (cons 0 "3DFACE")(cons 10 (car triangle))(cons 11 (cadr triangle))(cons 12 (caddr triangle))(cons 13 (caddr triangle))))
 )
 (princ)
)

P.S. Checked again with 100 pts - previous code : 2min 35sec; this new code : 53sec

But for 200 pts, new code works for : 14min 12sec... So slow...

M.R.

And here is slightly modified last code (while loops) instead of (foreach)... I thought this will be just slightly faster, but I was wrong - it's ab the same as previous code... Seems this is top of speed for this kind of algorithm based on logic by checking each point with each in loop2 with each in loop3...

(defun nearest (pt lst / d1 d2 p1 p2)
 (setq lst (vl-remove pt lst))
 (setq d1 (distance pt (car lst)) p1 (car lst))
 (foreach p2 (cdr lst)
   (if (> d1 (setq d2 (distance pt p2)))
     (setq d1 d2 p1 p2)
   )
 )
 p1
)
(defun averpttriang (p1 p2 p3)
 (mapcar '(lambda (a b c) (/ (+ a b c) 3.0)) p1 p2 p3)
)
(defun mid (p1 p2)
 (mapcar '(lambda (a b) (/ (+ a b) 2.0)) p1 p2)
)
(defun circumtriang (p1 p2 p3 / pp1 pp2 pp3 mp1p2 mp2p3 npmp1p2 npmp2p3 cen rad)
 (setq pp1 (list (car p1) (cadr p1)))
 (setq pp2 (list (car p2) (cadr p2)))
 (setq pp3 (list (car p3) (cadr p3)))
 (setq mp1p2 (mid pp1 pp2))
 (setq mp2p3 (mid pp2 pp3))
 (setq npmp1p2 (polar mp1p2 (+ (angle pp1 pp2) (/ pi 2.0)) 1.0))
 (setq npmp2p3 (polar mp2p3 (+ (angle pp2 pp3) (/ pi 2.0)) 1.0))
 (setq cen (inters mp1p2 npmp1p2 mp2p3 npmp2p3 nil))
 (setq rad (distance cen p1))
 (list cen rad)
)
(defun ptinsidecir (pt circle)
 (setq pt (list (car pt) (cadr pt)))
 (> (cadr circle) (distance (car circle) pt))
)
(defun c:triangulate ( / ss n pt ptlst pttlst p1 p2 p3 p2lst p3lst loop2 loop3 k circle pp lst avrpt avrlst triangles)
 (setq ss (ssget '((0 . "POINT"))))
 (repeat (setq n (sslength ss))
   (setq pt (cdr (assoc 10 (entget (ssname ss (setq n (1- n)))))))
   (setq ptlst (cons pt ptlst))
 )
 (setq pttlst ptlst)
 (while (> (length ptlst) 2)
   (setq p1 (car ptlst))
   (setq p2lst (cdr ptlst))
   (setq loop2 T)
   (while loop2
     (setq p2 (car p2lst))
     (setq p2lst (cdr p2lst))
     (setq p3lst (vl-remove p2 (cdr ptlst)))
     (setq k 0)
     (setq loop3 T)
     (while loop3
       (setq p3 (car p3lst))
       (setq p3lst (cdr p3lst))
       (setq circle (circumtriang p1 p2 p3))
       (setq pp (nearest (car circle) (vl-remove p1 (vl-remove p2 (vl-remove p3 pttlst)))))
       (if (not (ptinsidecir pp circle))
         (progn
           (setq lst (cons p1 lst) lst (cons p2 lst) lst (cons p3 lst))
           (setq avrpt (averpttriang p1 p2 p3))
           (setq k (1+ k))
         )
         (setq avrpt nil)
       )
       (if (and avrpt (not (member avrpt avrlst)))
         (progn
           (setq avrlst (cons avrpt avrlst))
           (setq triangles (cons lst triangles))
         )
       )
       (setq lst nil)
       (if (equal p1 (car ptlst) 1e- (setq ptlst (cdr ptlst)))
       (if (or (eq p3lst nil) (eq k 2)) (setq loop3 nil))
       (if (or (= (length ptlst) 2) (eq p2lst nil)) (setq loop2 nil))
     )
   )
 )
 (foreach triangle triangles
   (entmake (list (cons 0 "3DFACE")(cons 10 (car triangle))(cons 11 (cadr triangle))(cons 12 (caddr triangle))(cons 13 (caddr triangle))))
 )
 (princ)
)

Results are ab the same...

Regards, M.R.

One more thing, I've noticed that this line isn't going to do the job

(not (member avrpt avrlst))

so I've finally revised my last code - little bit slower, but better this :

(defun averpttriang (triangle)
 (mapcar '(lambda (a b c) (/ (+ a b c) 3.0)) (car triangle) (cadr triangle) (caddr triangle))
)
(defun unique (lst)
 (if lst (cons (car lst) (unique (vl-remove (car lst) (cdr lst)))))
)
(defun uniquetriangles (triangles / lst assoctriangles uniquetriangs)
 (foreach triangle triangles
   (setq lst (cons (averpttriang triangle) lst))
 )
 (setq lst (unique lst))
 (foreach triangle triangles
   (setq assoctriangles (cons (cons (averpttriang triangle) triangle) assoctriangles))
 )
 (foreach averpt lst
   (setq uniquetriangs (cons (cdr (assoc averpt assoctriangles)) uniquetriangs))
 )
 uniquetriangs
)
(defun nearest (pt lst / d1 d2 p1 p2)
 (setq lst (vl-remove pt lst))
 (setq d1 (distance pt (car lst)) p1 (car lst))
 (foreach p2 (cdr lst)
   (if (> d1 (setq d2 (distance pt p2)))
     (setq d1 d2 p1 p2)
   )
 )
 p1
)
(defun mid (p1 p2)
 (mapcar '(lambda (a b) (/ (+ a b) 2.0)) p1 p2)
)
(defun circumtriang (p1 p2 p3 / pp1 pp2 pp3 mp1p2 mp2p3 npmp1p2 npmp2p3 cen rad)
 (setq pp1 (list (car p1) (cadr p1)))
 (setq pp2 (list (car p2) (cadr p2)))
 (setq pp3 (list (car p3) (cadr p3)))
 (setq mp1p2 (mid pp1 pp2))
 (setq mp2p3 (mid pp2 pp3))
 (setq npmp1p2 (polar mp1p2 (+ (angle pp1 pp2) (/ pi 2.0)) 1.0))
 (setq npmp2p3 (polar mp2p3 (+ (angle pp2 pp3) (/ pi 2.0)) 1.0))
 (setq cen (inters mp1p2 npmp1p2 mp2p3 npmp2p3 nil))
 (setq rad (distance cen p1))
 (list cen rad)
)
(defun ptinsidecir (pt circle)
 (setq pt (list (car pt) (cadr pt)))
 (> (cadr circle) (distance (car circle) pt))
)
(defun c:triangulate ( / ss n pt ptlst pttlst p1 p2 p3 p2lst p3lst loop2 loop3 k circle pp lst triangles)
 (setq ss (ssget '((0 . "POINT"))))
 (repeat (setq n (sslength ss))
   (setq pt (cdr (assoc 10 (entget (ssname ss (setq n (1- n)))))))
   (setq ptlst (cons pt ptlst))
 )
 (setq pttlst ptlst)
 (while (> (length ptlst) 2)
   (setq p1 (car ptlst))
   (setq p2lst (cdr ptlst))
   (setq loop2 T)
   (while loop2
     (setq p2 (car p2lst))
     (setq p2lst (cdr p2lst))
     (setq p3lst (vl-remove p2 (cdr ptlst)))
     (setq k 0)
     (setq loop3 T)
     (while loop3
       (setq p3 (car p3lst))
       (setq p3lst (cdr p3lst))
       (setq circle (circumtriang p1 p2 p3))
       (setq pp (nearest (car circle) (vl-remove p1 (vl-remove p2 (vl-remove p3 pttlst)))))
       (if (not (ptinsidecir pp circle))
         (progn
           (setq lst (cons p1 lst) lst (cons p2 lst) lst (cons p3 lst))
           (setq triangles (cons lst triangles))
           (setq k (1+ k))
         )
       )
       (setq lst nil)
       (if (equal p1 (car ptlst) 1e- (setq ptlst (cdr ptlst)))
       (if (or (eq p3lst nil) (eq k 2)) (setq loop3 nil))
       (if (or (= (length ptlst) 2) (eq p2lst nil)) (setq loop2 nil))
     )
   )
 )
 (foreach triangle (uniquetriangles triangles)
   (entmake (list (cons 0 "3DFACE")(cons 10 (car triangle))(cons 11 (cadr triangle))(cons 12 (caddr triangle))(cons 13 (caddr triangle))))
 )
 (princ)
)

than this slower variant :

(defun nearest (pt lst / d1 d2 p1 p2)
 (setq lst (vl-remove pt lst))
 (setq d1 (distance pt (car lst)) p1 (car lst))
 (foreach p2 (cdr lst)
   (if (> d1 (setq d2 (distance pt p2)))
     (setq d1 d2 p1 p2)
   )
 )
 p1
)
(defun averpttriang (p1 p2 p3)
 (mapcar '(lambda (a b c) (/ (+ a b c) 3.0)) p1 p2 p3)
)
(defun mid (p1 p2)
 (mapcar '(lambda (a b) (/ (+ a b) 2.0)) p1 p2)
)
(defun circumtriang (p1 p2 p3 / pp1 pp2 pp3 mp1p2 mp2p3 npmp1p2 npmp2p3 cen rad)
 (setq pp1 (list (car p1) (cadr p1)))
 (setq pp2 (list (car p2) (cadr p2)))
 (setq pp3 (list (car p3) (cadr p3)))
 (setq mp1p2 (mid pp1 pp2))
 (setq mp2p3 (mid pp2 pp3))
 (setq npmp1p2 (polar mp1p2 (+ (angle pp1 pp2) (/ pi 2.0)) 1.0))
 (setq npmp2p3 (polar mp2p3 (+ (angle pp2 pp3) (/ pi 2.0)) 1.0))
 (setq cen (inters mp1p2 npmp1p2 mp2p3 npmp2p3 nil))
 (setq rad (distance cen p1))
 (list cen rad)
)
(defun ptinsidecir (pt circle)
 (setq pt (list (car pt) (cadr pt)))
 (> (cadr circle) (distance (car circle) pt))
)
(defun c:triangulate ( / ss n pt ptlst pttlst p1 p2 p3 p2lst p3lst loop2 loop3 k circle pp lst avrpt avrlst tst triangles)
 (setq ss (ssget '((0 . "POINT"))))
 (repeat (setq n (sslength ss))
   (setq pt (cdr (assoc 10 (entget (ssname ss (setq n (1- n)))))))
   (setq ptlst (cons pt ptlst))
 )
 (setq pttlst ptlst)
 (while (> (length ptlst) 2)
   (setq p1 (car ptlst))
   (setq p2lst (cdr ptlst))
   (setq loop2 T)
   (while loop2
     (setq p2 (car p2lst))
     (setq p2lst (cdr p2lst))
     (setq p3lst (vl-remove p2 (cdr ptlst)))
     (setq k 0)
     (setq loop3 T)
     (while loop3
       (setq p3 (car p3lst))
       (setq p3lst (cdr p3lst))
       (setq circle (circumtriang p1 p2 p3))
       (setq pp (nearest (car circle) (vl-remove p1 (vl-remove p2 (vl-remove p3 pttlst)))))
       (if (not (ptinsidecir pp circle))
         (progn
           (setq lst (cons p1 lst) lst (cons p2 lst) lst (cons p3 lst))
           (setq avrpt (averpttriang p1 p2 p3))
           (setq k (1+ k))
         )
         (setq avrpt nil)
       )
       (if avrpt
         (if avrlst
           (foreach pt avrlst
             (if (not (equal avrpt pt 1e-6)) (setq tst (cons T tst)) (setq tst (cons nil tst)))
           )
           (setq tst (cons T tst) tst (cons T tst))
         )
       )
       (if tst
         (if (eval (cons 'and tst))
           (progn
             (setq avrlst (cons avrpt avrlst))
             (setq triangles (cons lst triangles))
           )
         )
       )
       (setq lst nil)
       (setq tst nil)
       (if (equal p1 (car ptlst) 1e- (setq ptlst (cdr ptlst)))
       (if (or (eq p3lst nil) (eq k 2)) (setq loop3 nil))
       (if (or (= (length ptlst) 2) (eq p2lst nil)) (setq loop2 nil))
     )
   )
 )
 (foreach triangle triangles
   (entmake (list (cons 0 "3DFACE")(cons 10 (car triangle))(cons 11 (cadr triangle))(cons 12 (caddr triangle))(cons 13 (caddr triangle))))
 )
 (princ)
)

Still the best is DTM.vlx if it doesn't break...

My version can't break, but it's so slow, slow, slow... (200 pts approx 15min, and DTM 200 pts approx 5sec)

M.R.

And this is quite a mess of 3DFACEs, but speed is acceptable for large number of points - more than 200 pts... It divides area by segments of 40 pts, and overlap this net with area net (n+1)x(n+1) with starting position displacement by (-dx/2 -dy/2)... All this speeds up whole process but it causes mess with faces... Still if DTM.vlx fails, and there are no other alternatives, this is some sort of solution (it's strongly recommended that final terrain model is generated after step 1 by processing next steps till final 3d solid terrain)... Follow this link : click here

(defun averpttriang (triangle)
 (mapcar '(lambda (a b c) (/ (+ a b c) 3.0)) (car triangle) (cadr triangle) (caddr triangle))
)

(defun uniquetriangles (triangles / lst assoctriangles uniquetriangs)
 (foreach triangle triangles
   (setq lst (cons (averpttriang triangle) lst))
 )
 (setq lst (unique lst))
 (foreach triangle triangles
   (setq assoctriangles (cons (cons (averpttriang triangle) triangle) assoctriangles))
 )
 (foreach averpt lst
   (setq uniquetriangs (cons (cdr (assoc averpt assoctriangles)) uniquetriangs))
 )
 uniquetriangs
)

(defun flatten (lst / lstn)
 (foreach triangle (reverse lst)
   (setq lstn (cons (caddr triangle) lstn) lstn (cons (cadr triangle) lstn) lstn (cons (car triangle) lstn))
 )
 (reverse lstn)
)

(defun nearest (pt lst / d1 d2 p1 p2)
 (setq lst (vl-remove pt lst))
 (setq d1 (distance pt (car lst)) p1 (car lst))
 (foreach p2 (cdr lst)
   (if (> d1 (setq d2 (distance pt p2)))
     (setq d1 d2 p1 p2)
   )
 )
 p1
)

(defun mid (p1 p2)
 (mapcar '(lambda (a b) (/ (+ a b) 2.0)) p1 p2)
)

(defun circumtriang (p1 p2 p3 / pp1 pp2 pp3 mp1p2 mp2p3 npmp1p2 npmp2p3 cen rad)
 (setq pp1 (list (car p1) (cadr p1)))
 (setq pp2 (list (car p2) (cadr p2)))
 (setq pp3 (list (car p3) (cadr p3)))
 (setq mp1p2 (mid pp1 pp2))
 (setq mp2p3 (mid pp2 pp3))
 (setq npmp1p2 (polar mp1p2 (+ (angle pp1 pp2) (/ pi 2.0)) 1.0))
 (setq npmp2p3 (polar mp2p3 (+ (angle pp2 pp3) (/ pi 2.0)) 1.0))
 (setq cen (inters mp1p2 npmp1p2 mp2p3 npmp2p3 nil))
 (setq rad (distance cen p1))
 (list cen rad)
)

(defun ptinsidecir (pt circle)
 (setq pt (list (car pt) (cadr pt)))
 (> (cadr circle) (distance (car circle) pt))
)

(defun areatriangulate (ptlst / pttlst p1 p2 p3 p2lstt p2lst p3lst loop2 loop3 k circle pp lst triangles)
 (setq ptlst (vl-sort ptlst '(lambda (a b) (< (car a) (car b)))))
 (setq pttlst ptlst)
 (while (> (length ptlst) 2)
   (setq p1 (car ptlst))
   (setq p2lst (cdr ptlst))
   (setq p2lstt p2lst)
   (setq loop2 T)
   (while loop2
     (setq p2 (car p2lst))
     (setq p2lst (cdr p2lst))
     (setq p3lst (vl-remove p2 p2lstt))
     (setq k 0)
     (setq loop3 T)
     (while loop3
       (setq p3 (car p3lst))
       (setq p3lst (cdr p3lst))
       (setq circle (circumtriang p1 p2 p3))
       (setq pp (nearest (car circle) (vl-remove p1 (vl-remove p2 (vl-remove p3 pttlst)))))
       (if (not (ptinsidecir pp circle))
         (progn
           (setq lst (cons p1 lst) lst (cons p2 lst) lst (cons p3 lst))
           (setq triangles (cons lst triangles))
           (setq k (1+ k))
         )
       )
       (setq lst nil)
       (if (equal p1 (car ptlst) 1e- (setq ptlst (cdr ptlst)))
       (if (eq k 2) (setq loop3 nil p2lst (vl-remove p3 p2lst) p2lst (cons p3 p2lst)))
       (if (and (eq k 2) (member p3 (flatten (cdr triangles)))) (setq loop2 nil))
       (if (eq p3lst nil) (setq loop3 nil))
       (if (or (= (length ptlst) 2) (eq p2lst nil)) (setq loop2 nil))
     )
   )
 )
 triangles
)

(defun c:triangulate ( / ss ssw ssn n pt ptlst k xmin xmax ymin ymax dx dy stwpt enwpt stwptq enwptq vecx vecy i ii triangles stwptn enwptn z pto ptolst)
 (setq ss (ssget '((0 . "POINT"))))
 (repeat (setq n (sslength ss))
   (setq pt (cdr (assoc 10 (entget (ssname ss (setq n (1- n)))))))
   (setq ptlst (cons pt ptlst))
 )
 (setq k (length ptlst))
 (setq ptlst (vl-sort ptlst '(lambda (a b) (< (car a) (car b)))))
 (setq xmin (caar ptlst))
 (setq xmax (car (last ptlst)))
 (setq ptlst (vl-sort ptlst '(lambda (a b) (< (cadr a) (cadr b)))))
 (setq ymin (cadar ptlst))
 (setq ymax (cadr (last ptlst)))
 (setq n (fix (sqrt (/ k 40.0))))
 (setq dx (/ (- xmax xmin) n))
 (setq dy (/ (- ymax ymin) n))
 (setq stwpt (list xmin ymin))
 (setq enwpt (list (+ xmin dx) (+ ymin dy)))
 (setq vecx (list dx 0.0)) 
 (setq vecy (list 0.0 dy)) 
 (setq triangles '())
 (setq stwptq (list (- xmin (/ dx 2.0)) (- ymin (/ dy 2.0))))
 (setq enwptq (list (+ xmin (/ dx 2.0)) (+ ymin (/ dy 2.0))))
 (setq i -1 ii -1)
 (repeat n
   (setq i (1+ i))
   (repeat n
     (setq ii (1+ ii))
     (setq stwptn (mapcar '+ (mapcar '+ (mapcar '* (list i i) vecy) (mapcar '* (list ii ii) vecx)) stwpt))
     (setq enwptn (mapcar '+ (mapcar '+ (mapcar '* (list i i) vecy) (mapcar '* (list ii ii) vecx)) enwpt))
     (setq ssw (ssget "_W" stwptn enwptn '((0 . "POINT"))))
     (if ssw (setq ssn (acet-ss-intersection ss ssw)) (setq ssn ssw))
     (repeat (setq z (if ssn (sslength ssn) 0))
       (setq pto (cdr (assoc 10 (entget (ssname ssn (setq z (1- z)))))))
       (setq ptolst (cons pto ptolst))
     )
     (if (eq ii (- n 1)) (setq ii -1))
     (setq triangles (append (if (and (> (length ptolst) 3) ptolst) (areatriangulate ptolst) nil) triangles))
     (setq ptolst nil)
   )
 )
 (setq i -1 ii -1)
 (repeat (+ n 1)
   (setq i (1+ i))
   (repeat (+ n 1)
     (setq ii (1+ ii))
     (setq stwptn (mapcar '+ (mapcar '+ (mapcar '* (list i i) vecy) (mapcar '* (list ii ii) vecx)) stwptq))
     (setq enwptn (mapcar '+ (mapcar '+ (mapcar '* (list i i) vecy) (mapcar '* (list ii ii) vecx)) enwptq))
     (setq ssw (ssget "_W" stwptn enwptn '((0 . "POINT"))))
     (if ssw (setq ssn (acet-ss-intersection ss ssw)) (setq ssn ssw))
     (repeat (setq z (if ssn (sslength ssn) 0))
       (setq pto (cdr (assoc 10 (entget (ssname ssn (setq z (1- z)))))))
       (setq ptolst (cons pto ptolst))
     )
     (if (eq ii n) (setq ii -1))
     (setq triangles (append (if (and (> (length ptolst) 3) ptolst) (areatriangulate ptolst) nil) triangles))
     (setq ptolst nil)
   )
 ) 
 (foreach triangle (uniquetriangles triangles)
   (entmake (list (cons 0 "3DFACE")(cons 10 (car triangle))(cons 11 (cadr triangle))(cons 12 (caddr triangle))(cons 13 (caddr triangle))))
 )
 (princ)
)

Regards, M.R.

Hope it'll be of some kind of use...

For DWG's with over 2000 pts, I suggest that you have duplicate 3DFACEs as working with large lists are unneccessary... You can then convert 3DFACEs into REGIONs and do OVERKILL... Much faster than with calculation of unique 3DFACEs, though I don't quite know how to convert REGIONs back to 3DFACEs... And don't quite know are 3DFACEs necessary for next procedure step described in above posted link...

(defun flatten (lst / lstn)
 (foreach triangle (reverse lst)
   (setq lstn (cons (caddr triangle) lstn) lstn (cons (cadr triangle) lstn) lstn (cons (car triangle) lstn))
 )
 (reverse lstn)
)
(defun nearest (pt lst / d1 d2 p1 p2)
 (setq lst (vl-remove pt lst))
 (setq d1 (distance pt (car lst)) p1 (car lst))
 (foreach p2 (cdr lst)
   (if (> d1 (setq d2 (distance pt p2)))
     (setq d1 d2 p1 p2)
   )
 )
 p1
)
(defun mid (p1 p2)
 (mapcar '(lambda (a b) (/ (+ a b) 2.0)) p1 p2)
)
(defun circumtriang (p1 p2 p3 / pp1 pp2 pp3 mp1p2 mp2p3 npmp1p2 npmp2p3 cen rad)
 (setq pp1 (list (car p1) (cadr p1)))
 (setq pp2 (list (car p2) (cadr p2)))
 (setq pp3 (list (car p3) (cadr p3)))
 (setq mp1p2 (mid pp1 pp2))
 (setq mp2p3 (mid pp2 pp3))
 (setq npmp1p2 (polar mp1p2 (+ (angle pp1 pp2) (/ pi 2.0)) 1.0))
 (setq npmp2p3 (polar mp2p3 (+ (angle pp2 pp3) (/ pi 2.0)) 1.0))
 (setq cen (inters mp1p2 npmp1p2 mp2p3 npmp2p3 nil))
 (setq rad (distance cen p1))
 (list cen rad)
)
(defun ptinsidecir (pt circle)
 (setq pt (list (car pt) (cadr pt)))
 (> (cadr circle) (distance (car circle) pt))
)
(defun areatriangulate (ptlst / pttlst p1 p2 p3 p2lstt p2lst p3lst loop2 loop3 k circle pp lst triangles)
 (setq ptlst (vl-sort ptlst '(lambda (a b) (< (car a) (car b)))))
 (setq pttlst ptlst)
 (while (> (length ptlst) 2)
   (setq p1 (car ptlst))
   (setq p2lst (cdr ptlst))
   (setq p2lstt p2lst)
   (setq loop2 T)
   (while loop2
     (setq p2 (car p2lst))
     (setq p2lst (cdr p2lst))
     (setq p3lst (vl-remove p2 p2lstt))
     (setq k 0)
     (setq loop3 T)
     (while loop3
       (setq p3 (car p3lst))
       (setq p3lst (cdr p3lst))
       (setq circle (circumtriang p1 p2 p3))
       (setq pp (nearest (car circle) (vl-remove p1 (vl-remove p2 (vl-remove p3 pttlst)))))
       (if (not (ptinsidecir pp circle))
         (progn
           (setq lst (cons p1 lst) lst (cons p2 lst) lst (cons p3 lst))
           (setq triangles (cons lst triangles))
           (setq k (1+ k))
         )
       )
       (setq lst nil)
       (if (equal p1 (car ptlst) 1e- (setq ptlst (cdr ptlst)))
       (if (eq k 2) (setq loop3 nil p2lst (vl-remove p3 p2lst) p2lst (cons p3 p2lst)))
       (if (and (eq k 2) (member p3 (flatten (cdr triangles)))) (setq loop2 nil))
       (if (eq p3lst nil) (setq loop3 nil))
       (if (or (= (length ptlst) 2) (eq p2lst nil)) (setq loop2 nil))
     )
   )
 )
 triangles
)
(defun c:triangulate ( / ss ssw ssn n pt ptlst k xmin xmax ymin ymax dx dy stwpt enwpt stwptq enwptq vecx vecy i ii triangles stwptn enwptn z pto ptolst)
 (setq ss (ssget '((0 . "POINT"))))
 (repeat (setq n (sslength ss))
   (setq pt (cdr (assoc 10 (entget (ssname ss (setq n (1- n)))))))
   (setq ptlst (cons pt ptlst))
 )
 (setq k (length ptlst))
 (setq ptlst (vl-sort ptlst '(lambda (a b) (< (car a) (car b)))))
 (setq xmin (caar ptlst))
 (setq xmax (car (last ptlst)))
 (setq ptlst (vl-sort ptlst '(lambda (a b) (< (cadr a) (cadr b)))))
 (setq ymin (cadar ptlst))
 (setq ymax (cadr (last ptlst)))
 (setq n (fix (sqrt (/ k 40.0))))
 (acet-ui-progress "Progress : " (+ (* n n) (* (+ n 1) (+ n 1))))
 (setq dx (/ (- xmax xmin) n))
 (setq dy (/ (- ymax ymin) n))
 (setq stwpt (list xmin ymin))
 (setq enwpt (list (+ xmin dx) (+ ymin dy)))
 (setq vecx (list dx 0.0)) 
 (setq vecy (list 0.0 dy)) 
 (setq triangles '())
 (setq stwptq (list (- xmin (/ dx 2.0)) (- ymin (/ dy 2.0))))
 (setq enwptq (list (+ xmin (/ dx 2.0)) (+ ymin (/ dy 2.0))))
 (setq i -1 ii -1)
 (repeat n
   (setq i (1+ i))
   (repeat n
     (setq ii (1+ ii))
     (setq stwptn (mapcar '+ (mapcar '+ (mapcar '* (list i i) vecy) (mapcar '* (list ii ii) vecx)) stwpt))
     (setq enwptn (mapcar '+ (mapcar '+ (mapcar '* (list i i) vecy) (mapcar '* (list ii ii) vecx)) enwpt))
     (setq ssw (ssget "_W" stwptn enwptn '((0 . "POINT"))))
     (if ssw (setq ssn (acet-ss-intersection ss ssw)) (setq ssn ssw))
     (repeat (setq z (if ssn (sslength ssn) 0))
       (setq pto (cdr (assoc 10 (entget (ssname ssn (setq z (1- z)))))))
       (setq ptolst (cons pto ptolst))
     )
     (if (eq ii (- n 1)) (setq ii -1))
     (setq triangles (append (if (and (> (length ptolst) 3) ptolst) (areatriangulate ptolst) nil) triangles))
     (setq ptolst nil)
     (acet-ui-progress -1)
   )
 )
 (setq i -1 ii -1)
 (repeat (+ n 1)
   (setq i (1+ i))
   (repeat (+ n 1)
     (setq ii (1+ ii))
     (setq stwptn (mapcar '+ (mapcar '+ (mapcar '* (list i i) vecy) (mapcar '* (list ii ii) vecx)) stwptq))
     (setq enwptn (mapcar '+ (mapcar '+ (mapcar '* (list i i) vecy) (mapcar '* (list ii ii) vecx)) enwptq))
     (setq ssw (ssget "_W" stwptn enwptn '((0 . "POINT"))))
     (if ssw (setq ssn (acet-ss-intersection ss ssw)) (setq ssn ssw))
     (repeat (setq z (if ssn (sslength ssn) 0))
       (setq pto (cdr (assoc 10 (entget (ssname ssn (setq z (1- z)))))))
       (setq ptolst (cons pto ptolst))
     )
     (if (eq ii n) (setq ii -1))
     (setq triangles (append (if (and (> (length ptolst) 3) ptolst) (areatriangulate ptolst) nil) triangles))
     (setq ptolst nil)
     (acet-ui-progress -1)
  )
 ) 
 (foreach triangle triangles
   (entmake (list (cons 0 "3DFACE")(cons 10 (car triangle))(cons 11 (cadr triangle))(cons 12 (caddr triangle))(cons 13 (caddr triangle))))
 )
 (acet-ui-progress-done)
 (princ)
)

It did this code on 2000 pts for ab 5min, and above posted didn't even finish for >15 min...

M.R.

Yes, for the next step AutoCurve it's needed to select 3DFACEs, and I've just figured how to do conversion...

(defun unique (lst)
 (if lst (cons (car lst) (unique (vl-remove (car lst) (cdr lst)))))
)
(defun c:3ptregs23dfaces ( / ss n reg sslin k lin ps pe ptlst)
 (setq ss (ssget '((0 . "REGION"))))
 (repeat (setq n (sslength ss))
   (setq reg (ssname ss (setq n (1- n))))
   (vl-cmdf "_.explode" reg "")
   (setq sslin (ssget "_P"))
   (repeat (setq k (sslength sslin))
     (setq lin (ssname sslin (setq k (1- k))))
     (setq ps (cdr (assoc 10 (entget lin))))
     (setq pe (cdr (assoc 11 (entget lin))))
     (setq ptlst (cons ps ptlst) ptlst (cons pe ptlst))
     (entdel lin)
   )
   (setq ptlst (unique ptlst))
   (entmake (list (cons 0 "3DFACE")(cons 10 (car ptlst))(cons 11 (cadr ptlst))(cons 12 (caddr ptlst))(cons 13 (caddr ptlst))))
   (setq ptlst nil)
 )
 (princ)
)

Sincerely, M.R.

Last codes for large number of points have been finally revised...

You can test them now...

Sincerely, M.R.

Main algorithm has been changed to improve performance... Changed only codes for large number of points, as some faces are skipped and some are surplus and therefore needed to be converted to regions, overkill and than back return them to 3dfaces...

Note : change of main algorithm is to improve performance as some faces are skipped so it's not totaly aceptable and therefore main code remained unchanged :

(defun averpttriang (triangle)
 (mapcar '(lambda (a b c) (/ (+ a b c) 3.0)) (car triangle) (cadr triangle) (caddr triangle))
)
(defun unique (lst)
 (if lst (cons (car lst) (unique (vl-remove (car lst) (cdr lst)))))
)
(defun uniquetriangles (triangles / lst assoctriangles uniquetriangs)
 (foreach triangle triangles
   (setq lst (cons (averpttriang triangle) lst))
 )
 (setq lst (unique lst))
 (foreach triangle triangles
   (setq assoctriangles (cons (cons (averpttriang triangle) triangle) assoctriangles))
 )
 (foreach averpt lst
   (setq uniquetriangs (cons (cdr (assoc averpt assoctriangles)) uniquetriangs))
 )
 uniquetriangs
)
(defun nearest (pt lst / d1 d2 p1 p2)
 (setq lst (vl-remove pt lst))
 (setq d1 (distance pt (car lst)) p1 (car lst))
 (foreach p2 (cdr lst)
   (if (> d1 (setq d2 (distance pt p2)))
     (setq d1 d2 p1 p2)
   )
 )
 p1
)
(defun mid (p1 p2)
 (mapcar '(lambda (a b) (/ (+ a b) 2.0)) p1 p2)
)
(defun circumtriang (p1 p2 p3 / pp1 pp2 pp3 mp1p2 mp2p3 npmp1p2 npmp2p3 cen rad)
 (setq pp1 (list (car p1) (cadr p1)))
 (setq pp2 (list (car p2) (cadr p2)))
 (setq pp3 (list (car p3) (cadr p3)))
 (setq mp1p2 (mid pp1 pp2))
 (setq mp2p3 (mid pp2 pp3))
 (setq npmp1p2 (polar mp1p2 (+ (angle pp1 pp2) (/ pi 2.0)) 1.0))
 (setq npmp2p3 (polar mp2p3 (+ (angle pp2 pp3) (/ pi 2.0)) 1.0))
 (setq cen (inters mp1p2 npmp1p2 mp2p3 npmp2p3 nil))
 (setq rad (distance cen p1))
 (list cen rad)
)
(defun ptinsidecir (pt circle)
 (setq pt (list (car pt) (cadr pt)))
 (> (cadr circle) (distance (car circle) pt))
)
(defun c:triangulate ( / ss n pt ptlst pttlst p1 p2 p3 p2lst p3lst loop2 loop3 k circle pp lst triangles)
 (setq ss (ssget '((0 . "POINT"))))
 (repeat (setq n (sslength ss))
   (setq pt (cdr (assoc 10 (entget (ssname ss (setq n (1- n)))))))
   (setq ptlst (cons pt ptlst))
 )
 (setq pttlst ptlst)
 (while (> (length ptlst) 2)
   (setq p1 (car ptlst))
   (setq p2lst (cdr ptlst))
   (setq loop2 T)
   (while loop2
     (setq p2 (car p2lst))
     (setq p2lst (cdr p2lst))
     (setq p3lst (vl-remove p2 (cdr ptlst)))
     (setq k 0)
     (setq loop3 T)
     (while loop3
       (setq p3 (car p3lst))
       (setq p3lst (cdr p3lst))
       (setq circle (circumtriang p1 p2 p3))
       (setq pp (nearest (car circle) (vl-remove p1 (vl-remove p2 (vl-remove p3 pttlst)))))
       (if (not (ptinsidecir pp circle))
         (progn
           (setq lst (cons p1 lst) lst (cons p2 lst) lst (cons p3 lst))
           (setq triangles (cons lst triangles))
           (setq k (1+ k))
         )
       )
       (setq lst nil)
       (if (equal p1 (car ptlst) 1e- (setq ptlst (cdr ptlst)))
       (if (or (eq p3lst nil) (eq k 2)) (setq loop3 nil))
       (if (or (= (length ptlst) 2) (eq p2lst nil)) (setq loop2 nil))
     )
   )
 )
 (foreach triangle (uniquetriangles triangles)
   (entmake (list (cons 0 "3DFACE")(cons 10 (car triangle))(cons 11 (cadr triangle))(cons 12 (caddr triangle))(cons 13 (caddr triangle))))
 )
 (princ)
)

And faster code, but may skip some faces around boundary points - (revision 17.04.2012. (shouldn't skip any face)):

(defun averpttriang (triangle)
 (mapcar '(lambda (a b c) (/ (+ a b c) 3.0)) (car triangle) (cadr triangle) (caddr triangle))
)

(defun unique (lst)
 (if lst (cons (car lst) (unique (vl-remove (car lst) (cdr lst)))))
)

(defun uniquetriangles (triangles / lst assoctriangles uniquetriangs)
 (foreach triangle triangles
   (setq lst (cons (averpttriang triangle) lst))
 )
 (setq lst (unique lst))
 (foreach triangle triangles
   (setq assoctriangles (cons (cons (averpttriang triangle) triangle) assoctriangles))
 )
 (foreach averpt lst
   (setq uniquetriangs (cons (cdr (assoc averpt assoctriangles)) uniquetriangs))
 )
 uniquetriangs
)

(defun flatten (lst / lstn)
 (foreach triangle (reverse lst)
   (setq lstn (cons (caddr triangle) lstn) lstn (cons (cadr triangle) lstn) lstn (cons (car triangle) lstn))
 )
 (reverse lstn)
)

(defun nearest (pt lst / d1 d2 p1 p2)
 (setq lst (vl-remove pt lst))
 (setq d1 (distance pt (car lst)) p1 (car lst))
 (foreach p2 (cdr lst)
   (if (> d1 (setq d2 (distance pt p2)))
     (setq d1 d2 p1 p2)
   )
 )
 p1
)

(defun mid (p1 p2)
 (mapcar '(lambda (a b) (/ (+ a b) 2.0)) p1 p2)
)

(defun circumtriang (p1 p2 p3 / pp1 pp2 pp3 mp1p2 mp2p3 npmp1p2 npmp2p3 cen rad)
 (setq pp1 (list (car p1) (cadr p1)))
 (setq pp2 (list (car p2) (cadr p2)))
 (setq pp3 (list (car p3) (cadr p3)))
 (setq mp1p2 (mid pp1 pp2))
 (setq mp2p3 (mid pp2 pp3))
 (setq npmp1p2 (polar mp1p2 (+ (angle pp1 pp2) (/ pi 2.0)) 1.0))
 (setq npmp2p3 (polar mp2p3 (+ (angle pp2 pp3) (/ pi 2.0)) 1.0))
 (setq cen (inters mp1p2 npmp1p2 mp2p3 npmp2p3 nil))
 (setq rad (distance cen p1))
 (list cen rad)
)

(defun ptinsidecir (pt circle)
 (setq pt (list (car pt) (cadr pt)))
 (> (cadr circle) (distance (car circle) pt))
)

(defun c:triangulate ( / ss n pt ptlst pttlst p1 p2 p3 p2lstt p2lst p3lst loop2 loop3 k circle pp lst triangles)
 (setq ss (ssget '((0 . "POINT"))))
 (repeat (setq n (sslength ss))
   (setq pt (cdr (assoc 10 (entget (ssname ss (setq n (1- n)))))))
   (setq ptlst (cons pt ptlst))
 )
 (setq ptlst (vl-sort ptlst '(lambda (a b) (< (car a) (car b)))))
 (setq pttlst ptlst)
 (acet-ui-progress "Progress : " n)
 (while (> (length ptlst) 2)
   (setq p1 (car ptlst))
   (setq p2lst (cdr ptlst))
   (setq p2lstt p2lst)
   (setq loop2 T)
   (while loop2
     (setq p2 (car p2lst))
     (setq p2lst (cdr p2lst))
     (setq p3lst (vl-remove p2 p2lstt))
     (setq k 0)
     (setq loop3 T)
     (while loop3
       (setq p3 (car p3lst))
       (setq p3lst (cdr p3lst))
       (setq circle (circumtriang p1 p2 p3))
       (setq pp (nearest (car circle) (vl-remove p1 (vl-remove p2 (vl-remove p3 pttlst)))))
       (if (not (ptinsidecir pp circle))
         (progn
           (setq lst (cons p1 lst) lst (cons p2 lst) lst (cons p3 lst))
           (setq triangles (cons lst triangles))
           (setq k (1+ k))
         )
       )
       (setq lst nil)
       (if (equal p1 (car ptlst) 1e- (setq ptlst (cdr ptlst)))
       (if (eq k 2) (setq loop3 nil p2lst (vl-remove p3 p2lst) p2lst (cons p3 p2lst)))
       (if (and (eq k 2) (member p3 (flatten (cdr triangles)))) (setq loop2 nil))
       (if (eq p3lst nil) (setq loop3 nil))
       (if (or (= (length ptlst) 2) (eq p2lst nil)) (setq loop2 nil))
     )
   )
   (acet-ui-progress -1)
 )
 (foreach triangle (uniquetriangles triangles)
   (entmake (list (cons 0 "3DFACE")(cons 10 (car triangle))(cons 11 (cadr triangle))(cons 12 (caddr triangle))(cons 13 (caddr triangle))))
 )
 (acet-ui-progress-done)
 (princ)
)

M.R.