Author Topic: Given a transformation matrix,How do I get its normal ,rotation angle and scale?  (Read 13272 times)

0 Members and 1 Guest are viewing this topic.

highflyingbird

  • Bull Frog
  • Posts: 415
  • Later equals never.
Given a tranformation matrix,How do I get its normal ,rotation angle and scale?
for example , this is a transformation matrix, maybe  from  nentsel or other way:
((0.423113 0.901122 0.0946252) (0.0753338 -0.0864765 0.486669) (0.446731 -0.198788 -0.104474) (2002.55 741.736 157.945))

P.S.  maybe it 's a nonuniform matrix,so need to get the  x scalefactor, y scalefactor and z scalefactor.
« Last Edit: January 01, 2012, 09:47:48 PM by HighflyingBird »
I am a bilingualist,Chinese and Chinglish.

ribarm

  • Gator
  • Posts: 3225
  • Marko Ribar, architect
I would transform cube block positioned with its center at 0,0,0 and aligned to WCS, and see what are results after transformation... Query for block info X, Y, Z scale factors and as well its rotation around new normal vector and position translation vector (4th line of your matrix)...

M.R.
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

ribarm

  • Gator
  • Posts: 3225
  • Marko Ribar, architect
To obtain angle between new vector normal and WCS normal, after transformation use this simple code :

