;;****************************************************************************;
;; sloan by ymg ;
;; Delaunay's Triangulation as per S.W. Sloan's papers, ;
;; A Fast Algorithm For Constructing Delaunay Triangulations In The Plane. ;
;; A Fast Algorithm For Generating Constrained Delaunay Triangulations. ;
;; ;
;; ;
;;****************************************************************************;
(setq tl
nil nl
nil tn
nil) )
dmax
(max (- xmax xmin
)(- ymax ymin
)) ; Points are Scaled to 1 along Max of x and y dimensions ;
(/ (- (cadr a
) ymin
) dmax
) )
)
)
pl
)
np
(length pl
) ; Number of Pts ;
;Vertex of Supertriangle are appended to the Point list ;
pl
(append pl
(list '
(-100.
-100.
0.
)'
(100.
-100.
0.
)'
(0.
100.
0.
)))
tl
(list (list np
(1+ np
)(+ np
2))) ; Init. Triangle list. ; nl
(list (list nil nil nil)) ; Init. Neighbour list. ; stk nil ; Init. Swapping Stack. ;
nt 0 ; Init. Triangles Index.;
n -1 ; Init. Point Index. ;
)
;Begin Insertion of Points ;
(acet-ui-progress "Points Insertion:" np)
tn (triloc p pl tl nl) ; Index of Triangle containing p. ;
tc
(nth tn tl
) ntc
(nth tn nl
) t1
(list n v1 v2
) nt1
(list (+ nt
2) a
(+ nt
1)) t2
(list n v2 v3
) nt2
(list tn b
(+ nt
1)) t3
(list n v3 v1
) nt3
(list (- nt
1) c tn
)
tl
(subst t1 tc tl
) ; Updates Current Triangles; nl
(subst nt1 ntc nl
) ; Updates Its Neighbours ;
tl
(append tl
(list t2 t3
)) ; Creates 2 New Triangles ; nl
(append nl
(list nt2 nt3
)) ; Creates 2 New Neighbours ; )
)
)
)
)
)
)
)
)
)
)
)
)
)
)
)
)
)
)
(acet-ui-progress -1)
) ;We are done with points insertion. ;
(acet-ui-progress)
;Purge Triangle list of any triangle that has a common vertex with supertriangle.
)
tl
)
)
;; Here we will replace call to get neighour wit adjustment to nl
(setq nl
(getneighbour tl
))
; Re-Scale the point list ;
(+ (* (cadr a
) dmax
) ymin
) )
)
)
pl
)
)
;Create a layer and Draw the triangulation ;
(mk_layer
(list "TIN" 8)) (acet
-ui
-progress
"Drawing 3DFaces:" (length tl
)) (setq 3df '
(0 .
"3DFACE")) )
)
(acet-ui-progress -1)
)
(acet-ui-progress)
)
)
)
;;****************************************************************************;
;; (swap l r pl) ;
;; Cline & Renka Swap Test ;
;; ;
;; Given a triangle defined by three points indices v1, v2, v3 ;
;; and an index to pointp , ;
;; Returns T is p is inside circle circumscribing triangle v1 v2 v3. ;
;; ;
;;****************************************************************************;
(defun swap
(v1 v2 v3 p pl
/ cosa cosb sina sinb v1 v2 v3
x1 x13 x1p x2 x23 x2p x3 xp
y1 y13 y1p y2 y23 y2p y3 yp)
x13 (- x1 x3) y13 (- y1 y3)
x23 (- x2 x3) y23 (- y2 y3)
x1p (- x1 xp) y1p (- y1 yp)
x2p (- x2 xp) y2p (- y2 yp)
cosa (+ (* x13 x23) (* y13 y23))
cosb (+ (* x1p x2p) (* y1p y2p))
)
(t
(setq sina
(- (* x13 y23
) (* x23 y13
)) sinb (- (* x2p y1p) (* x1p y2p))
)
(minusp (+ (* sina cosb
)(* sinb cosa
))) )
)
)
;;****************************************************************************;
;; (edgrpl l k r e) ;
;; ;
;; Find edge in Triangle l which is adjacent to triangle K ;
;; ;
;; Input: l Index of triangle ;
;; r Index of triangle r in neighbour list ;
;; v Replacement value ;
;; e Neighbour List ;
;; ;
;;****************************************************************************;
(defun edgrpl
(l r v e
/ ln tr
) )
)
;;****************************************************************************;
;; (triloc p) ;
;; ;
;; Locates triangle which encloses point p using Lawson's Walk. ;
;; ;
;; Given p a point, Returns Index in tl of triangle containing the point. ;
;; If outside the triangulation Return is nil. ;
;; ;
;; Point List pl and Neigbour List nl are defined outside this routine. ;
;; by ymg August 2013 ;
;; Optimized Speed and re-organized code January 2014 ;
;; Nice but get lost when triangulation is disjointed. ;
;;****************************************************************************;
(defun triloc
(p pl tl nl
/ notfound i p1 p2 p3 x x1 x2 x3 y y1 y2 y3
)
x1x
(- (car p1
) x
) y1y
(- (cadr p1
) y
) x2x
(- (car p2
) x
) y2y
(- (cadr p2
) y
) x3x
(- (car p3
) x
) y3y
(- (cadr p3
) y
) )
)
)
tn
)
