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

Select all 
;;------------------=={ 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

Select all 
(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

Select all 
(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

Select all 
(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

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

Select all 
(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

Select all 
;;----------------=={ 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

Select all 
(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

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

textsize

increase · reset · decrease

Designed & Created by Lee Mac © 2010