Code: [Select]
(defun c:ang-normals ( / pt1 pt2 pt3 pt4 rad deg degs cmde )
(setq cmde (getvar 'cmdecho))
(setvar 'cmdecho 0)
(command "ucsicon" "off")
(command "ucs" "s" "lastucs")
(command "ucs" "w")
(print)
(setq pt1 '(0.0 0.0 1.0))
(setq pt2 '(0.0 0.0 0.0))
(setq pt3 (cdr (assoc 210 (entget (car (entsel "\nPick object to calculate angle between new vector of normal and WCS normal"))))))
(command "ucs" "3p" pt2 pt1 pt3)
(setq pt4 (trans pt3 0 1))
(setq rad (angle '(0 0) pt4))
(setq deg (cvunit rad "radians" "degrees"))
(setq degs (rtos deg))
(command "ucs" "r" "lastucs")
(command "ucs" "d" "lastucs")
(command "ucsicon" "on")
(print)
(prompt degs)
(setvar 'cmdecho cmde)
(princ)
)

M.R.
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

ribarm

  • Gator
  • Posts: 3225
  • Marko Ribar, architect
Now I've checked, indeed it's non-uniform scale matrix, and it's impossible to do transformation on block vla-object... So try some other method... Here is what I used unsuccessfully :

Code: [Select]
(defun c:t ( / obj 3dmatrix )
(vl-load-com)
(setq obj (vlax-ename->vla-object (car (entsel "\nSelect object for transformation"))))
(vla-transformby obj
  (vlax-tmatrix (setq 3dmatrix
    (list '(0.423113 0.901122 0.0946252 0.0) '(0.0753338 -0.0864765 0.486669 0.0) '(0.446731 -0.198788 -0.104474 0.0) '(0.0 0.0 0.0 1.0)))
  )
)
(prompt "\nTransformation matrix applied to selected object : ")(princ "\n")(princ 3dmatrix)
(princ)
)

M.R.
« Last Edit: January 02, 2012, 03:02:20 AM by ribarm »
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

ribarm

  • Gator
  • Posts: 3225
  • Marko Ribar, architect
By measuring vector distances, I obtained scale factors 1.0; 0.5; 0.5 or if you multiply by 2.0 => 2.0; 1.0; 1.0... So X scale factor is 2x larger than Y or Z scale factors... See attached *.dwg...

M.R.
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

highflyingbird

  • Bull Frog
  • Posts: 415
  • Later equals never.
By measuring vector distances, I obtained scale factors 1.0; 0.5; 0.5 or if you multiply by 2.0 => 2.0; 1.0; 1.0... So X scale factor is 2x larger than Y or Z scale factors... See attached *.dwg...

M.R.
Excellent! It's a good way!
I am a bilingualist,Chinese and Chinglish.

ribarm

  • Gator
  • Posts: 3225
  • Marko Ribar, architect
transposed vectors - XYZ of transformed object
0.42311313 0.90112227 0.09462523
0.15066759 -0.17295294 0.97333784
0.89346212 -0.39757506 -0.20894858

vectors of 3dmatrix - uniform scale (X=1.0 Y=1.0 Z=1.0)
0.42311313 0.15066759 0.89346212
0.90112227 -0.17295294 -0.39757506
0.09462523 0.97333784 -0.20894858

Similar method applied on your 3dmatrix :

3dmatrix
0.42311313 0.90112227 0.09462523
0.07533379 -0.08647647 0.48666892
0.44673106 -0.19878753 -0.10447429

transposed vectors - XYZ
0.42311313 0.07533379 0.44673106
0.90112227 -0.08647647 -0.19878753
0.09462523 0.48666892 -0.10447429

But, because these X,Y,Z are not orthogonal (see my newly attached *.dwg), you probably didn't post data for 3dmatrix, but for X,Y,Z vectors; so
X:Y:Z = 1.0:0.5:0.5

vectors of - XYZ of transformed object
0.42311313 0.90112227 0.09462523
0.07533379 -0.08647647 0.48666892
0.44673106 -0.19878753 -0.10447429

so transposed 3dmatrix should be :
0.42311313 0.07533379 0.44673106
0.90112227 -0.08647647 -0.19878753
0.09462523 0.48666892 -0.10447429

But because matrix is non-uniformly scaled transformation, this also doesn't work :
Code: [Select]
(defun c:t ( / obj 3dmatrix )
(vl-load-com)
(setq obj (vlax-ename->vla-object (car (entsel "\nSelect object 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)
)

M.R.
I hope I explained well...
:)
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

highflyingbird

  • Bull Frog
  • Posts: 415
  • Later equals never.
ribarm,thank you very much.
I  learned a lot from your code and files.
I am a bilingualist,Chinese and Chinglish.

Lee Mac

  • Seagull
  • Posts: 12906
  • London, England
Firstly, note that the matrix returned by nentsel differs from that returned by nentselp (it is the transpose matrix minus the bottom row):

nentselp
Code: [Select]
(
    (a b c x)
    (d e f y)
    (g h j z)
    (0 0 0 1)
)
[ (x y z 1) is the homogeneous translation vector; the last row (0 0 0 1) is merely to create a square matrix ]

nentsel
Code: [Select]
(
    (a d g)
    (b e h)
    (c f j)
    (x y z)
)

In the following, I shall focus on using the matrix returned by the nentselp function, so to convert the nentsel matrix to the nentselp matrix, you can use the following function:

Code: [Select]
(defun nentsel->nentselp ( m )
    (append (apply 'mapcar (cons 'list m)) '((0.0 0.0 0.0 1.0)))
)

We can focus solely on rotations in the WCS plane, since the OCS matrix can be tranformed to WCS using the Object Normal (DXF 210) - I believe we discussed this previously here.

For the WCS nentselp matrix we have:

Code: [Select]
(a b c x)
(d e f y)
(g h j z)
(0 0 0 1)

Here, for the WCS matrix, we have:

Code: [Select]
(a  b  c  x)       (Sx·cosθ  -Sy·sinθ  0   x)
(d  e  f  y)   =   (Sx·sinθ   Sy·cosθ  0   y)
(g  h  j  z)       (    0       0     Sz   z)
(0  0  0  1)       (    0       0      0   1)

Where (Sx Sy Sz) are the respective x,y,z scale factors, θ is the rotation angle about the origin in the WCS plane, and (x y z) is the translation vector.


Now:

Code: [Select]
Sx  =  ±sqrt(a² + d²)
Sy  =  ±sqrt(b² + e²)
Sz  =  j

 θ  =  atan(d/a)

To determine the sign of Sx and Sy we can use the sign of values a and e (since Cosine is an even function and is non-negative in the domain of the ArcTan function).


Using this information, we can construct an AutoLISP function to return a list of: ((Sx Sy Sz) θ (x y z)), given the matrix returned by nentselp (or nentsel converted), transformed relative to WCS:

Code: [Select]
;; Decompose Matrix  -  Lee Mac
;; Decomposes a 4x4 transformation matrix into a list of
;; ((Sx Sy Sz) <angle> (x y z))

(defun LM:Decompose ( mat )   
    (list
        (list
            (* (sign (caar mat))
               (sqrt (+ (* (caar mat) (caar mat)) (* (caadr mat) (caadr mat))))
            )
            (* (sign (cadadr mat))
               (sqrt (+ (* (cadar mat) (cadar mat)) (* (cadadr mat) (cadadr mat))))
            )
            (caddr (caddr mat))
        )
        (atan (caadr mat) (caar mat))
        (mapcar '+ (mapcar 'last mat) '(0 0 0))
    )
)
(defun sign ( a ) (if (minusp a) -1.0 1.0))

An example, for a block with X-Scale = 1.5, Y-Scale = 1.3, Z-Scale = 1.5 and Rotation = pi/6 (30 degs), we have the following matrix returned by nentselp (for some position in ModelSpace):

Code: [Select]
(
    (1.29904 -0.65 0.0 -67.0503)
    (0.75 1.12583 0.0 18.2337)
    (0.0 0.0 1.5 0.0)
    (0.0 0.0 0.0 1.0)
)

Using the above function:

Code: [Select]
(setq m
   '(
        (1.29904 -0.65 0.0 -67.0503)
        (0.75 1.12583 0.0 18.2337)
        (0.0 0.0 1.5 0.0)
        (0.0 0.0 0.0 1.0)
    )
)

_$ (LM:Decompose m)
((1.5 1.3 1.5) 0.523599 (-67.0503 18.2337 0.0))

_$ (/ pi 6)
0.523599

ribarm

  • Gator
  • Posts: 3225
  • Marko Ribar, architect
Here is my little experiment with transformation matrices. It is using my explanation of X, Y, Z vectors incorporated in matrix and inverse matrix by Lee Mac (thanks Lee for your subfunction)... All that combined with grread function... It has some visual problems, but with fast mouse moving it is less viewable... I designed it for plan view (top view)...

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 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)))
    (setq matrixi (LM:InverseMatrix matrix))
    (cond
    ((vla-transformby obj (vlax-tmatrix matrix))) ((progn (vla-put-visible obj -1) (vla-update obj)))
    ((vla-transformby obj (vlax-tmatrix matrixi))) ((progn (vla-put-visible obj 0) (vla-update obj)))
    )
    (if (eq (car gr) 3)
      (progn
        (vla-put-visible obj -1)
        (setq loop nil)
      )
    )
  )
  (setvar 'regenmode rm)
  (princ)
)

M.R. (Thanks once again Lee)
« Last Edit: September 24, 2021, 10:36:25 AM by ribarm »
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

Jeff H

  • Needs a day job
  • Posts: 6144
Have you looked at the ArxDocs?
 
The attached PDF is only a portion of information given.
 

highflyingbird

  • Bull Frog
  • Posts: 415
  • Later equals never.
Code: [Select]
Sx  =  ±sqrt(a² + d²)
Sy  =  ±sqrt(b² + e²)
Sz  =  j

 θ  =  atan(d/a)

Lee,you are a genius!This is exactly what I wanted.
For  most of 2d operations, it's enough.
Thank you very much.
I am a bilingualist,Chinese and Chinglish.

Lee Mac

  • Seagull
  • Posts: 12906
  • London, England
Lee,you are a genius!This is exactly what I wanted.
For  most of 2d operations, it's enough.
Thank you very much.

Many thanks HighflyingBird, I enjoyed constructing the solution  :-)

ribarm

  • Gator
  • Posts: 3225
  • Marko Ribar, architect
Does anyone know how to improve my above posted code... It seems that after (vla-update obj), object is always shown even if previously was set (redraw objename 2)...  :-(

M.R.
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

ribarm

  • Gator
  • Posts: 3225
  • Marko Ribar, architect
I did what I could... Used (vla-put-visible obj 0) to turn it off and (vla-put-visible obj -1) to turn it on. Now it works better than with (redraw) variant... This is what I wanted. Updated code above...

Regards,
M.R.
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

ribarm

  • Gator
  • Posts: 3225
  • Marko Ribar, architect
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.
 8-)
« Last Edit: September 24, 2021, 10:37:29 AM by ribarm »
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

ribarm

  • Gator
  • Posts: 3225
  • Marko Ribar, architect
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.
 8-)
« Last Edit: September 24, 2021, 10:38:37 AM by ribarm »
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

ribarm

  • Gator
  • Posts: 3225
  • Marko Ribar, architect
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. 8-)
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

gile

  • Gator
  • Posts: 2507
  • Marseille, France
Hi,

Your invmatrix function only works with uniformly scaled transformation matrices.
Lee's or mine work with any inversible square matrix.
« Last Edit: January 06, 2012, 04:42:13 AM by gile »
Speaking English as a French Frog

ribarm

  • Gator
  • Posts: 3225
  • Marko Ribar, architect
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.
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

gile

  • Gator
  • Posts: 2507
  • Marseille, France
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.
Speaking English as a French Frog

ribarm

  • Gator
  • Posts: 3225
  • Marko Ribar, architect
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.
« Last Edit: January 06, 2012, 07:25:48 AM by ribarm »
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

gile

  • Gator
  • Posts: 2507
  • Marseille, France
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
Speaking English as a French Frog

ribarm

  • Gator
  • Posts: 3225
  • Marko Ribar, architect
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.
« Last Edit: January 06, 2012, 10:15:01 AM by ribarm »
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

ribarm

  • Gator
  • Posts: 3225
  • Marko Ribar, architect
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.
« Last Edit: September 24, 2021, 10:41:15 AM by ribarm »
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

Lee Mac

  • Seagull
  • Posts: 12906
  • London, England
And there was me thinking I'd answered the OP's question by post#8  :roll:

ribarm

  • Gator
  • Posts: 3225
  • Marko Ribar, architect
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.
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

highflyingbird

  • Bull Frog
  • Posts: 415
  • Later equals never.
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.
« Last Edit: January 06, 2012, 09:32:24 PM by HighflyingBird »
I am a bilingualist,Chinese and Chinglish.

ribarm

  • Gator
  • Posts: 3225
  • Marko Ribar, architect
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.
« Last Edit: September 24, 2021, 10:43:05 AM by ribarm »
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

Lee Mac

  • Seagull
  • Posts: 12906
  • London, England
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.

ribarm

  • Gator
  • Posts: 3225
  • Marko Ribar, architect
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.

Have you tried this :
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 ( / nents obj 3dmatrix Xvec Yvec Zvec X Y Z matrix invmat Sx Sy Sz )
  (setq nents (nentselp "\nSelect block for transformation"))
  (setq obj (vlax-ename->vla-object (last (cadddr nents))))
  (setq 3dmatrix (caddr nents))
  (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 (strcat "((" (rtos (nth 0 (car 3dmatrix)) 2 50) " " (rtos (nth 1 (car 3dmatrix)) 2 50) " " (rtos (nth 2 (car 3dmatrix)) 2 50) " " (rtos (nth 3 (car 3dmatrix)) 2 50) ")"
                  "(" (rtos (nth 0 (cadr 3dmatrix)) 2 50) " " (rtos (nth 1 (cadr 3dmatrix)) 2 50) " " (rtos (nth 2 (cadr 3dmatrix)) 2 50) " " (rtos (nth 3 (cadr 3dmatrix)) 2 50) ")"
                  "(" (rtos (nth 0 (caddr 3dmatrix)) 2 50) " " (rtos (nth 1 (caddr 3dmatrix)) 2 50) " " (rtos (nth 2 (caddr 3dmatrix)) 2 50) " " (rtos (nth 3 (caddr 3dmatrix)) 2 50) ")"
                  "(" (rtos (nth 0 (cadddr 3dmatrix)) 2 50) " " (rtos (nth 1 (cadddr 3dmatrix)) 2 50) " " (rtos (nth 2 (cadddr 3dmatrix)) 2 50) " " (rtos (nth 3 (cadddr 3dmatrix)) 2 50) "))"
         )
  )
  (textpage)
  (princ)
)

If hatch is block object (you said that you can obtain matrix by nentselp) this should return your block to its original scale and orientation...

M.R.

EDIT : changed line :
(setq obj (vlax-ename->vla-object (car (cadddr nents))))
into
(setq obj (vlax-ename->vla-object (last (cadddr nents))))

This way it will always be transformed most parent Xref or block in nesting tree...
« Last Edit: January 08, 2012, 05:24:58 AM by ribarm »
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube