[LSP函数]求逆矩阵。

eachy · 发表于 2003-2-11 21:42:13

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

(defun ea:matrix_inverse (matrix / m0 m1 m2 m3 m00 m01 m02 m03 m10 m11 m12 m13 m20 m21 m22 m23 _a ea:determinant a11 a12
a21 a22 a33 a34 a41 a42 a43 a13 a23 a31 a32
) ; 行列式展开，计算代数余子式
(defun ea:determinant (a00 a01 a02 a10 a11 a12 a20 a21 a22 /)
(- (+ (* a00 a11 a22) (* a01 a12 a20) (* a02 a21 a10)) (* a02 a11 a20) (* a01 a10 a22) (* a00 a21 a12))
)
(setq m0 (car matrix)
m1 (cadr matrix)
m2 (nth 2 matrix)
m3 (last matrix)
)
(setq m00 (car m0)
m01 (cadr m0)
m02 (nth 2 m0)
m03 (last m0)
)
(setq m10 (car m1)
m11 (cadr m1)
m12 (nth 2 m1)
m13 (last m1)
)
(setq m20 (car m2)
m21 (cadr m2)
m22 (nth 2 m2)
m23 (last m2)
)
(setq a11 (ea:determinant m11 m12 m13 m21 m22 m23 0.0 0.0 1.0)
a12 (- (ea:determinant m10 m12 m13 m20 m22 m23 0.0 0.0 1.0))
a13 (ea:determinant m10 m11 m13 m20 m21 m23 0.0 0.0 1.0)
a21 (- (ea:determinant m01 m02 m03 m21 m22 m23 0.0 0.0 1.0))
a22 (ea:determinant m00 m02 m03 m20 m22 m23 0.0 0.0 1.0)
a23 (- (ea:determinant m00 m01 m03 m20 m21 m23 0.0 0.0 1.0))
a31 (ea:determinant m01 m02 m03 m11 m12 m13 0.0 0.0 1.0)
a32 (- (ea:determinant m00 m02 m03 m10 m12 m13 0.0 0.0 1.0))
a33 (ea:determinant m00 m01 m03 m10 m11 m13 0.0 0.0 1.0)
a41 (- (ea:determinant m01 m02 m03 m11 m12 m13 m21 m22 m23))
a42 (ea:determinant m00 m02 m03 m10 m12 m13 m20 m22 m23)
a43 (- (ea:determinant m00 m01 m03 m10 m11 m13 m20 m21 m23))
)
(list (list a11 a21 a31 a41) (list a12 a22 a32 a42) (list a13 a23 a33 a43) '(0.0 0.0 0.0 1.0))
)

(defun ea:matrix_inverse (matrix / m0 m1 m2 m3 m00 m01 m02 m03 m10 m11 m12 m13 m20 m21 m22 m23 _a ea:determinant a11 a12 
                                 a21 a22 a33 a34 a41 a42 a43 a13 a23 a31 a32 
                         )               ; 行列式展开，计算代数余子式 
  (defun ea:determinant (a00 a01 a02 a10 a11 a12 a20 a21 a22 /) 
    (- (+ (* a00 a11 a22) (* a01 a12 a20) (* a02 a21 a10)) (* a02 a11 a20) (* a01 a10 a22) (* a00 a21 a12)) 
  ) 
  (setq m0 (car matrix) 
        m1 (cadr matrix) 
        m2 (nth 2 matrix) 
        m3 (last matrix) 
  ) 
  (setq m00 (car m0) 
        m01 (cadr m0) 
        m02 (nth 2 m0) 
        m03 (last m0) 
  ) 
  (setq m10 (car m1) 
        m11 (cadr m1) 
        m12 (nth 2 m1) 
        m13 (last m1) 
  ) 
  (setq m20 (car m2) 
        m21 (cadr m2) 
        m22 (nth 2 m2) 
        m23 (last m2) 
  ) 
  (setq a11 (ea:determinant m11 m12 m13 m21 m22 m23 0.0 0.0 1.0) 
        a12 (- (ea:determinant m10 m12 m13 m20 m22 m23 0.0 0.0 1.0)) 
        a13 (ea:determinant m10 m11 m13 m20 m21 m23 0.0 0.0 1.0) 
        a21 (- (ea:determinant m01 m02 m03 m21 m22 m23 0.0 0.0 1.0)) 
        a22 (ea:determinant m00 m02 m03 m20 m22 m23 0.0 0.0 1.0) 
        a23 (- (ea:determinant m00 m01 m03 m20 m21 m23 0.0 0.0 1.0)) 
        a31 (ea:determinant m01 m02 m03 m11 m12 m13 0.0 0.0 1.0) 
        a32 (- (ea:determinant m00 m02 m03 m10 m12 m13 0.0 0.0 1.0)) 
        a33 (ea:determinant m00 m01 m03 m10 m11 m13 0.0 0.0 1.0) 
        a41 (- (ea:determinant m01 m02 m03 m11 m12 m13 m21 m22 m23)) 
        a42 (ea:determinant m00 m02 m03 m10 m12 m13 m20 m22 m23) 
        a43 (- (ea:determinant m00 m01 m03 m10 m11 m13 m20 m21 m23)) 
  ) 
  (list (list a11 a21 a31 a41) (list a12 a22 a32 a42) (list a13 a23 a33 a43) '(0.0 0.0 0.0 1.0)) 
)

LUCAS · 发表于 2003-2-14 09:19:33

;;图块比例 x=1 y=1 z=1时转换正确,但当比例不为1时(如-1 or 0.5),要如何修改比例
;;-------------------------------------------------------------------------------------------------
(defun C:TT (/ WW)
(vla-transformby
(vlax-ename->vla-object (car (entsel "\n选取转换对象:")))
(vlax-tmatrix
(EA:MATRIX_INVERSE
(caddr (nentselp "\n选取要对齐UCS的图块:"))
)
)
)
)
;;-----功能同上程序-------------------------------------------------
(defun C:TT ()
(defun M_MX_BLK (IP SX SY SZ RT)
(list
(list (* SX (cos RT)) (* SY -1.0 (sin RT)) 0.0 (car IP))
(list (* SX (sin RT)) (* SY (cos RT)) 0.0 (cadr IP))
(list 0.0 0.0 SZ (caddr IP))
(list 0.0 0.0 0.0 1.0)
)
)
(setq EL (entget (car (entsel "\n选取要对齐UCS的图块:")))
TRMX (M_MX_BLK (cdr (assoc 10 EL))
(cdr (assoc 41 EL))
(cdr (assoc 42 EL))
(cdr (assoc 43 EL))
(cdr (assoc 50 EL))
)
)
(vla-transformby
(vlax-ename->vla-object (car (entsel "\n选取转换对象:")))
(vlax-tmatrix (EA:MATRIX_INVERSE TRMX))
)
)

;;图块比例 x=1 y=1 z=1时转换正确,但当比例不为1时(如-1 or 0.5),要如何修改比例 
;;------------------------------------------------------------------------------------------------- 
 (defun C:TT (/ WW) 
  (vla-transformby 
    (vlax-ename->vla-object (car (entsel "\n选取转换对象:"))) 
    (vlax-tmatrix 
      (EA:MATRIX_INVERSE 
        (caddr (nentselp "\n选取要对齐UCS的图块:")) 
      ) 
    ) 
  ) 
) 
 
;;-----功能同上程序------------------------------------------------- 
(defun C:TT () 
  (defun M_MX_BLK (IP SX SY SZ RT) 
    (list 
      (list (* SX (cos RT)) (* SY -1.0 (sin RT)) 0.0 (car IP)) 
      (list (* SX (sin RT)) (* SY (cos RT)) 0.0 (cadr IP)) 
      (list 0.0 0.0 SZ (caddr IP)) 
      (list 0.0 0.0 0.0 1.0) 
    ) 
  ) 
  (setq        EL   (entget (car (entsel "\n选取要对齐UCS的图块:"))) 
        TRMX (M_MX_BLK (cdr (assoc 10 EL)) 
                       (cdr (assoc 41 EL)) 
                       (cdr (assoc 42 EL)) 
                       (cdr (assoc 43 EL)) 
                       (cdr (assoc 50 EL)) 
             ) 
  ) 
  (vla-transformby 
    (vlax-ename->vla-object (car (entsel "\n选取转换对象:"))) 
    (vlax-tmatrix (EA:MATRIX_INVERSE TRMX)) 
  ) 
)

eachy · 发表于 2003-2-14 16:24:21

((x1 x2 x3 x4) -----------------X比例
(y1 y2 y3 y4) ----------------Y比例
(z1 z2 z3 z4) -----------------Z比例
(0.0 0.0 0.0 1.0)
)
最后一列是构造平移的，x1 y1 z1 x2 y2 z2 乘以一个余弦就是旋转矩阵。

复制代码

LUCAS · 发表于 2003-2-18 13:16:55

;|
;;----------------------------------------------------------------------
;;按你说的,好像不行???
(defun MREV (A B / N U V)
(setq N 0)
(repeat (- (length A) 1)
(setq U (cons (mapcar '(lambda (V) (* (nth N B) V)) (nth N A)) U)
N (1+ N)
)
)
(append (reverse U) (list (nth 3 A)))
)
(defun C:TT (/ TM TMP)
(setq TM (nentselp "\n选取要对齐UCS的图块:"))
(setq TMP (vlax-ename->vla-object (car (last TM))))
(vla-transformby
(vlax-ename->vla-object (car (entsel "\n选取转换对象:")))
(vlax-tmatrix
(MREV (EA:MATRIX_INVERSE
(caddr TM)
)
(list (/ 1 (vla-get-xscalefactor TMP))
(/ 1 (vla-get-yscalefactor TMP))
(/ 1 (vla-get-zscalefactor TMP))
)
)
)
)
)
;;----------------------------------------------------------------------
|;
;;----------------------------------------------------------------------
;;功能:把对象退回原图块位置
;;X Y Z比例相同时,这样做可以,但比例不同要如何做???
(defun MREV (A B / N U V)
(setq N 0)
(repeat (- (length A) 1)
(setq U (cons (mapcar '(lambda (V) (* B V)) (nth N A)) U)
N (1+ N)
)
)
(append (reverse U) (list (nth 3 A)))
)
(defun C:TT1 (/ TM TMP)
(setq TM (nentselp "\n选取要对齐UCS的图块:"))
(setq TMP (vlax-ename->vla-object (car (last TM))))
(vla-transformby
(vlax-ename->vla-object (car (entsel "\n选取转换对象:")))
(vlax-tmatrix
(MREV (EA:MATRIX_INVERSE
(caddr TM)
)
(* (/ 1 (vla-get-xscalefactor TMP))
(/ 1 (vla-get-yscalefactor TMP))
(/ 1 (vla-get-zscalefactor TMP))
)
)
)
)
)
;;----------------------------------------------------------------------

;| 
;;---------------------------------------------------------------------- 
;;按你说的,好像不行??? 
(defun MREV (A B / N U V) 
  (setq N 0) 
  (repeat (- (length A) 1) 
    (setq U (cons (mapcar '(lambda (V) (* (nth N B) V)) (nth N A)) U) 
          N (1+ N) 
    ) 
  ) 
  (append (reverse U) (list (nth 3 A))) 
) 
 
(defun C:TT (/ TM TMP) 
  (setq TM (nentselp "\n选取要对齐UCS的图块:")) 
  (setq TMP (vlax-ename->vla-object (car (last TM)))) 
  (vla-transformby 
    (vlax-ename->vla-object (car (entsel "\n选取转换对象:"))) 
    (vlax-tmatrix 
      (MREV (EA:MATRIX_INVERSE 
              (caddr TM) 
            ) 
            (list (/ 1 (vla-get-xscalefactor TMP)) 
                  (/ 1 (vla-get-yscalefactor TMP)) 
                  (/ 1 (vla-get-zscalefactor TMP)) 
            ) 
      ) 
    ) 
  ) 
) 
;;---------------------------------------------------------------------- 
|; 
 
;;---------------------------------------------------------------------- 
;;功能:把对象退回原图块位置 
;;X Y Z比例相同时,这样做可以,但比例不同要如何做??? 
(defun MREV (A B / N U V) 
  (setq N 0) 
  (repeat (- (length A) 1) 
    (setq U (cons (mapcar '(lambda (V) (* B V)) (nth N A)) U) 
          N (1+ N) 
    ) 
  ) 
  (append (reverse U) (list (nth 3 A))) 
) 
 
(defun C:TT1 (/ TM TMP) 
  (setq TM (nentselp "\n选取要对齐UCS的图块:")) 
  (setq TMP (vlax-ename->vla-object (car (last TM)))) 
  (vla-transformby 
    (vlax-ename->vla-object (car (entsel "\n选取转换对象:"))) 
    (vlax-tmatrix 
      (MREV (EA:MATRIX_INVERSE 
              (caddr TM) 
            ) 
            (* (/ 1 (vla-get-xscalefactor TMP)) 
               (/ 1 (vla-get-yscalefactor TMP)) 
               (/ 1 (vla-get-zscalefactor TMP)) 
            ) 
      ) 
    ) 
  ) 
) 
;;----------------------------------------------------------------------

eachy · 发表于 2003-2-18 18:59:47

CAD模型不支持不等比的矩阵。

cable2004 · 发表于 2014-3-20 23:01:07

源码是好东西

吴外安放 · 发表于 2020-7-26 18:48:44

谢谢版主分享.

账号		自动登录	找回密码
密码			立即注册

[每日一码] [LSP函数]求逆矩阵。

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

相关帖子