本帖最后由 chlh_jd 于 2012-1-26 21:59 编辑
集大成啊!
获取当前UCS矩阵参数我一直用楼主的版本简化版
- (defun ss-getucsarg (/ f x y z o m)
- (if (= (getvar "WORLDUCS") 0)
- (setq f T
- x (getvar "UCSXDIR")
- y (getvar "UCSYDIR")
- z (v^v x y)
- o (getvar "UCSORG")
- m (append
- (mapcar (function (lambda (x y)
- (append x (list y))
- )
- )
- (list x y z)
- o
- )
- (list (list 0. 0. 0. 1.))
- )
- )
- (setq f nil)
- )
- (list f m)
- )
获取变换矩阵,法国的gile是这样写的,大致和狂刀前辈的简化版相近
- (defun gc:TMatrixFromTo (from to)
- (append
- (mapcar
- (function
- (lambda (v o)
- (append (trans v from to T) (list o))
- )
- )
- (quote ((1. 0. 0.) (0. 1. 0.) (0. 0. 1.)))
- (trans (list 0. 0. 0.) to from)
- )
- (list (list 0. 0. 0. 1.))
- )
- )
- ;;(gc:TMatrixFromTo 0 1)或(gc:TMatrixFromTo 1 0)
gile的旋转矩阵
- ;; gc:2dRotationMatrix
- ;; Returns the 4x4 transformation matrix for a rotation about the Z axis
- ;;
- ;; Arguments
- ;; base: the base point
- ;; ang: the angle in radians
- (defun gc:2dRotationMatrix (base ang / mat)
- (append
- (mapcar
- (function
- (lambda (v1 v2)
- (append v1 (list v2))
- )
- )
- (setq mat (list (list (cos ang) (- (sin ang)) 0)
- (list (sin ang) (cos ang) 0)
- (list 0. 0. 1.)
- )
- )
- (mapcar '- base (mxv mat base))
- )
- (list (list 0. 0. 0. 1.))
- )
- )
- ;; gc:3dRotationMatrix
- ;; Returns the 3d rotation matrix
- ;;
- ;; Arguments
- ;; org: the rotation base point
- ;; axis: the rotation axis vector
- ;; ang: the angle rotation (radians)
- (defun gc:3dRotationMatrix (org axis ang)
- (mxm
- (gc:TMatrixFromTo 0 axis)
- (mxm
- (gc:2dRotationMatrix (trans org 0 axis) ang)
- (gc:TMatrixFromTo axis 0)
- )
- )
- )
配套函数
- (defun mxv(m v)(mapcar(function(lambda (r)(vxv r v)))m))
- ;;
- (defun vxv (v1 v2)
- (apply (function +)(mapcar(function *) v1 v2)))
- ;;
- (defun v^v (v1 v2)
- (list (- (* (cadr v1) (caddr v2)) (* (caddr v1) (cadr v2)))
- (- (* (caddr v1) (car v2)) (* (car v1) (caddr v2)))
- (- (* (car v1) (cadr v2)) (* (cadr v1) (car v2)))
- )
- )
|