pl nil
s
(ssget '
((0 .
"POINT"))) )
)
)
(triangulate pl)
)
)
)
;;*****************************************************************************;
;; ;
;; Structure of Program by ElpanovEvgeniy ;
;; 17.10.2008 ;
;; edit 20.05.2011 ;
;; Program triangulate an irregular set of 3d points. ;
;; Modified and Commented by ymg June 2011. ;
;; Modified to operate on index by ymg in June 2013. ;
;; Contour Generation added by ymg in June 2013. ;
;;*****************************************************************************;
(defun triangulate
(pl
/ a b c i i1 i2 xmin ymin zmin
bb sl pl el l zm z1 z2 xmax ymax zmax
ti tr np n j r cp sl pl al intv
p tl vc pc e cl xl pol ent nxt
)
i 1
i2 0
; Variables and Constant to Control Progress Spinner ;
tl nil
)
; Sort points list on x coordinates ;
)
;Replaced code to get the min and max with 3d Bounding Box Routine ;
;A bit slower but clearer. zmin and zmax kept for contouring ;
np
(length pl
) ;Number of points to insert ;
cp
(list (/ (+ xmin xmax
) 2.0) (/ (+ ymin ymax
) 2.0)) ; Midpoint of points cloud and center point of circumcircle through supertriangle. ;
; This could still be too small in certain case. No harm if we make it bigger. ;
)
; sl list of 3 points defining the Supertriangle, ;
; I have tried initializing to an infinite triangle but it slows down calculation ;
;Vertex of Supertriangle are appended to the Point list ;
sl
(list np
(+ np
1)(+ np
2)) ;sl now is a list of index into point list defining the supertriangle ;
;Initialize the Active Triangle list ;
; al is a list that contains active triangles defined by 4 items: ;
; 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 indexes to vertices defining the triangle ;
n -1
; n is a counting index into Point List ;
)
;Begin insertion of points
(setq n
(1+ n
) ; Increment Index into Point List ; p
(nth n pl
) ; Get one point from point list ; el nil ; el list of triangles edges ;
) ; ;
(repeat (length al
) ; Loop to go through Active triangle list ; (setq tr
(car al
); Get one triangle from active triangle list. ; al
(cdr al
); Remove the triangle from the active list. ; )
;This triangle inactive. We store it's 3 vertex in tl (Final triangle list). ;
(setq tr
(cadddr tr
) ; Trim tr to vertex of triangle only. ; a
(car tr
) ; Index of First point. ; b
(cadr tr
) ; Index of Second point. ; c
(caddr tr
) ; Index of Third point. ; el
(cons (list a
; ((a b)(b c)(c a) (. .)(. .).....) ; b
)
c
)
a
)
el
)
)
)
)
)
;tr did not meet any cond so it remain active. We store it in the swap list ;
);End cond
);End repeat, go to next triangle of active list.
(setq al l
;Restore active triangle list from the temporary list. ; l nil ;Clear the swap list to prepare for next insertion. ;
)
;Removes doubled edges, calculates circumcircles and add them to al ;
)
)
)
)
)
; Neat Spinner to show progress does not work too good with Window7 ;
"MODEMACRO"
" "
" % "
"||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||"
1
i2
)
)
)
)
)
) ;End repeat np, Go to insert next point
;We are done with points insertion. Any triangle left in al is added to tl ;
;Purge triangle list of any triangle that has a common vertex with supertriangle. ;
)
)
tl
)
)
;Create a layer and Draw the triangulation ;
'(0 . "LAYER")
'(100 . "AcDbSymbolTableRecord")
'(100 . "AcDbLayerTableRecord")
'(2 . "TIN")
'(70 . 0)
'(62 . 8)
'(6 . "Continuous")
'(290 . 1)
'(370 . -3)
)
)
)
)
)
)
)
)
; 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, first locating an edge with no neighbour if any and follow from edge ;
; to edge until either we've closed the polyline or reached the convex hull. ;
; As we complete each polyline list xl is formed. ;
; 5. We entmake each element of list xl thus completing. ;
; 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 ;
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 ;
)
; Extract all triangle edges from tl and form list 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 ;
)
z1
(caddr (nth (car e
) pl
)) ; Get elevation of edges from the point list. ; )
(if (and (= (rem j
3) 0) (< zm
(+ l intv
))) ; Reduce size of el on zmax criteria. ; 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. ;
;;Find in cl an edge that has no reverse hence on the convex hull and start from it ;
;;if none is found we start with the last edge in cl ;
)
vc (+ 2 vc)
)
)
);end while
);end while cl
)
)
ent
(cons (cons 100 "AcDbPolyline") ent
)
)
);end foreach p
);end repeat
);end defun triangulate
;;*****************************************************************************;
;; ;
;; 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) ;
;; Modified ymg June 2013 to operate on Index ;
;;*****************************************************************************;
(defun getcircumcircle
(a el
/ b c c2 cp r ang vl
)
)
)
)
(+ -1.570796326794896 (angle c p
) ang
) )
)
)
)
)
;Generate a bunch of points for testing on layer named points. ;
'(0 . "POINT")
'(8 . "Points")
(cons 10 (list (* 1000 (ran
)) (* 750 (ran
)) (* 10 (ran
)))) )
)
)
)
; Random number generator ;
(setq seed
(if seed
(rem (+ (* seed
15625.7) 0.21137152) 1) 0.3171943)) )
