(defun c:vor
(/ i s pl doc
)
)
pl nil
s
(ssget '
((0 .
"POINT"))) )
)
)
; Sorting of point list moved here so contour can use it.
(triangulate pl)
); end progn
); end if
)
;;************************************************************************************************;
;; Triangulate ;
;; 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 July 2013. ;
;;************************************************************************************************;
(defun triangulate
( pl
/ a al b c cp i i1 i2 l
n p r ti tr
xmax xmin ymax ymin
)
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
ctr
(list cp
) ;added for Voronoi 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. )
ctr
(cons (cadr tr
) ctr
); added for voronoi )
)
;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 (length al)
(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 Progress Spinner
"MODEMACRO"
" "
" % "
"||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||"
1
i2
)
)
)
)
)
) ;End repeat np
;We are done with points insertion. Any triangle left in al is added to tl ;
ctr
(cons (cadr tr
) ctr
) ; Added for Voronoi )
)
; Extract all triangle edges from tl and form edges list el
)
)
; Here let's draw the Voronoi Diagram ;
)
)
)
)
)
vor
(cdddr vor
) ; Remove the edges of Supercircle ; )
; Creates Layer for Voronoi Diagram
'(0 . "LAYER")
'(100 . "AcDbSymbolTableRecord")
'(100 . "AcDbLayerTableRecord")
'(2 . "Voronoi")
'(70 . 0)
'(62 . 10)
'(6 . "Continuous")
'(290 . 1)
'(370 . -3)
)
)
)
)
)
; 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)
)
)
)
)
)
)
)
)
)
)
)
;;************************************************************************************************;
;; ;
;; 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 pl
/ b c c2 cp r ang vl p
)
)
)
)
(+ -1.570796326794896 (angle c p
) ang
) )
)
)
)
)
; Midpoint of two points
)
; Generate a bunch of points for testing on layer named points.
; This function change Autocad vars PDMODE to 34 and PDSIZE to -1.5
(
defun c:gen
( / n rangex rangey rangez
)
rangex 5000 ; Extent in X for the points
rangey (/ rangex 1.6); Extent in Y * Golden Ratio
rangez 20 ; Extent in Z
)
'(0 . "POINT")
'(8 . "Points")
(cons 10 (list (* rangex
(ran
)) (* rangey
(ran
)) (* rangez
(ran
)))) )
)
)
(setvar "PDMODE" 34) ; You will need to set it back to your preference manually. (setvar "PDSIZE" -1.5) ; 1.5 Percent relative to screen. )
; Random number generator
(setq seed
(if seed
(rem (+ (* seed
15625.7) 0.21137152) 1) 0.3171943)) )
