Once, long time ago my friend from faculty of architecture, now my colegue, asked me to construct snub dodecahedron, so I did it with help of math forums where I found radius of cicumscribed sphere...
Now I discovered more precise way with help of Lee Mac's subfunctions that work perfect. So I thought I could share this my discovery...
To obtain main angle of rotation of edge triangle I used this routine :
;;----------------=={ 3D Rotate by Matrix }==-----------------;;
;; ;;
;; Rotates a VLA-Object or Point List about a 3D axis using ;;
;; a Transformation matrix. ;;
;;------------------------------------------------------------;;
;; Author: Lee Mac, Copyright © 2011 - www.lee-mac.com ;;
;;------------------------------------------------------------;;
;; Arguments: ;;
;; target - VLA-Object or Point List to Rotate ;;
;; p1,p2 - Two 3D points defining the axis of rotation ;;
;; ang - Rotation Angle ;;
;;------------------------------------------------------------;;
(defun LM:Rotate3D ( target p1 p2 ang / ux uy uz )
(mapcar 'set '(ux uy uz) (setq u (unit (mapcar '- p2 p1))))
(LM:ApplyMatrixTransformation target
(setq m
(m+m
(list
(list (cos ang) 0. 0.)
(list 0. (cos ang) 0.)
(list 0. 0. (cos ang))
)
(m+m
(mxs
(list
(list 0. (- uz) uy)
(list uz 0. (- ux))
(list (- uy) ux 0.)
)
(sin ang)
)
(mxs (mapcar '(lambda ( e ) (vxs u e)) u) (- 1. (cos ang)))
)
)
)
(mapcar '- p1 (mxv m p1))
)
)
;;----------------=={ 3D Reflect by Matrix }==----------------;;
;; ;;
;; Reflects a VLA-Object or Point List in a plane using a ;;
;; Transformation matrix. ;;
;;------------------------------------------------------------;;
;; Author: Lee Mac, Copyright © 2011 - www.lee-mac.com ;;
;;------------------------------------------------------------;;
;; Arguments: ;;
;; target - VLA-Object or Point List to Reflect ;;
;; p1,p2,p3 - Three 3D points defining the reflection plane ;;
;;------------------------------------------------------------;;
(defun LM:Reflect3D ( target p1 p2 p3 / m u ux uy uz )
(mapcar 'set '(ux uy uz) (setq u (unit (v^v (mapcar '- p2 p1) (mapcar '- p3 p1)))))
(LM:ApplyMatrixTransformation target
(setq m
(list
(list (- 1. (* 2. ux ux)) (* -2. uy ux) (* -2. ux uz))
(list (* -2. ux uy) (- 1. (* 2. uy uy)) (* -2. uy uz))
(list (* -2. ux uz) (* -2. uy uz) (- 1. (* 2. uz uz)))
)
)
(mapcar '- p1 (mxv m p1))
)
)
;;-----------=={ Apply Matrix Transformation }==--------------;;
;; ;;
;; Transforms a VLA-Object or Point List using a ;;
;; Transformation Matrix ;;
;;------------------------------------------------------------;;
;; Author: Lee Mac, Copyright © 2010 - www.lee-mac.com ;;
;;------------------------------------------------------------;;
;; Arguments: ;;
;; target - VLA-Object or Point List to Transform ;;
;; matrix - 3x3 Matrix by which to Transform object ;;
;; vector - 3D translation vector ;;
;;------------------------------------------------------------;;
(defun LM:ApplyMatrixTransformation ( target matrix vector ) (vl-load-com)
(cond
( (eq 'VLA-OBJECT (type target))
(vla-TransformBy target
(vlax-tMatrix
(append (mapcar '(lambda ( x v ) (append x (list v))) matrix vector)
'((0. 0. 0. 1.))
)
)
)
)
( (listp target)
(mapcar
(function
(lambda ( point ) (mapcar '+ (mxv matrix point) vector))
)
target
)
)
)
)
;; Matrix x Vector - Vladimir Nesterovsky
;; Args: m - nxn matrix, v - vector in R^n
(defun mxv ( m v )
(mapcar '(lambda ( r ) (apply '+ (mapcar '* r v))) m)
)
;; Matrix x Scalar - Lee Mac
;; Args: m - nxn matrix, n - real scalar
(defun mxs ( m s )
(mapcar '(lambda ( r ) (mapcar '(lambda ( n ) (* n s)) r)) m)
)
;; Matrix + Matrix - Lee Mac
;; Args: m,n - nxn matrices
(defun m+m ( m n )
(mapcar '(lambda ( r s ) (mapcar '+ r s)) m n)
)
;; Vector Norm - Lee Mac
;; Args: v - vector in R^n
(defun norm ( v )
(sqrt (apply '+ (mapcar '* v v)))
)
;; Vector x Scalar - Lee Mac
;; Args: v - vector in R^n, s - real scalar
(defun vxs ( v s )
(mapcar '(lambda ( n ) (* n s)) v)
)
;; Unit Vector - Lee Mac
;; Args: v - vector in R^n
(defun unit ( v )
( (lambda ( n ) (if (equal 0.0 n 1e-14) nil (vxs v (/ 1.0 n)))) (norm v))
)
;; Vector Cross Product - Lee Mac
;; Args: u,v - vectors in R^3
(defun v^v ( u v )
(list
(- (* (cadr u) (caddr v)) (* (cadr v) (caddr u)))
(- (* (car v) (caddr u)) (* (car u) (caddr v)))
(- (* (car u) (cadr v)) (* (car v) (cadr u)))
)
)
(defun mid ( a b )
(mapcar '(lambda (x y) (/ (+ x y) 2.0)) a b)
)
(defun dtr ( ad )
(* (/ PI 180.0) ad)
)
;; Coplanar-p - Lee Mac
;; Returns T if points p1,p2,p3,p4 are coplanar
(defun LM:Coplanar-p ( p1 p2 p3 p4 )
(
(lambda ( n )
(equal
(last (trans p3 0 n))
(last (trans p4 0 n))
1e-9
)
)
(v^v (mapcar '- p1 p2) (mapcar '- p1 p3))
)
)
(defun snubcal ( pt1 pt2 pt3 cen cenn incr stan / ar pt3r ptt pttn o pp )
(setq ar stan)
(setq pp pt3)
(while (eq (LM:Coplanar-p cen cenn pt2 pp) nil)
(setq ar (+ ar incr))
(setq pt3r (car (LM:Rotate3D (list pt3) pt1 pt2 ar)))
(setq ptt (inters pt3r (mid pt1 pt2) pt2 (mid pt1 pt3r) nil))
(setq pttn (mapcar '+ ptt (v^v (mapcar '- pt3r pt1) (mapcar '- pt3r pt2))))
(setq o (inters ptt pttn cen cenn nil))
(setq pp (car (LM:Reflect3D (list pt1) pt2 o pt3r)))
)
pp
; ar
)
(defun c:snub ( / pt1 pt2 pt3 cen cenn incr stan )
(vl-cmdf "_.UCS" "w")
(setq pt1 (getpoint "\nPick first point of edge triangle in WCS plane - start point of axis trans definition"))
(setq pt2 (getpoint "\nPick second point of edge triangle in WCS plane - end point of axis trans definition"))
(setq pt3 (getpoint "\nPick third point of edge triangle in WCS plane - transform point"))
(setq cen (getpoint "\nPick center point of 5 sided polygon : "))
(setq cenn (mapcar '+ cen '(0.0 0.0 1.0)))
(initget 6)
(setq stan (getreal "\nInput start angle for continuing calculation <0.472462019882673 radians - ENTER> : "))
(if (null stan) (setq stan 0.472462019882673))
(initget 6)
(setq incr (getreal "\nInput angle increment in decimal degrees <1e-16 radians - ENTER> : "))
(if (null incr) (setq incr 1e-16))
(princ
(strcat
(rtos (car (snubcal pt1 pt2 pt3 cen cenn incr stan)) 2 10)
" , "
(rtos (cadr (snubcal pt1 pt2 pt3 cen cenn incr stan)) 2 10)
" , "
(rtos (caddr (snubcal pt1 pt2 pt3 cen cenn incr stan)) 2 10)
)
)
; (princ (rtos (snubcal pt1 pt2 pt3 cen cenn incr stan) 2 30))
(princ)
)
In addition I will attach *.dwg with marked points for checking with this my code...
To see my old construction, watch :
http://www.youtube.com/watch?v=QIZTaaLPtycRegards, M.R.
Thanks, Lee Mac...
