Topic: Given a transformation matrix,How do I get its normal ,rotation angle and scale?

[ribarm]

Even better, now it uses only one transformation instead of 2 (one for returning back to original orientation with InverseMatrix and one for new orientation)... Now I multiplied matrices in reverse order and obtained only 1 matrix for transformation... So no flickering while previewing object... Thanks to gile also for informing me how to apply matrix multiplication in reference to object transformations (reverse order of matrices in multiplication of real transformations order)... So here it goes :

Code: [Select]

(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)
)

;;--------------------=={ 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 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 unit ( v / dv )
  (setq dv (distance '(0.0 0.0 0.0) v))
  (mapcar '(lambda ( x ) (/ x dv)) v)
)

(defun c:objpreview ( / A D GR LOOP MATRIX MATRIXI OBJ PT RM VS VSMAXR VSMINR XDIR YDIR YDIRXY YDIRZ ZDIR )
  (setq obj (vlax-ename->vla-object (car (entsel "\nPick object to preview"))))
  (setq rm (getvar 'regenmode))
  (setvar 'regenmode 0)
  (setq vs (getvar 'viewsize))
  (setq vsmaxr (/ vs 2.0))
  (setq vsminr (/ vs 4.0))
  (setq loop T)
  (prompt "\nLeft click with mouse to exit")
  (while loop
    (setq gr (grread T 15 0))
    (setq pt (cadr gr))
    (setq d (distance '(0.0 0.0 0.0) pt))
    (if (<= vsminr d vsmaxr) (setq a (/ (* PI 2.0) (/ (- vsmaxr vsminr) (- vsmaxr d)))) (setq a 0.0))
    (setq xdir (unit pt))
    (setq ydirxy (polar '(0.0 0.0 0.0) (+ (angle '(0.0 0.0 0.0) pt) (/ PI 2.0)) (cos a)))
    (setq ydirz (sin a))
    (setq ydir (list (car ydirxy) (cadr ydirxy) ydirz))
    (setq zdir (unit (v^v xdir ydir)))
    (setq matrix (list (list (car xdir) (car ydir) (car zdir) 0.0) (list (cadr xdir) (cadr ydir) (cadr zdir) 0.0) (list (caddr xdir) (caddr ydir) (caddr zdir) 0.0) '(0.0 0.0 0.0 1.0)))
    (if (not matrixi) (vla-transformby obj (vlax-tmatrix matrix)) (vla-transformby obj (vlax-tmatrix (mxm matrix matrixi))))
    (setq matrixi (LM:InverseMatrix matrix))
    (if (eq (car gr) 3)
      (progn
        (vla-transformby obj (vlax-tmatrix matrixi))
        (setq loop nil)
      )
    )
  )
  (setvar 'regenmode rm)
  (princ)
)

Best wishes, M.R.
 

[ribarm]

objpreview.lsp for 3dsolid object in anywhere in 3d space... Previewing is around its centroid...

Code: [Select]

(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)
)

;;--------------------=={ 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 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 unit ( v / dv )
  (setq dv (distance '(0.0 0.0 0.0) v))
  (mapcar '(lambda ( x ) (/ x dv)) v)
)

(defun c:objpreview ( / A CENT D GR LOOP MATRIX MATRIXI OBJ PT RM VS VSMAXR VSMINR XDIR YDIR YDIRXY YDIRZ ZDIR )
  (prompt "\nPick 3DSOLID to preview")
  (vl-cmdf "_.UCS" "w")
  (setq obj (vlax-ename->vla-object (ssname (ssget "_+.:E:S:L" '((0 . "3DSOLID"))) 0)))
  (setq cent (vlax-safearray->list (vlax-variant-value (vla-get-Centroid obj))))
  (vl-cmdf "_.UCS" "m" cent)
  (vla-move obj (vlax-3d-point cent) (vlax-3d-point '(0.0 0.0 0.0)))
  (setq rm (getvar 'regenmode))
  (setvar 'regenmode 0)
  (setq vs (getvar 'viewsize))
  (setq vsmaxr (/ vs 2.0))
  (setq vsminr (/ vs 4.0))
  (setq loop T)
  (prompt "\nLeft click with mouse to exit")
  (while loop
    (setq gr (grread T 15 0))
    (setq pt (cadr gr))
    (setq d (distance '(0.0 0.0 0.0) pt))
    (if (<= vsminr d vsmaxr) (setq a (/ (* PI 2.0) (/ (- vsmaxr vsminr) (- vsmaxr d)))) (setq a 0.0))
    (setq xdir (unit pt))
    (setq ydirxy (polar '(0.0 0.0 0.0) (+ (angle '(0.0 0.0 0.0) pt) (/ PI 2.0)) (cos a)))
    (setq ydirz (sin a))
    (setq ydir (list (car ydirxy) (cadr ydirxy) ydirz))
    (setq zdir (unit (v^v xdir ydir)))
    (setq matrix (list (list (car xdir) (car ydir) (car zdir) (car cent)) (list (cadr xdir) (cadr ydir) (cadr zdir) (cadr cent)) (list (caddr xdir) (caddr ydir) (caddr zdir) (caddr cent)) (list 0.0 0.0 0.0 1.0)))
    (if (not matrixi) (vla-transformby obj (vlax-tmatrix matrix)) (vla-transformby obj (vlax-tmatrix (mxm matrix matrixi))))
    (setq matrixi (LM:InverseMatrix matrix))
    (if (eq (car gr) 3)
      (progn
        (vla-transformby obj (vlax-tmatrix matrixi))
        (vla-move obj (vlax-3d-point '(0.0 0.0 0.0)) (vlax-3d-point cent))
        (setq loop nil)
      )
    )
  )
  (setvar 'regenmode rm)
  (vl-cmdf "_.UCS" "p")
  (vl-cmdf "_.UCS" "p")
  (princ)
)

M.R.
 

[ribarm]

Here is variant with my subfunctions (inverse matrix with transptucs) :

Code: [Select]

(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 c:objpreview ( / A CENT D GR LOOP MATRIX MATRIXI OBJ PT RM VS VSMAXR VSMINR XDIR YDIR YDIRXY YDIRZ ZDIR )
  (prompt "\nPick 3DSOLID to preview")
  (vl-cmdf "_.UCS" "w")
  (setq obj (vlax-ename->vla-object (ssname (ssget "_+.:E:S:L" '((0 . "3DSOLID"))) 0)))
  (setq cent (vlax-safearray->list (vlax-variant-value (vla-get-Centroid obj))))
  (vl-cmdf "_.UCS" "m" cent)
  (vla-move obj (vlax-3d-point cent) (vlax-3d-point '(0.0 0.0 0.0)))
  (setq rm (getvar 'regenmode))
  (setvar 'regenmode 0)
  (setq vs (getvar 'viewsize))
  (setq vsmaxr (/ vs 2.0))
  (setq vsminr (/ vs 4.0))
  (setq loop T)
  (prompt "\nLeft click with mouse to exit")
  (while loop
    (setq gr (grread T 15 0))
    (setq pt (cadr gr))
    (setq d (distance '(0.0 0.0 0.0) pt))
    (if (<= vsminr d vsmaxr) (setq a (/ (* PI 2.0) (/ (- vsmaxr vsminr) (- vsmaxr d)))) (setq a 0.0))
    (setq xdir (unit pt))
    (setq ydirxy (polar '(0.0 0.0 0.0) (+ (angle '(0.0 0.0 0.0) pt) (/ PI 2.0)) (cos a)))
    (setq ydirz (sin a))
    (setq ydir (list (car ydirxy) (cadr ydirxy) ydirz))
    (setq zdir (unit (v^v xdir ydir)))
    (setq matrix (list (list (car xdir) (car ydir) (car zdir) (car cent)) (list (cadr xdir) (cadr ydir) (cadr zdir) (cadr cent)) (list (caddr xdir) (caddr ydir) (caddr zdir) (caddr cent)) (list 0.0 0.0 0.0 1.0)))
    (if (not matrixi) (vla-transformby obj (vlax-tmatrix matrix)) (vla-transformby obj (vlax-tmatrix (mxm matrix matrixi))))
    (setq matrixi (invmatrix matrix))
    (if (eq (car gr) 3)
      (progn
        (vla-transformby obj (vlax-tmatrix matrixi))
        (vla-move obj (vlax-3d-point '(0.0 0.0 0.0)) (vlax-3d-point cent))
        (setq loop nil)
      )
    )
  )
  (setvar 'regenmode rm)
  (vl-cmdf "_.UCS" "p")
  (vl-cmdf "_.UCS" "p")
  (princ)
)

M.R.

[gile]

Hi,

Your invmatrix function only works with uniformly scaled transformation matrices.
Lee's or mine work with any inversible square matrix.

[ribarm]

Gile, of course your and Lee's code is better, but tell me on what example can you apply non-uniformly scaled matrix (speaking of CAD computing)? :ugly: I just can't think of any (maybe I am missing something)...
As you can see, my version is also applicable like yours and Lee's (above posted routine works fine)...

M.R.

[gile]

Gile, of course your and Lee's code is better, but tell me on what example can you apply non-uniformly scaled matrix (speaking of CAD computing)? :ugly: I just can't think of any (maybe I am missing something)...

With the matrix returned by nenteselp on a non uniformly scaled block reference component.

[ribarm]

Tell me please, then why this also isn't working on block object :

Code: [Select]

(defun c:t ( / obj 3dmatrix )
(vl-load-com)
(setq obj (vlax-ename->vla-object (car (cadddr (nentselp "\nSelect block for transformation")))))
(vla-transformby obj
  (vlax-tmatrix (setq 3dmatrix
    (list '(0.42311313 0.07533379 0.44673106 0.0) '(0.90112227 -0.08647647 -0.19878753 0.0) '(0.09462523 0.48666892 -0.10447429 0.0) '(0.0 0.0 0.0 1.0)))
  )
)
(prompt "\nTransformation matrix applied to selected object : ")(princ "\n")(princ 3dmatrix)
(princ)
)

Or to simplify :

Code: [Select]

(defun c:t ( / obj 3dmatrix )
(vl-load-com)
(setq obj (vlax-ename->vla-object (car (cadddr (nentselp "\nSelect block for transformation")))))
(vla-transformby obj
  (vlax-tmatrix (setq 3dmatrix
    (list '(1.0 0.0 0.0 0.0) '(0.0 0.5 0.0 0.0) '(0.0 0.0 1.0 0.0) '(0.0 0.0 0.0 1.0)))
  )
)
(prompt "\nTransformation matrix applied to selected object : ")(princ "\n")(princ 3dmatrix)
(princ)
)

M.R.

[gile]

You cannot use vla-TransformBy with non uniform matrices, but you may have tou transform coordinates from or to block reference components. See here:
http://www.theswamp.org/index.php?topic=27402.msg329826#msg329826

[ribarm]

I've solved problem with non-uniform scaling of block... Only thing is now that precision of 3dmatrix must be on 1e-17 decimal place of each matrix component :

Code: [Select]

(vl-load-com)

(defun unit ( v / dst )
  (setq dst (distance '(0.0 0.0 0.0) v))
  (mapcar '(lambda ( x ) (/ x dst)) v)
)

(defun c: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 0.0) '(0.9011222711801549 -0.08647647224546744 -0.1987875319122376 0.0) '(0.09462522847614014 0.4866689215761297 -0.1044742901669432 0.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)
  (princ)
)

M.R.

[ribarm]

All 3 subfunctions work, but real inverse matrix can't be obtained directly by applying subfunctions, but only through this examples ... (apply this codes after previously posted example for non-uniform scale matrix) :

M.R.

Code: [Select]

(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 c: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 0.0) '(0.9011222711801549 -0.08647647224546744 -0.1987875319122376 0.0) '(0.09462522847614014 0.4866689215761297 -0.1044742901669432 0.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)
  (princ)
)

Gile :

Code: [Select]

(vl-load-com)

;; InverseMatrix (gile) 2009/03/17
;; Uses the Gauss-Jordan elimination method to calculate the inverse
;; matrix of any dimension square matrix
;;
;; Argument : a square matrix
;; Return : the inverse matrix (or nil if singular)

(defun InverseMatrix (mat / col piv row res)
  (setq mat (mapcar '(lambda (x1 x2) (append x1 x2)) mat (Imat (length mat))))
  (while mat
    (setq col (mapcar '(lambda (x) (abs (car x))) mat))
    (repeat (vl-position (apply 'max col) col)
      (setq mat (append (cdr mat) (list (car mat))))
    )
    (if (equal (setq piv (caar mat)) 0.0 1e-14)
      (setq mat nil
    res nil
      )
      (setq piv (/ 1.0 piv)
    row (mapcar '(lambda (x) (* x piv)) (car mat))
    mat (mapcar
  '(lambda (r / e)
     (setq e (car r))
     (cdr (mapcar '(lambda (x n) (- x (* n e))) r row))
   )
  (cdr mat)
)
    res (cons
  (cdr row)
  (mapcar
    '(lambda (r / e)
       (setq e (car r))
       (cdr (mapcar '(lambda (x n) (- x (* n e))) r row))
     )
    res
  )
)
      )
    )
  )
  (reverse res)
)

;; IMAT (gile)
;; Returns the specified dimension identity matrix
;;
;; Argument
;; d : the matrix dimension (positive integer)

(defun Imat (d / i n r m)
  (setq i d)
  (while (<= 0 (setq i (1- i)))
    (setq n d r nil)
    (while (<= 0 (setq n (1- n)))
      (setq r (cons (if (= i n) 1.0 0.0) r))
    )
    (setq m (cons r m))
  )
)

(defun unit ( v / dst )
  (setq dst (distance '(0.0 0.0 0.0) v))
  (mapcar '(lambda ( x ) (/ x dst)) v)
)

(defun c: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 0.0) '(0.9011222711801549 -0.08647647224546744 -0.1987875319122376 0.0) '(0.09462522847614014 0.4866689215761297 -0.1044742901669432 0.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 (InverseMatrix 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)
  (princ)
)

Lee Mac :

Code: [Select]

(vl-load-com)

;;--------------------=={ 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 unit ( v / dst )
  (setq dst (distance '(0.0 0.0 0.0) v))
  (mapcar '(lambda ( x ) (/ x dst)) v)
)

(defun c: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 0.0) '(0.9011222711801549 -0.08647647224546744 -0.1987875319122376 0.0) '(0.09462522847614014 0.4866689215761297 -0.1044742901669432 0.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 (LM:InverseMatrix 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)
  (princ)
)

Regards, M.R.

[Lee Mac]

And there was me thinking I'd answered the OP's question by post#8 

[ribarm]

Sorry Lee, I've made mistake at the end. It should be :

Code: [Select]

  (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)
                 )
  )

After all, nobody is perfect...
M.R.

[highflyingbird]

If a matrix is not orthogonal, we can't  transform an enttity, otherwise ,we'll get the message:
error: Automation Error. Cannot scale nonuniformly.
Like this:

Code: [Select]

'((1.26233 -3.10259 0.0 280319.0) (1.16347 1.8935 0.0 -160520.0) (0.0 0.0 1.0 0.0) (0.0 0.0 0.0 1.0)) 
we can get the  matrix by "nentselp"  ,but this hatch has been scaled nonuniformly twice,so we can't  use transformation matrix 
directly.

[ribarm]

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 :

Code: [Select]

;; 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 :

Code: [Select]

(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.

[Lee Mac]

If a matrix is not orthogonal, we can't  transform an enttity, otherwise ,we'll get the message:
error: Automation Error. Cannot scale nonuniformly.

Indeed, you cannot apply the TransformBy method to non-orthogonal matrices, however, you can still transform point lists by non-orthogonal matrices using such functions as 'mxv' etc.