UCS的变换矩阵及其逆变换矩阵

Highflybird

这里提供一个函数，得到当前UCS下的变化矩阵和逆变换矩阵。

[pcode=lisp,true]
;;;UCS到WCS的变换矩阵及其WCS到UCS的变换矩阵                             
;;;the transformation matrix of UCS to WCS and WCS to UCS.              
(defun UCS2WCS (/ xdir ydir zdir UcsOrg WcsOrg matlst revlst matrix)
  (defun AppendMatrix (lst org)
    (append
      (mapcar 'append lst (mapcar 'list org))
      '((0. 0. 0. 1.))
    )
  )
  (if (zerop (getvar "WORLDUCS"))                    ;如果不同于WCS
    (setq xdir   (getvar "UCSXDIR")                     ;X方向
             ydir   (getvar "UCSYDIR")                     ;Y方向
             zdir   (G:CrossProductor xdir ydir)         ;Z方向等于X方向叉乘Y方向
             UcsOrg (getvar "UCSORG")                  ;UCS原点
             WcsOrg (trans '(0 0 0) 0 1)                   ;WCS原点相对于UCS的坐标
             matLst (list xdir ydir zdir)                        ;UCS的旋转矩阵
             RevLst (trp matLst)                               ;UCS的旋转矩阵的逆
             matrix (list
                      (AppendMatrix matlst WcsOrg)        ;UCS到WCS的变换矩阵
                      (AppendMatrix RevLst UcsOrg)        ;WCS到UCS的变换矩阵
                    )
    )
    (list
      '((1. 0. 0. 0.) (0. 1. 0. 0.) (0. 0. 1. 0.) (0. 0. 0. 1.))  ;世界坐标系下是单位矩阵
      '((1. 0. 0. 0.) (0. 1. 0. 0.) (0. 0. 1. 0.) (0. 0. 0. 1.))  ;世界坐标系下是单位矩阵
    )
  )
)

;;; 矢量的点积                                                         
;;; VXV Returns the dot product of 2 vectors                           
(defun vxv (v1 v2)
  (apply '+ (mapcar '* v1 v2))
)
;;; 矢量转置                                                            
;;; TRP Transpose a matrix -Doug Wilson-                                
(defun trp (m)
  (apply 'mapcar (cons 'list m))
)
;;; 矢量的矩阵变换                                                      
;;; MXV Apply a transformation matrix to a vector -Vladimir Nesterovsky-
(defun mxv (m v)
  (mapcar (function (lambda (r) (vxv r v))) m)
)
;;; 矩阵相乘                                                            
;;; MXM Multiply two matrices -Vladimir Nesterovsky-                    
(defun mxm (m q)
  (mapcar (function (lambda (r) (mxv (trp q) r))) m)
)
;;;两矢量的叉积                                                         
;;; CrossProductor --vec1 * vec2                                       
(defun G:CrossProductor (vec1 vec2 / a b c d e f)                 
  (setq a (car   vec1))
  (setq b (cadr  vec1))
  (setq c (caddr vec1))
  (setq d (car   vec2))
  (setq e (cadr  vec2))
  (setq f (caddr vec2))
  (list
    (- (* b f) (* c e))
    (- (* c d) (* a f))
    (- (* a e) (* b d))
  )
)
[/pcode]

以下作为测试
[pcode=lisp,true]                                                  
(defun c:test(/ ent obj mat)
  (if (setq ent (car (entsel)))
    (progn
      (setq obj (vlax-ename->vla-object ent))
      (setq mat (ucs2wcs))
      (vla-TransformBy obj (vlax-tmatrix (car  mat)))                   ;UCS->WCS
      (command ".select" ent pause)
      (vla-TransformBy obj (vlax-tmatrix (cadr mat)))                  ;WCS->UCS
    )
  )
)
[/pcode]

Highflybird

Lee Mac 的，更简洁
[pcode=lisp,true]

(defun LM:UCS2WCS nil
  (append
    (mapcar 'append
      (mapcar
        (function
          (lambda ( v ) (trans v 1 0 t))
        )
       '((1. 0. 0.) (0. 1. 0.) (0. 0. 1.))
      )
      (mapcar 'list (trans '(0. 0. 0.) 0 1))
    )
   '((0. 0. 0. 1.))
  )
)

(defun LM:WCS2UCS nil
  (append
    (mapcar 'append
      (mapcar
        (function
          (lambda ( v ) (trans v 0 1 t))
        )
       '((1. 0. 0.) (0. 1. 0.) (0. 0. 1.))
      )
      (mapcar 'list (trans '(0. 0. 0.) 1 0))
    )
   '((0. 0. 0. 1.))
  )
)
[/pcode]

Highflybird

[pcode=lisp,true]


