[LISP函数-矩阵]：构造一个平移矩阵

eachy · 发表于 2005-9-4 23:49:58

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

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

×

;;构造一个平移矩阵
;;;--------------------------------------------------------------------;
;;; Function: MAKE-TRANSLATION-MATRIX ;
;;; ;
;;; Description: This function converts a variant vector list ;
;;; (a list of three numbers) into a vector matrix. ;
;;; ;
;;; Required Functions: ;
;;; ;
;;; ;
;;; Example: A vector list '( 5 5 5 ) is passed to ;
;;; make-translation-matrix. The function then ;
;;; translates this value to a matrix list. ;
;;; using the following logic. ;
;;; ;
;;; make a translation matrix from ;
;;; 1,2 or 3 dim vector v represented as: ;
;;; list (x), (x y) or (x y z) ;
;;; ;
;;; ;
;;; Arguments: ;
;;; vector = a valid vector list such as: ;
;;; '( 5 5 5) or '( 1.2 4.5 200.00) ;
;;; or vector = a valid safearray variant vector list of doubles ;
;;; ;
;;; Returned Value: A matrix List such as: ;
;;; (make-translation-matrix '( 5 5 5 )) ;
;;; ;
;;; Returns List In A Variant Array: ;
;;; ((1.0 0.0 0.0 5.0) ;
;;; (0.0 1.0 0.0 5.0) ;
;;; (0.0 0.0 1.0 5.0) ;
;;; (0.0 0.0 0.0 1.0) ;
;;; ) ;
;;; ;
;;; Usage: (make-translation-matrix '( 5 5 5 )) or ;
;;; (make-translation-matrix (vlax-3d-point '( 5 5 5 ))) ;
;;; ;
;;;--------------------------------------------------------------------;
(defun make-translation-matrix (vector)
(if (> (vlax-variant-type vector) 8192)
(setq vector (vlax-safearray->list (vlax-variant-value vector)))
)
(setq tm (vlax-tmatrix
(list (list 1 0 0 (car vector))
(list 0 1 0 (check-vector-elem (cadr vector)))
(list 0 0 1 (check-vector-elem (caddr vector)))
'(0 0 0 1)
)
)
)
;; Convert to a Variant Array of Doubles here ->
(setq TransDataA
(vlax-make-safearray vlax-vbDouble (cons 0 3) (cons 0 3))
)
(vlax-safearray-fill TransDataA tm)
(setq TransData (vlax-make-variant
TransDataA
(logior vlax-vbarray vlax-vbDouble)
)
)
)

;;构造一个平移矩阵 
;;;--------------------------------------------------------------------; 
;;;       Function:  MAKE-TRANSLATION-MATRIX                           ; 
;;;                                                                    ; 
;;;    Description:  This function converts a variant vector list      ; 
;;;                  (a list of three numbers) into a vector matrix.   ; 
;;;                                                                    ; 
;;;                  Required Functions:                               ; 
;;;                                                                    ; 
;;;                                                                    ; 
;;;                  Example:  A vector list '( 5 5 5 ) is passed to   ; 
;;;                  make-translation-matrix. The function then        ; 
;;;                  translates this value to a matrix list.           ; 
;;;                  using the following logic.                        ; 
;;;                                                                    ; 
;;;                        make a translation matrix from                 ; 
;;;                        1,2 or 3 dim vector v represented as:          ; 
;;;                                 list (x), (x y) or (x y z)             ; 
;;;                                                                    ; 
;;;                                                                    ; 
;;;      Arguments:                                                    ; 
;;;             vector =  a valid vector list such as:                 ; 
;;;                       '( 5 5 5) or '( 1.2 4.5 200.00)              ; 
;;;      or vector =  a valid safearray variant vector list of doubles ; 
;;;                                                                    ; 
;;; Returned Value:  A matrix List such as:                            ; 
;;;                      (make-translation-matrix '( 5 5 5 ))             ; 
;;;                                                                       ; 
;;;                            Returns List In A Variant Array:           ; 
;;;                                ((1.0 0.0 0.0 5.0)                     ; 
;;;                                  (0.0 1.0 0.0 5.0)                    ; 
;;;                                  (0.0 0.0 1.0 5.0)                    ; 
;;;                                  (0.0 0.0 0.0 1.0)                    ; 
;;;                                )                                      ; 
;;;                                                                       ; 
;;;       Usage: (make-translation-matrix '( 5 5 5 ))   or             ; 
;;;              (make-translation-matrix (vlax-3d-point '( 5 5 5 )))  ; 
;;;                                                                    ; 
;;;--------------------------------------------------------------------; 
(defun make-translation-matrix (vector) 
  (if (> (vlax-variant-type vector) 8192) 
    (setq vector (vlax-safearray->list (vlax-variant-value vector))) 
  ) 
  (setq        tm (vlax-tmatrix 
             (list (list 1 0 0 (car vector)) 
                   (list 0 1 0 (check-vector-elem (cadr vector))) 
                   (list 0 0 1 (check-vector-elem (caddr vector))) 
                   '(0 0 0 1) 
             ) 
           ) 
  ) 
  ;; Convert to a Variant Array of Doubles here -> 
  (setq        TransDataA 
         (vlax-make-safearray vlax-vbDouble (cons 0 3) (cons 0 3)) 
  ) 
  (vlax-safearray-fill TransDataA tm) 
  (setq        TransData (vlax-make-variant 
                    TransDataA 
                    (logior vlax-vbarray vlax-vbDouble) 
                  ) 
  ) 
 
)

liuyj · 发表于 2005-9-5 11:24:33

check-vector-elem 未定义

eachy · 发表于 2005-9-5 12:22:06

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Matrix Operations ;
;;;--------------------------------------------------------------------;
;;; Function: CHECK-VECTOR-ELEM ;
;;; ;
;;; Description: This function check the integrity of the elem ;
;;; argument. This guarantees a number value for ;
;;; functions that require this check. ;
;;; ;
;;; Required Functions: ;
;;; check-vector-elem ;
;;; ;
;;; Arguments: ;
;;; elem = a valid number or nil ;
;;; ;
;;; Returned Value: A number. If the argument elem is nil. ;
;;; check-vector returns 0 otherwise it returns the ;
;;; argument. ;
;;; ;
;;; Usage: (check-vector-elem 0) ;
;;;--------------------------------------------------------------------;
(defun check-vector-elem (elem)
(if (null elem)
0
elem
)
)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 
;;;  Matrix Operations                                                 ; 
;;;--------------------------------------------------------------------; 
;;;       Function:  CHECK-VECTOR-ELEM                                 ; 
;;;                                                                    ; 
;;;    Description:  This function check the integrity of the elem     ; 
;;;                  argument. This guarantees a number value for      ; 
;;;                  functions that require this check.                ; 
;;;                                                                    ; 
;;;                  Required Functions:                               ; 
;;;                      check-vector-elem                             ; 
;;;                                                                    ; 
;;;      Arguments:                                                    ; 
;;;               elem =  a valid number or nil                        ; 
;;;                                                                    ; 
;;; Returned Value:  A number. If the argument elem is nil.            ; 
;;;                  check-vector returns 0 otherwise it returns the   ; 
;;;                  argument.                                         ; 
;;;                                                                       ; 
;;;          Usage: (check-vector-elem 0)                              ; 
;;;--------------------------------------------------------------------; 
(defun check-vector-elem (elem) 
  (if (null elem) 
    0 
    elem 
  ) 
)

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

[LISP函数-矩阵]：构造一个平移矩阵

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

相关帖子