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