Lee Mac check :
Command: TRANSCHECK
((0.423113 0.0753338 0.446731 2.0) (0.901122 -0.0864765 -0.198788 5.0)
(0.0946252 0.486669 -0.104474 8.0) (0.0 0.0 0.0 1.0))
((0.423113 0.901122 0.0946252 -6.10884) (0.301335 -0.345906 1.94668 -14.4465)
(1.78692 -0.79515 -0.417897 3.74508) (0.0 0.0 0.0 1.0))
MxM = ((1.0 -1.11022e-016 -5.55112e-017 2.22045e-016) (0.0 1.0 1.38778e-017
-8.88178e-016) (0.0 4.16334e-017 1.0 0.0) (0.0 0.0 0.0 1.0))
M.R. check :
Transformation matrix applied to selected object :
((0.423113 0.0753338 0.446731 2.0) (0.901122 -0.0864765 -0.198788 5.0)
(0.0946252 0.486669 -0.104474 8.0) (0.0 0.0 0.0 1.0))
Select block for transformation
Inverse transformation matrix applied to selected object :
((0.423113 1.80224 0.18925 -6.10884) (0.150668 -0.345906 1.94668 -7.22327)
(0.893462 -0.79515 -0.417897 1.87254) (0.0 0.0 0.0 1.0))
MxM = ((0.589512 0.381277 0.0400372 -0.292365) (0.190638 1.81202 0.0852689
-0.252406) (0.0200186 0.0852689 1.00895 3.71097) (0.0 0.0 0.0 1.0))
Although it seems that Lee's & Gile's code give correct result, this is only pure mathematically... My check doesn't give results through checking via (mxm) by Vladimir Nesterovsky correctly, but geometrically speaking my inverse matrix is correct inversion of given non-uniform scaled matrix...
Look into matrix vectors, and compare them :
- Lee's matix vectors (X (0.423113,0.301335,1.78692); Y (0.901122,-0.345906,-0.79515); Z (0.0946252,1.94668,-0.417897)) give unothogonal solution so this matrix is untransformable...
- M.R.'s matrix vectors (X (0.423113,0.150668,0.893462) D=1.0; Y (1.80224,-0.345906,-0.79515) D=2.0; Z (0.18925,1.94668,-0.417897) D=2.0) give orthogonal solution so the matrix is transformable, and it is just opposite than firstly given (X D=1.0; Y D=0.5; Z D=0.5)... You can see that Y and Z vectors are scaled to be smaller - factor 0.5, and with inversed vectors, Y and Z vectors are scaled to be bigger - factor 2.0
So to conclude :
Lee check - mathematically correct, but geometrically wrong :
;; TRP
;; Transposes a matrix -Doug Wilson-
;;
;; Argument : a matrix
(defun trp (m) (apply 'mapcar (cons 'list m)))
;; MXV
;; Applies a transformation matrix to a vector -Vladimir Nesterovsky-
;;
;; Arguments : a matrix and a vector
(defun mxv (m v)
(mapcar (function (lambda (r) (apply '+ (mapcar '* r v)))) m)
)
;; MXM
;; Multiplies (combinates) two matrices -Vladimir Nesterovsky-
;;
;; Arguments : two matrices
(defun mxm (m q)
(mapcar (function (lambda (r) (mxv (trp q) r))) m)
)
;;--------------------=={ Inverse Matrix }==------------------;;
;; ;;
;; Implements the Gauss-Jordan Elimination algorithm to ;;
;; inverse a non-singular nxn matrix. ;;
;;------------------------------------------------------------;;
;; Author: Lee Mac, Copyright © 2011 - www.lee-mac.com ;;
;;------------------------------------------------------------;;
;; Arguments: m - nxn Matrix ;;
;;------------------------------------------------------------;;
;; Returns: Matrix inverse, or nil if matrix is singular ;;
;;------------------------------------------------------------;;
(defun LM:InverseMatrix ( m / _identity _eliminate p r x )
(defun _identity ( n / i j l m ) (setq i 1)
(repeat n (setq j 0)
(repeat n
(setq l (cons (if (= i (setq j (1+ j))) 1. 0.) l))
)
(setq m (cons (reverse l) m) l nil i (1+ i))
) (reverse m)
)
(defun _eliminate ( m p )
(mapcar
(function
(lambda ( x / d )
(setq d (car x)) (mapcar (function (lambda ( a b ) (- a (* d b)))) (cdr x) p)
)
)
m
)
)
(setq m (mapcar 'append m (_identity (length m))))
(while m
(setq p (apply 'max (mapcar 'abs (mapcar 'car m))))
(while (not (equal p (abs (caar m)) 1e-14))
(setq m (append (cdr m) (list (car m))))
)
(if (equal 0.0 (caar m) 1e-14)
(setq m nil)
(setq p (/ 1. (caar m))
p (mapcar (function (lambda ( x ) (* p x))) (cdar m))
m (_eliminate (cdr m) p)
r (cons p (_eliminate r p))
)
)
)
(reverse r)
)
(defun c:transcheck ( / 3dmatrix )
(setq 3dmatrix (list '(0.4231131273299830 0.07533379400976697 0.4467310598675163 2.0) '(0.9011222711801549 -0.08647647224546744 -0.1987875319122376 5.0) '(0.09462522847614014 0.4866689215761297 -0.1044742901669432 8.0) '(0.0 0.0 0.0 1.0)))
(princ 3dmatrix)
(princ "\n")
(princ (LM:InverseMatrix 3dmatrix))
(princ "\n\n\n MxM = ")
(princ (mxm 3dmatrix (LM:InverseMatrix 3dmatrix)))
(textpage)
(princ)
)
M.R. check - geometrically correct, but mathematically wrong :
(vl-load-com)
;; TRP
;; Transposes a matrix -Doug Wilson-
;;
;; Argument : a matrix
(defun trp (m) (apply 'mapcar (cons 'list m)))
;; MXV
;; Applies a transformation matrix to a vector -Vladimir Nesterovsky-
;;
;; Arguments : a matrix and a vector
(defun mxv (m v)
(mapcar (function (lambda (r) (apply '+ (mapcar '* r v)))) m)
)
;; MXM
;; Multiplies (combinates) two matrices -Vladimir Nesterovsky-
;;
;; Arguments : two matrices
(defun mxm (m q)
(mapcar (function (lambda (r) (mxv (trp q) r))) m)
)
;; Unit Vector - Marko Ribar, d.i.a.
;; Args: v - vector in R^n
(defun unit ( v / dst )
(setq dst (distance '(0.0 0.0 0.0) v))
(mapcar '(lambda ( x ) (/ x dst)) 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)))
)
)
; transptucs by M.R. (Marko Ribar, d.i.a.)
; arguments :
; pt - point to be transformed from WCS to imaginary UCS
; pt1 - origin of imaginary UCS
; pt2 - point to define X axis of imaginary UCS (vector pt1-pt2 represents X axis)
; pt3 - point to define Y axis of imaginary UCS (vector pt1-pt3 represents Y axis)
; important note : angle between X and Y axises of imaginary UCS must always be 90 degree for correct transformation calculation
(defun transptucs ( pt p1 p2 p3 / ux uy uz )
(setq uz (unit (v^v (mapcar '- p2 p1) (mapcar '- p3 p1))))
(setq ux (unit (mapcar '- p2 p1)))
(setq uy (unit (mapcar '- p3 p1)))
(mxv (list ux uy uz) (mapcar '- pt p1))
)
; inverse matrix by M.R. (Marko Ribar, d.i.a.)
; arguments :
; 4x4 transform matrix :
; ((Xx Yx Zx X)
; (Xy Yy Zy Y)
; (Xz Yz Zz Z)
; (0.0 0.0 0.0 1.0))
(defun invmatrix ( 4x4matrix / Xx Xy Xz Yx Yy Yz Zx Zy Zz X Y Z Xinv Yinv Zinv XYZinv invmatrix )
(setq Xx (car (car 4x4matrix)))
(setq Xy (car (cadr 4x4matrix)))
(setq Xz (car (caddr 4x4matrix)))
(setq Yx (cadr (car 4x4matrix)))
(setq Yy (cadr (cadr 4x4matrix)))
(setq Yz (cadr (caddr 4x4matrix)))
(setq Zx (caddr (car 4x4matrix)))
(setq Zy (caddr (cadr 4x4matix)))
(setq Zz (caddr (caddr 4x4matrix)))
(setq X (cadddr (car 4x4matrix)))
(setq Y (cadddr (cadr 4x4matrix)))
(setq Z (cadddr (caddr 4x4matrix)))
(setq Xinv (transptucs '(1.0 0.0 0.0) '(0.0 0.0 0.0) (list Xx Xy Xz) (list Yx Yy Yz)))
(setq Yinv (transptucs '(0.0 1.0 0.0) '(0.0 0.0 0.0) (list Xx Xy Xz) (list Yx Yy Yz)))
(setq Zinv (transptucs '(0.0 0.0 1.0) '(0.0 0.0 0.0) (list Xx Xy Xz) (list Yx Yy Yz)))
(setq XYZinv (transptucs (list X Y Z) '(0.0 0.0 0.0) (list Xx Xy Xz) (list Yx Yy Yz)))
(setq invmatrix (list
(list (car Xinv) (car Yinv) (car Zinv) (- (car XYZinv)))
(list (cadr Xinv) (cadr Yinv) (cadr Zinv) (- (cadr XYZinv)))
(list (caddr Xinv) (caddr Yinv) (caddr Zinv) (- (caddr XYZinv)))
(list 0.0 0.0 0.0 1.0)
)
)
invmatrix
)
(defun transblbymatrix ( / obj 3dmatrix Xvec Yvec Zvec X Y Z matrix Sx Sy Sz )
(setq obj (vlax-ename->vla-object (car (cadddr (nentselp "\nSelect block for transformation")))))
(setq 3dmatrix (list '(0.4231131273299830 0.07533379400976697 0.4467310598675163 2.0) '(0.9011222711801549 -0.08647647224546744 -0.1987875319122376 5.0) '(0.09462522847614014 0.4866689215761297 -0.1044742901669432 8.0) '(0.0 0.0 0.0 1.0)))
(setq Xvec (list (car (car 3dmatrix)) (car (cadr 3dmatrix)) (car (caddr 3dmatrix))))
(setq Yvec (list (cadr (car 3dmatrix)) (cadr (cadr 3dmatrix)) (cadr (caddr 3dmatrix))))
(setq Zvec (list (caddr (car 3dmatrix)) (caddr (cadr 3dmatrix)) (caddr (caddr 3dmatrix))))
(setq X (cadddr (car 3dmatrix)))
(setq Y (cadddr (cadr 3dmatrix)))
(setq Z (cadddr (caddr 3dmatrix)))
(setq matrix (list
(list (car (unit Xvec)) (car (unit Yvec)) (car (unit Zvec)) X)
(list (cadr (unit Xvec)) (cadr (unit Yvec)) (cadr (unit Zvec)) Y)
(list (caddr (unit Xvec)) (caddr (unit Yvec)) (caddr (unit Zvec)) Z)
(list 0.0 0.0 0.0 1.0)
)
)
(setq Sx (sqrt (+ (expt (car Xvec) 2) (expt (cadr Xvec) 2) (expt (caddr Xvec) 2))))
(setq Sy (sqrt (+ (expt (car Yvec) 2) (expt (cadr Yvec) 2) (expt (caddr Yvec) 2))))
(setq Sz (sqrt (+ (expt (car Zvec) 2) (expt (cadr Zvec) 2) (expt (caddr Zvec) 2))))
(vla-transformby obj (vlax-tmatrix matrix))
(vla-put-Xscalefactor obj (* Sx (vla-get-Xscalefactor obj)))
(vla-put-Yscalefactor obj (* Sy (vla-get-Yscalefactor obj)))
(vla-put-Zscalefactor obj (* Sz (vla-get-Zscalefactor obj)))
(prompt "\nTransformation matrix applied to selected object : ")(princ "\n")(princ 3dmatrix)
(textpage)
3dmatrix
)
(defun transblbymatrix-inv ( / obj 3dmatrix Xvec Yvec Zvec X Y Z matrix invmat Sx Sy Sz )
(setq obj (vlax-ename->vla-object (car (cadddr (nentselp "\nSelect block for transformation")))))
(setq 3dmatrix (list '(0.4231131273299830 0.07533379400976697 0.4467310598675163 2.0) '(0.9011222711801549 -0.08647647224546744 -0.1987875319122376 5.0) '(0.09462522847614014 0.4866689215761297 -0.1044742901669432 8.0) '(0.0 0.0 0.0 1.0)))
(setq Xvec (list (car (car 3dmatrix)) (car (cadr 3dmatrix)) (car (caddr 3dmatrix))))
(setq Yvec (list (cadr (car 3dmatrix)) (cadr (cadr 3dmatrix)) (cadr (caddr 3dmatrix))))
(setq Zvec (list (caddr (car 3dmatrix)) (caddr (cadr 3dmatrix)) (caddr (caddr 3dmatrix))))
(setq X (cadddr (car 3dmatrix)))
(setq Y (cadddr (cadr 3dmatrix)))
(setq Z (cadddr (caddr 3dmatrix)))
(setq matrix (list
(list (car (unit Xvec)) (car (unit Yvec)) (car (unit Zvec)) X)
(list (cadr (unit Xvec)) (cadr (unit Yvec)) (cadr (unit Zvec)) Y)
(list (caddr (unit Xvec)) (caddr (unit Yvec)) (caddr (unit Zvec)) Z)
(list 0.0 0.0 0.0 1.0)
)
)
(setq invmat (invmatrix matrix))
(setq Sx (/ 1.0 (sqrt (+ (expt (car Xvec) 2) (expt (cadr Xvec) 2) (expt (caddr Xvec) 2)))))
(setq Sy (/ 1.0 (sqrt (+ (expt (car Yvec) 2) (expt (cadr Yvec) 2) (expt (caddr Yvec) 2)))))
(setq Sz (/ 1.0 (sqrt (+ (expt (car Zvec) 2) (expt (cadr Zvec) 2) (expt (caddr Zvec) 2)))))
(vla-transformby obj (vlax-tmatrix invmat))
(vla-put-Xscalefactor obj (* Sx (vla-get-Xscalefactor obj)))
(vla-put-Yscalefactor obj (* Sy (vla-get-Yscalefactor obj)))
(vla-put-Zscalefactor obj (* Sz (vla-get-Zscalefactor obj)))
(setq 3dmatrix (list
(list (* Sx (car (car invmat))) (* Sy (cadr (car invmat))) (* Sz (caddr (car invmat))) (cadddr (car invmat)))
(list (* Sx (car (cadr invmat))) (* Sy (cadr (cadr invmat))) (* Sz (caddr (cadr invmat))) (cadddr (cadr invmat)))
(list (* Sx (car (caddr invmat))) (* Sy (cadr (caddr invmat))) (* Sz (caddr (caddr invmat))) (cadddr (caddr invmat)))
(list 0.0 0.0 0.0 1.0)
)
)
(prompt "\nInverse transformation matrix applied to selected object : ")(princ "\n")(princ 3dmatrix)
(textpage)
3dmatrix
)
(defun c:transcheck nil
(setq mat (mxm (transblbymatrix) (transblbymatrix-inv)))
(princ "\n\n\n MxM = ") (princ mat)
(textpage)
(princ)
)
For geometric check see posted *.dwg files...
Regards, M.R.