;;;Hence the code would only be able to create a transformation matrix to transfrom from WCS to
;;;a coordinate system with origin, normal and rotation as supplied.
下面的代码可以创建一个变换矩阵，这个矩阵定义了原点，法线，和旋转角度。
(defun LM:UCSMatrix ( org norm ang )
  (append
    (mapcar 'append
      (mxm
        (mapcar
          (function
            (lambda ( v ) (trans v 0 norm t))
          )
         '((1. 0. 0.) (0. 1. 0.) (0. 0. 1.))
        )
        (list
          (list (cos ang) (- (sin ang)) 0.)
          (list (sin ang)    (cos ang)  0.)
          (list    0.            0.     1.)
        )
      )
      (mapcar 'list (trans org norm 0))
    )
   '((0. 0. 0. 1.))
  )
)

;; Matrix x Vector  ~  Vladimir Nesterovsky
(defun mxv ( mat vec )
  (mapcar '(lambda ( row ) (apply '+ (mapcar '* row vec))) mat)
)

;; Matrix x Matrix  ~  Vladimir Nesterovsky
(defun mxm ( m q )
  (mapcar (function (lambda ( r ) (mxv (trp q) r))) m)
)

;; Matrix Transpose  ~  Doug Wilson
(defun trp ( m )
  (apply 'mapcar (cons 'list m))
)
[/pcode]

Highflybird

顺便说一下：
我开始的矩阵变换还是有用的：

如果一个坐标系统是定义成(UCSorg UCSXDir UCSYDir) -->CAD中UCS定义的方法
那么可按照下面的函数得到转换矩阵和逆转换矩阵。
[pcode=lisp,true]
;;;UCS变换矩阵
(defun UCSMatrix (Org xAxis yAxis / d1 d2 xNrm yNrm zNrm RotMat InvMat
                      WcsOrg UCS->WCS WCS->UCS matrix)
  (setq d1 (distance '(0 0 0) xAxis))
  (setq d2 (distance '(0 0 0) yAxis))
  (if (or (zerop d1) (zerop d2))
    '((1. 0. 0. 0.) (0. 1. 0. 0.) (0. 0. 1. 0.) (0. 0. 0. 1.))
    (setq xNrm    (mapcar '/ xAxis (list d1 d1 d1))    ;X Axis
   yNrm    (mapcar '/ yAxis (list d2 d2 d2))    ;Y Axis
   zNrm    (G:CrossProductor xNrm yNrm)    ;Z Axis
   RotMat   (list xNrm yNrm zNrm)     ;Rotation matrix
   InvMat   (trp RotMat)      ;Inverse Rotation matrix
   WcsOrg   (mxv RotMat (mapcar '- Org))    ;The coordinate of WCS origin relate to UCS
   UCS->WCS (append (mapcar 'append RotMat (mapcar 'list WcsOrg))  '((0. 0. 0. 1.)))         
   WCS->UCS (append (mapcar 'append InvMat (mapcar 'list Org)) '((0. 0. 0. 1.)))
   matrix   (list UCS->WCS WCS->UCS)    ;return two matrices
    )
  )
)
[/pcode]
例如下面的测试：
[pcode=lisp,true]
(defun c:test()
  (if (setq Ent (car (entsel)))
    (progn
      (setq Org (getvar "ucsorg"))
      (setq XDr (getvar "ucsxdir"))
      (setq ydr (getvar "ucsydir"))
      (setq Obj (vlax-ename->vla-object Ent))
      (setq Mat (UCSMatrix Org xdr ydr))
      (vla-TransformBy Obj (vlax-tmatrix (car  Mat)))                   ;UCS->WCS
      (command ".select" ent pause)
      (vla-TransformBy Obj (vlax-tmatrix (cadr Mat)))                   ;WCS->UCS
    )
  )
)[/pcode]


另外附上旋转矩阵函数：
这个旋转矩阵的参数是（旋转角度，旋转轴，旋转基点)
[pcode=lisp,true]
;;;Ang ---旋转角度
;;;Nrm ---旋转轴（矢量）(WCS下的)
;;;Org ---旋转基点 (WCS下的)
(defun RotationMatrix (Ang Nrm Org / A B C dist M N PT WX WY WZ)
  (setq dist (distance '(0 0 0) Nrm))
  (if (> dist 1e-8)
    (setq N  (mapcar '/ nrm (list dist dist dist))
   wx (car N)
   wy (cadr N)
   wz (caddr N)
   A  (cos Ang)
   B  (sin Ang)
   C  (- 1 A)
   M  (list (list (+ A (* wx wx C))
    (- (* wx wy C) (* wz B))
    (+ (* wy B) (* wx wz C))
     )
     (list (+ (* wz B) (* wx wy C))
    (+ A (* wy wy C))
    (- (* wy wz C) (* wx B))
     )
     (list (- (* wx wz C) (* wy B))
    (+ (* wx B) (* wy wz C))
    (+ A (* wz wz C))
     )
      )
   pt (mapcar '- org (mxv M org))
   M  (append (mapcar 'append M (mapcar 'list pt))
       '((0. 0. 0. 1.))
      )
    )
    '((1. 0. 0. 0.) (0. 1. 0. 0.) (0. 0. 1. 0.) (0. 0. 0. 1.))
  )
)
[/pcode]


例如下面的测试例子:


[pcode=lisp,true]
(defun c:ttt (/ Ent Obj Mat Org Vec Ang Nrm)
  (setq app (vlax-get-acad-object))
  (setq doc (vla-get-ActiveDocument app))
  (setq ucs (vla-get-UserCoordinateSystems doc))
  (setq i 0)
  (repeat (vla-get-Count ucs)
    (setq u (vla-item ucs i))
    (vlax-dump-object u  T)
    (setq i (1+ i))   
  )
  (if (and (setq Ent (car (entsel)))
    (setq Org (getpoint "\nInput origin point of rotation:"))
    (setq Vec (getpoint Org "\nInput the Axis vector of rotation:"))
    (setq Ang (getangle "\nInput the angle of rotation:"))
      )
    (progn
      (setq Org (trans Org 1 0))
      (setq Vec (trans Vec 1 0))
      (setq Nrm (mapcar '- Vec Org))
      (setq Obj (vlax-ename->vla-object Ent))
      (setq Mat (RotationMatrix Ang Nrm Org))
      (vla-TransformBy Obj (vlax-tmatrix Mat))                   ;旋转矩阵
    )
  )
)
[/pcode]

zteykmgscqh

值得学习一下，虽然对矩阵不了解