[LISP函数-向量]：向量运算(乘常量/加/减)

eachy · 发表于 2005-8-31 19:00:27

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

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

×

;; ! ****************************************************************************
;; ! GE_VecScale
;; ! ****************************************************************************
;; ! Function : Scale a vector by a scalar amount
;; !
;; ! Arguments: 'v' - Vector to be scaled
;; ! 'scl' - Scalar amount to be scaled
;; !
;; ! Returns : 'v' - The scaled vector
;; !
;; ! (C) 1999-2004, Four Dimension Technologies, Bangalore
;; ! e-mail : [email]rakesh.rao@4d-technologies.com[/email]
;; ! Web : [url]www.4d-technologies.com[/url]
;; ! ****************************************************************************
;; 矢量放缩
(defun GE_VecScale (v scl)
(mapcar '(lambda (x) (* x scl)) v)
)
;|
向量乘常量
|;
(defun $XDLSP_Vector_Scaling (vec const)
(mapcar
'(lambda (x)
(* x const)
)
vec
)
)
;|
向量相加
|;
(defun $XDLSP_Vector_Union (vec1 vec2)
(mapcar '+ vec1 vec2)
)
;|
向量相减
|;
(defun $XDLSP_Vector_Subtract (vec1 vec2)
(mapcar '- vec1 vec2)
)

;; ! **************************************************************************** 
;; ! GE_VecScale 
;; ! **************************************************************************** 
;; ! Function : Scale a vector by a scalar amount 
;; ! 
;; ! Arguments: 'v'   - Vector to be scaled 
;; !            'scl' - Scalar amount to be scaled 
;; ! 
;; ! Returns  : 'v' - The scaled vector 
;; ! 
;; ! (C) 1999-2004, Four Dimension Technologies, Bangalore 
;; ! e-mail   : [email]rakesh.rao@4d-technologies.com[/email] 
;; ! Web      : [url]www.4d-technologies.com[/url] 
;; ! **************************************************************************** 
;; 矢量放缩 
(defun GE_VecScale (v scl) 
  (mapcar '(lambda (x) (* x scl)) v) 
) 
 
 ;| 
   向量乘常量 
|; 
(defun $XDLSP_Vector_Scaling (vec const) 
  (mapcar 
    '(lambda (x) 
       (* x const) 
     ) 
    vec 
  ) 
) 
 ;| 
   向量相加 
|; 
(defun $XDLSP_Vector_Union (vec1 vec2) 
  (mapcar '+ vec1 vec2) 
) 
 ;| 
   向量相减 
|; 
(defun $XDLSP_Vector_Subtract (vec1 vec2) 
  (mapcar '- vec1 vec2) 
)

aeo · 发表于 2005-9-1 23:12:36

VecScale其实是一个挺不实用的函数:因为cad的scale要基点的.

组合一下:

(defun VecScale-base(v Pbase scl)
($XDLSP_Vector_Union
(GE_VecScale ($XDLSP_Vector_Subtract v Pbase)sca)
Pbase
)
)

eachy · 发表于 2005-9-4 23:45:15

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Geometry Utilities ;
;;;--------------------------------------------------------------------;
;;; Function: 向量相加 ;
;;; ;
;;; Description: This function returns the addition of ;
;;; two vectors. ;
;;; ;
;;; Arguments: ;
;;; v1 = a valid vector list such as: ;
;;; '( 5 5 5 ) ;
;;; v2 = a valid vector list such as: ;
;;; '( 2 2 2 ) ;
;;; ;
;;; Returned Value: A vector list with the subtraction performed ;
;;; from v1 and v2. ;
;;; (add-vector '(5 5 5 ) '(2 2 2)) ;
;;; Returns: ;
;;; (7 7 7) ;
;;; ;
;;; Usage: (add-vector '(5 5 5 ) '(2 2 2 )) ;
;;;--------------------------------------------------------------------;
(defun add-vector (v1 v2)
(if (eq (type v1) 'VARIANT)
(if (> (vlax-variant-type v1) 8192)
(setq v1 (vlax-safearray->list (vlax-variant-value v1)))
)
)
(if (eq (type v2) 'VARIANT)
(if (> (vlax-variant-type v2) 8192)
(setq v2 (vlax-safearray->list (vlax-variant-value v2)))
)
)
(mapcar '+ v1 v2)
)
;;;--------------------------------------------------------------------;
;;; Function: 向量相减 ;
;;; ;
;;; Description: This function returns the subtraction of two ;
;;; vectors. ;
;;; ;
;;; Arguments: ;
;;; v1 = a valid vector list such as: ;
;;; '( 5 5 5 ) ;
;;; v2 = a valid vector list such as: ;
;;; '( 1 1 1 ) ;
;;; ;
;;; Returned Value: A vector list with the subtraction performed ;
;;; from v1 and v2. ;
;;; (subtract-vector '(5 5 5 ) '(1 1 1)) ;
;;; Returns: ;
;;; (4 4 4) ;
;;; ;
;;; Usage: (subtract-vector '(5 5 5 ) '(1 1 1)) ;
;;;--------------------------------------------------------------------;
(defun subtract-vector (v1 v2)
(vlax-3d-point (mapcar '- v1 v2))
)
;;;--------------------------------------------------------------------;
;;; Function: 向量乘以一个系数 ;
;;; ;
;;; Description: This function returns the multiplication of ;
;;; a vector to a number. ;
;;; ;
;;; Required Functions: ;
;;; mult-by-scalar ;
;;; ;
;;; Arguments: ;
;;; vect = a valid vector list such as: ;
;;; '( 5 5 5 ) ;
;;; scalar = a valid number ;
;;; ;
;;; Returned Value: A vector list with the multiplication of the ;
;;; scalar argument with the supplied vector list. ;
;;; (mult-by-scalar '(5 5 5 ) 12) ;
;;; Returns: ;
;;; (60 60 60) ;
;;; ;
;;; Usage: (mult-by-scalar '(5 5 5 ) 12) ;
;;;--------------------------------------------------------------------;
(defun mult-by-scalar (vect scalar / sv TransDataA TransData)
(if (> (vlax-variant-type vect) 8192)
(setq vect (vlax-safearray->list (vlax-variant-value vect)))
)
(setq sv (if (null vect)
nil
(cons (* scalar (car vect))
(mult-by-scalar (cdr vect) scalar)
)
)
)
;; Convert to a Variant Array of Doubles here ->
(setq TransDataA (vlax-make-safearray vlax-vbDouble (cons 0 3)))
(vlax-safearray-fill TransDataA sv)
(setq TransData (vlax-make-variant
TransDataA
(logior vlax-vbarray vlax-vbDouble)
)
)
)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 
;;;  Geometry Utilities                                                ; 
;;;--------------------------------------------------------------------; 
;;;       Function:  向量相加                                          ; 
;;;                                                                    ; 
;;;    Description:  This function returns the addition of             ; 
;;;                  two vectors.                                      ; 
;;;                                                                    ; 
;;;      Arguments:                                                    ; 
;;;               v1   =  a valid vector list such as:                 ; 
;;;                       '( 5 5 5 )                                   ; 
;;;               v2   =  a valid vector list such as:                 ; 
;;;                       '( 2 2 2 )                                   ; 
;;;                                                                    ; 
;;; Returned Value:  A vector list with the subtraction performed      ; 
;;;                  from v1 and v2.                                   ; 
;;;                        (add-vector '(5 5 5 ) '(2 2 2))                ; 
;;;                                         Returns:                       ; 
;;;                                        (7 7 7)                        ; 
;;;                                                                       ; 
;;;          Usage: (add-vector '(5 5 5 ) '(2 2 2 ))                   ; 
;;;--------------------------------------------------------------------; 
(defun add-vector (v1 v2) 
  (if (eq (type v1) 'VARIANT) 
    (if        (> (vlax-variant-type v1) 8192) 
      (setq v1 (vlax-safearray->list (vlax-variant-value v1))) 
    ) 
  ) 
  (if (eq (type v2) 'VARIANT) 
    (if        (> (vlax-variant-type v2) 8192) 
      (setq v2 (vlax-safearray->list (vlax-variant-value v2))) 
    ) 
  ) 
  (mapcar '+ v1 v2) 
) 
 
;;;--------------------------------------------------------------------; 
;;;       Function:  向量相减                                          ; 
;;;                                                                    ; 
;;;    Description:  This function returns the subtraction of two      ; 
;;;                  vectors.                                          ; 
;;;                                                                    ; 
;;;      Arguments:                                                    ; 
;;;               v1   =  a valid vector list such as:                 ; 
;;;                       '( 5 5 5 )                                   ; 
;;;               v2   =  a valid vector list such as:                 ; 
;;;                       '( 1 1 1 )                                   ; 
;;;                                                                    ; 
;;; Returned Value:  A vector list with the subtraction performed      ; 
;;;                  from v1 and v2.                                   ; 
;;;                        (subtract-vector '(5 5 5 ) '(1 1 1))           ; 
;;;                                         Returns:                       ; 
;;;                                        (4 4 4)                        ; 
;;;                                                                       ; 
;;;          Usage: (subtract-vector '(5 5 5 ) '(1 1 1))               ; 
;;;--------------------------------------------------------------------; 
(defun subtract-vector (v1 v2) 
  (vlax-3d-point (mapcar '- v1 v2)) 
) 
 
;;;--------------------------------------------------------------------; 
;;;       Function:  向量乘以一个系数                                  ; 
;;;                                                                    ; 
;;;    Description:  This function returns the multiplication of       ; 
;;;                  a vector to a number.                             ; 
;;;                                                                    ; 
;;;                  Required Functions:                               ; 
;;;                      mult-by-scalar                                ; 
;;;                                                                    ; 
;;;      Arguments:                                                    ; 
;;;               vect =  a valid vector list such as:                 ; 
;;;                       '( 5 5 5 )                                   ; 
;;;             scalar = a valid number                                ; 
;;;                                                                    ; 
;;; Returned Value:  A vector list with the multiplication of the      ; 
;;;                  scalar argument with the supplied vector list.    ; 
;;;                        (mult-by-scalar '(5 5 5 ) 12)                  ; 
;;;                                         Returns:                       ; 
;;;                                        (60 60 60)                     ; 
;;;                                                                       ; 
;;;          Usage: (mult-by-scalar '(5 5 5 ) 12)                      ; 
;;;--------------------------------------------------------------------; 
(defun mult-by-scalar (vect scalar / sv TransDataA TransData) 
  (if (> (vlax-variant-type vect) 8192) 
    (setq vect (vlax-safearray->list (vlax-variant-value vect))) 
  ) 
  (setq        sv (if (null vect) 
             nil 
             (cons (* scalar (car vect)) 
                   (mult-by-scalar (cdr vect) scalar) 
             ) 
           ) 
  ) 
  ;; Convert to a Variant Array of Doubles here -> 
  (setq TransDataA (vlax-make-safearray vlax-vbDouble (cons 0 3))) 
  (vlax-safearray-fill TransDataA sv) 
  (setq        TransData (vlax-make-variant 
                    TransDataA 
                    (logior vlax-vbarray vlax-vbDouble) 
                  ) 
  ) 
)

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

[LISP函数-向量]：向量运算(乘常量/加/减)

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

相关帖子