So, inspired with these topics :
http://www.theswamp.org/index.php?topic=45085.0and
http://www.theswamp.org/index.php?topic=44259.0I tried to construct something of both codes combined...
I had no luck in getting desired results, as on www there is some pictures showing correct results... I have trouble in connecting projected circumcenters of triangles that are around making outer faces envelope (SPHERE-TIN) - projected on sphere and can't whatever I think make correct condition of how to make these connections... After studying Voronoi diagram and observing triangles in 3D space I came to conclusion that this condition is as opposite in plane (checking circle-circle intersections) in 3D is checking sphere-sphere intersections - so my (if (< (distance o1 o2) (+ r1 r2)) ... ) should work, but when executing routine something is wrong, not to mention that I firstly wanted to connect these projected circumcenters with arcs, but then I abandoned this as something again wasn't correct either with arbitary axis orientation or and something with calculating correct arcs start-end angles-parameters (dxf 50, dxf 51)... It would be nice if connection with arcs would work, but even with simple point-point connection with straight lines doesn't satisfy...
So if you see something I haven't and you wish to help, you're very welcome...
I'll attach 36 RND points cloud with center of sphere at point (50.0 50.0 50.0), so you can do tests...
(defun c:voronoi
-sphere
( / unit mxv v
^v transptucs transptwcs _reml AssocOn mid otr acos angle3d checkpts
pt1l pt2l ss n pt ptlst nor x tr oo ol rl orl osph o1l r r1 r2 in o1 o2 oo1 oo2 tmp uz ux uy pux a1 a2 ce )
'(0 . "LAYER")
'(100 . "AcDbSymbolTableRecord")
'(100 . "AcDbLayerTableRecord")
'(2 . "SPHERE-TIN")
'(70 . 0)
'(62 . 8)
'(6 . "Continuous")
'(290 . 1)
'(370 . -3)
)
)
)
(setvar "CLAYER" "SPHERE-TIN")
)
)
)
(defun transptucs
( pt p1 p2 p3
/ ux uy uz
)
)
(defun transptwcs
( pt pt1 pt2 pt3
/ pt1n pt2n pt3n
) (setq pt1n
(transptucs '
(0.0 0.0 0.0) pt1 pt2 pt3
)) (setq pt2n
(transptucs '
(1.0 0.0 0.0) pt1 pt2 pt3
)) (setq pt3n
(transptucs '
(0.0 1.0 0.0) pt1 pt2 pt3
)) (transptucs pt pt1n pt2n pt3n)
)
(defun _reml
(l1 l2
/ a n ls
) )
n t
)
)
)
)
)
)
(defun AssocOn
( SearchTerm Lst func fuzz
) )
lst
)
)
)
)
(defun otr
( tr
/ p1 p2 p3 p12 p23 p31 z o
) )
p23 (mid p2 p3)
p31 (mid p3 p1)
)
o
)
((equal x
0.0 1e
-8
) (/ pi
2.0)) ((equal x
-0.0 1e
-8
) (* 3.0 (/ pi
2.0))) )
)
(defun angle3d
( p1 por p2
/ vec1 vec2 dd ang
) vec2
(unit
(mapcar '
- p2 por
)) ang
(acos
(- 1.0 (/ (expt dd
2) 2.0))) )
)
(defun checkpts
( ptlst pt1 x nor
/ y
) (checkpts
(cdr ptlst
) pt1 x nor
) )
((< y -1e-8)
(checkpts
(cdr ptlst
) pt1 x nor
) )
(checkpts
(cdr ptlst
) pt1 x nor
) )
)
oneside
)
)
)
(foreach pt3
(_reml
(_reml ptlst pt1l
) pt2l
) )
)
)
(setq signs
nil oneside
nil) )
)
)
'(0 . "LAYER")
'(100 . "AcDbSymbolTableRecord")
'(100 . "AcDbLayerTableRecord")
'(2 . "SPHERE-Voronoi")
'(70 . 0)
'(62 . 10)
'(6 . "Continuous")
'(290 . 1)
'(370 . -3)
)
)
)
(setvar "CLAYER" "SPHERE-Voronoi")
nil
)
oo nil
)
;| (if (minusp (- (* (car o1) (cadr o2)) (* (cadr o1) (car o2)))) (setq tmp oo1 oo1 oo2 oo2 tmp))
(setq uz (unit (v^v o1 o2)))
(if (equal uz '(0.0 0.0 1.0) 1e-8) (setq ux '(1.0 0.0 0.0) uy '(0.0 1.0 0.0)))
(if (equal uz '(0.0 0.0 -1.0) 1e-8) (setq ux '(-1.0 0.0 0.0) uy '(0.0 -1.0 0.0)))
(if (not (or (equal uz '(0.0 0.0 1.0) 1e-8) (equal uz '(0.0 0.0 -1.0) 1e-8))) (setq ux (unit (v^v '(0.0 0.0 1.0) uz))))
(if (not uy) (setq uy (unit (v^v uz ux))))
(setq ce (trans osph 0 uz))
(setq pux (mapcar '+ osph ux))
(setq a1 (angle3d pux osph oo1) a2 (angle3d pux osph oo2))
(if (> a1 a2) (setq tmp a1 a1 a2 a2 tmp))
(entmake (list '(0 . "ARC") '(100 . "AcDbEntity") '(100 . "AcDbCircle") (cons 10 ce) (cons 40 r) (cons 210 uz) '(100 . "AcDbArc") (cons 50 a1) (cons 51 a2)))
|;
)
)
)
)
)
Thanks in advance, M.R.
