Matrix Transformation Functions
I have put together a library of subfunctions enabling the user to transform a VLA-Object or Vertex Point List using a Transformation Matrix.
Transformation Matrices may be used to apply a linear transformation, such as a rotation or translation, to a set of points encoding vertices of an object. Through the use of the Visual LISP vla-transformby function, these transformations may also be applied directly to a supplied VLA-Object.
The subfunctions included below allow the user to supply either a Vertex Point List or VLA-Object as the 'target' of the transformation and the relevant matrix will be applied to manipulate the target in the desired way.
2D Transformations
;;------------------=={ Scale by Matrix }==-------------------;; ;; ;; ;; Scales a VLA-Object or Point List using a ;; ;; Transformation Matrix ;; ;;------------------------------------------------------------;; ;; Author: Lee Mac, Copyright © 2010 - www.lee-mac.com ;; ;;------------------------------------------------------------;; ;; Arguments: ;; ;; target - VLA-Object or Point List to transform ;; ;; p1 - Base Point for Scaling Transformation ;; ;; scale - Scale Factor by which to scale object ;; ;;------------------------------------------------------------;; (defun LM:ScaleByMatrix ( target p1 scale / m ) (LM:ApplyMatrixTransformation target (setq m (list (list scale 0. 0.) (list 0. scale 0.) (list 0. 0. scale) ) ) (mapcar '- p1 (mxv m p1)) ) ) ;;----------------=={ Translate by Matrix }==-----------------;; ;; ;; ;; Translates a VLA-Object or Point List using a ;; ;; Transformation Matrix ;; ;;------------------------------------------------------------;; ;; Author: Lee Mac, Copyright © 2010 - www.lee-mac.com ;; ;;------------------------------------------------------------;; ;; Arguments: ;; ;; target - VLA-Object or Point List to transform ;; ;; p1, p2 - Points representing vector by which to translate ;; ;;------------------------------------------------------------;; (defun LM:TranslateByMatrix ( target p1 p2 ) (LM:ApplyMatrixTransformation target (list (list 1. 0. 0.) (list 0. 1. 0.) (list 0. 0. 1.) ) (mapcar '- p2 p1) ) ) ;;------------------=={ Rotate by Matrix }==------------------;; ;; ;; ;; Rotates a VLA-Object or Point List using a ;; ;; Transformation Matrix ;; ;;------------------------------------------------------------;; ;; Author: Lee Mac, Copyright © 2010 - www.lee-mac.com ;; ;;------------------------------------------------------------;; ;; Arguments: ;; ;; target - VLA-Object or Point List to transform ;; ;; p1 - Base Point for Rotation Transformation ;; ;; ang - Angle through which to rotate object ;; ;;------------------------------------------------------------;; (defun LM:RotateByMatrix ( target p1 ang ) (LM:ApplyMatrixTransformation target (setq m (list (list (cos ang) (- (sin ang)) 0.) (list (sin ang) (cos ang) 0.) (list 0. 0. 1.) ) ) (mapcar '- p1 (mxv m p1)) ) ) ;;-----------------=={ Reflect by Matrix }==------------------;; ;; ;; ;; Reflects a VLA-Object or Point List using a ;; ;; Transformation Matrix ;; ;;------------------------------------------------------------;; ;; Author: Lee Mac, Copyright © 2010 - www.lee-mac.com ;; ;;------------------------------------------------------------;; ;; Arguments: ;; ;; target - VLA-Object or Point List to transform ;; ;; p1, p2 - Points representing vector in which to reflect ;; ;;------------------------------------------------------------;; (defun LM:ReflectByMatrix ( target p1 p2 ) ( (lambda ( a / m ) (LM:ApplyMatrixTransformation target (setq m (list (list (cos a) (sin a) 0.) (list (sin a) (- (cos a)) 0.) (list 0. 0. 1.) ) ) (mapcar '- p1 (mxv m p1)) ) ) (* 2. (angle p1 p2)) ) ) ;;-----------=={ Apply Matrix Transformation }==--------------;; ;; ;; ;; Transforms a VLA-Object or Point List using a ;; ;; Transformation Matrix ;; ;;------------------------------------------------------------;; ;; Author: Lee Mac, Copyright © 2010 - www.lee-mac.com ;; ;;------------------------------------------------------------;; ;; Arguments: ;; ;; target - VLA-Object or Point List to Transform ;; ;; matrix - 3x3 Matrix by which to Transform object ;; ;; vector - 3D translation vector ;; ;;------------------------------------------------------------;; (defun LM:ApplyMatrixTransformation ( target matrix vector ) (vl-load-com) (cond ( (eq 'VLA-OBJECT (type target)) (vla-TransformBy target (vlax-tMatrix (append (mapcar '(lambda ( x v ) (append x (list v))) matrix vector) '((0. 0. 0. 1.)) ) ) ) ) ( (listp target) (mapcar (function (lambda ( point ) (mapcar '+ (mxv matrix point) vector)) ) target ) ) ) ) ;; Matrix x Vector - Vladimir Nesterovsky ;; Args: m - nxn matrix, v - vector in R^n (defun mxv ( m v ) (mapcar '(lambda ( r ) (apply '+ (mapcar '* r v))) m) )
Test Functions
I have furthermore assembled a complete set of example functions to demonstrate how to call the above subfunctions with the correct arguments and moreover illustrate the effect of applying each transformation.
Scaling Test Functions
(defun c:scaleobject ( / e p s ) (if (and (setq e (car (entsel))) (setq p (getpoint "\nBase Point: ")) (setq s (getdist "\nScale: " p)) ) (LM:ScaleByMatrix (vlax-ename->vla-object e) (trans p 1 0) s) ) (princ) ) (defun c:scalelist ( / e p s ) (if (and (setq e (car (entsel))) (eq "LWPOLYLINE" (cdr (assoc 0 (entget e)))) (setq p (getpoint "\nBase Point: ")) (setq s (getdist "\nScale: " p)) ) (LWPolyline (LM:ScaleByMatrix (Vertices e) (trans p 1 0) s) (cdr (assoc 70 (entget e))) ) ) (princ) )
Translation Test Functions
(defun c:translateobject ( / e p q ) (if (and (setq e (car (entsel))) (setq p (getpoint "\nBase Point: ")) (setq q (getpoint "\nDisplacement: " p)) ) (LM:TranslateByMatrix (vlax-ename->vla-object e) (trans p 1 0) (trans q 1 0)) ) (princ) ) (defun c:translatelist ( / e p q ) (if (and (setq e (car (entsel))) (eq "LWPOLYLINE" (cdr (assoc 0 (entget e)))) (setq p (getpoint "\nBase Point: ")) (setq q (getpoint "\nDisplacement: " p)) ) (LWPolyline (LM:TranslateByMatrix (Vertices e) (trans p 1 0) (trans q 1 0)) (cdr (assoc 70 (entget e))) ) ) (princ) )
Rotation Test Functions
(defun c:rotateobject ( / e p a ) (if (and (setq e (car (entsel))) (setq p (getpoint "\nBase Point: ")) (setq a (getangle "\nRotation: " p)) ) (LM:RotateByMatrix (vlax-ename->vla-object e) (trans p 1 0) a) ) (princ) ) (defun c:rotatelist ( / e p a ) (if (and (setq e (car (entsel))) (eq "LWPOLYLINE" (cdr (assoc 0 (entget e)))) (setq p (getpoint "\nBase Point: ")) (setq a (getangle "\nRotation: " p)) ) (LWPolyline (LM:RotateByMatrix (Vertices e) (trans p 1 0) a) (cdr (assoc 70 (entget e))) ) ) (princ) )
Reflection Test Functions
(defun c:reflectobject ( / e p q ) (if (and (setq e (car (entsel))) (setq p (getpoint "\nBase Point: ")) (setq q (getpoint "\nSecond Point of Reflection Vector: " p)) ) (LM:ReflectByMatrix (vlax-ename->vla-object e) (trans p 1 0) (trans q 1 0)) ) (princ) ) (defun c:reflectlist ( / e p q ) (if (and (setq e (car (entsel))) (eq "LWPOLYLINE" (cdr (assoc 0 (entget e)))) (setq p (getpoint "\nBase Point: ")) (setq q (getpoint "\nSecond Point of Reflection Vector: " p)) ) (LWPolyline (LM:ReflectByMatrix (Vertices e) (trans p 1 0) (trans q 1 0)) (cdr (assoc 70 (entget e))) ) ) (princ) )
Test Function Subfunctions
(The above functions require these to run)
(defun LWPolyline ( l c ) (entmakex (append (list (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 100 "AcDbPolyline") (cons 90 (length l)) (cons 70 c) ) (mapcar '(lambda ( p ) (cons 10 p)) l) ) ) ) (defun Vertices ( e ) (mapcar '(lambda ( x ) (append x (list 0.0))) (mapcar 'cdr (vl-remove-if-not '(lambda ( x ) (= 10 (car x))) (entget e)) ) ) )
3D Transformations
;;----------------=={ 3D Rotate by Matrix }==-----------------;; ;; ;; ;; Rotates a VLA-Object or Point List about a 3D axis using ;; ;; a Transformation matrix. ;; ;;------------------------------------------------------------;; ;; Author: Lee Mac, Copyright © 2011 - www.lee-mac.com ;; ;;------------------------------------------------------------;; ;; Arguments: ;; ;; target - VLA-Object or Point List to Rotate ;; ;; p1,p2 - Two 3D points defining the axis of rotation ;; ;; ang - Rotation Angle ;; ;;------------------------------------------------------------;; (defun LM:Rotate3D ( target p1 p2 ang / ux uy uz ) (mapcar 'set '(ux uy uz) (setq u (unit (mapcar '- p2 p1)))) (LM:ApplyMatrixTransformation target (setq m (m+m (list (list (cos ang) 0. 0.) (list 0. (cos ang) 0.) (list 0. 0. (cos ang)) ) (m+m (mxs (list (list 0. (- uz) uy) (list uz 0. (- ux)) (list (- uy) ux 0.) ) (sin ang) ) (mxs (mapcar '(lambda ( e ) (vxs u e)) u) (- 1. (cos ang))) ) ) ) (mapcar '- p1 (mxv m p1)) ) ) ;;----------------=={ 3D Reflect by Matrix }==----------------;; ;; ;; ;; Reflects a VLA-Object or Point List in a plane using a ;; ;; Transformation matrix. ;; ;;------------------------------------------------------------;; ;; Author: Lee Mac, Copyright © 2011 - www.lee-mac.com ;; ;;------------------------------------------------------------;; ;; Arguments: ;; ;; target - VLA-Object or Point List to Reflect ;; ;; p1,p2,p3 - Three 3D points defining the reflection plane ;; ;;------------------------------------------------------------;; (defun LM:Reflect3D ( target p1 p2 p3 / m u ux uy uz ) (mapcar 'set '(ux uy uz) (setq u (unit (v^v (mapcar '- p2 p1) (mapcar '- p3 p1))))) (LM:ApplyMatrixTransformation target (setq m (list (list (- 1. (* 2. ux ux)) (* -2. uy ux) (* -2. ux uz)) (list (* -2. ux uy) (- 1. (* 2. uy uy)) (* -2. uy uz)) (list (* -2. ux uz) (* -2. uy uz) (- 1. (* 2. uz uz))) ) ) (mapcar '- p1 (mxv m p1)) ) ) ;;-----------=={ Apply Matrix Transformation }==--------------;; ;; ;; ;; Transforms a VLA-Object or Point List using a ;; ;; Transformation Matrix ;; ;;------------------------------------------------------------;; ;; Author: Lee Mac, Copyright © 2010 - www.lee-mac.com ;; ;;------------------------------------------------------------;; ;; Arguments: ;; ;; target - VLA-Object or Point List to Transform ;; ;; matrix - 3x3 Matrix by which to Transform object ;; ;; vector - 3D translation vector ;; ;;------------------------------------------------------------;; (defun LM:ApplyMatrixTransformation ( target matrix vector ) (vl-load-com) (cond ( (eq 'VLA-OBJECT (type target)) (vla-TransformBy target (vlax-tMatrix (append (mapcar '(lambda ( x v ) (append x (list v))) matrix vector) '((0. 0. 0. 1.)) ) ) ) ) ( (listp target) (mapcar (function (lambda ( point ) (mapcar '+ (mxv matrix point) vector)) ) target ) ) ) ) ;; Matrix x Vector - Vladimir Nesterovsky ;; Args: m - nxn matrix, v - vector in R^n (defun mxv ( m v ) (mapcar '(lambda ( r ) (apply '+ (mapcar '* r v))) m) ) ;; Matrix x Scalar - Lee Mac ;; Args: m - nxn matrix, n - real scalar (defun mxs ( m s ) (mapcar '(lambda ( r ) (mapcar '(lambda ( n ) (* n s)) r)) m) ) ;; Matrix + Matrix - Lee Mac ;; Args: m,n - nxn matrices (defun m+m ( m n ) (mapcar '(lambda ( r s ) (mapcar '+ r s)) m n) ) ;; Vector Norm - Lee Mac ;; Args: v - vector in R^n (defun norm ( v ) (sqrt (apply '+ (mapcar '* v v))) ) ;; Vector x Scalar - Lee Mac ;; Args: v - vector in R^n, s - real scalar (defun vxs ( v s ) (mapcar '(lambda ( n ) (* n s)) v) ) ;; Unit Vector - Lee Mac ;; Args: v - vector in R^n (defun unit ( v ) ( (lambda ( n ) (if (equal 0.0 n 1e-14) nil (vxs v (/ 1.0 n)))) (norm 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))) ) )
Test Functions
Rotation Test Functions
(defun c:rotateobject ( / e p q a ) (if (and (setq e (car (entsel))) (setq p (getpoint "\nFirst Point of Rotation Axis: ")) (setq q (getpoint p "\nSecond Point of Rotation Axis: ")) (setq a (getangle "\nRotation: " p)) ) (LM:Rotate3D (vlax-ename->vla-object e) (trans p 1 0) (trans q 1 0) a) ) (princ) ) (defun c:rotatelist ( / l p q a ) (if (and (car (setq l (list (getpoint "\nSpecify First Point: ")))) (progn (while (car (setq l (cons (getpoint "\nNext Point: ") l)))) (setq p (getpoint "\nFirst Point of Rotation Axis: ")) ) (setq q (getpoint p "\nSecond Point of Rotation Axis: ")) (setq a (getangle "\nRotation: " p)) ) (foreach p (LM:Rotate3D (mapcar '(lambda ( x ) (trans x 1 0)) (cdr l)) (trans p 1 0) (trans q 1 0) a ) (entmakex (list (cons 0 "POINT") (cons 10 p))) ) ) (princ) )
Reflection Test Functions
(defun c:reflectobject ( / e p1 p2 p3 ) (if (and (setq e (car (entsel))) (setq p1 (getpoint "\nFirst Point of Reflection Plane: ")) (setq p2 (getpoint "\nSecond Point of Reflection Plane: " p1)) (setq p3 (getpoint "\nThird Point of Reflection Plane: " p1)) ) (LM:Reflect3D (vlax-ename->vla-object e) (trans p1 1 0) (trans p2 1 0) (trans p3 1 0)) ) (princ) ) (defun c:reflectlist ( / l p1 p2 p3 ) (if (and (car (setq l (list (getpoint "\nSpecify First Point: ")))) (progn (while (car (setq l (cons (getpoint "\nNext Point: ") l)))) (setq p1 (getpoint "\nFirst Point of Reflection Plane: ")) ) (setq p2 (getpoint "\nSecond Point of Reflection Plane: " p1)) (setq p3 (getpoint "\nThird Point of Reflection Plane: " p1)) ) (foreach p (LM:Reflect3D (mapcar '(lambda ( x ) (trans x 1 0)) (cdr l)) (trans p1 1 0) (trans p2 1 0) (trans p3 1 0) ) (entmakex (list (cons 0 "POINT") (cons 10 p))) ) ) (princ) )