rutils.lsp

Autocad-2005-简体中文-解密版.zip

;;;    Description:  This function mimics the AutoLISP entsel function.;
;;;                  The difference is that the return value is a      ;
;;;                  vla-object.                                       ;
;;;                                                                    ;
;;;      Arguments:  none                                              ;
;;;                                                                    ;
;;; Returned Value:  A the selected item as a vla-object               ;
;;;                  such as:                                          ;
;;;		      #<VLA-OBJECT IAcadCircle 01b42790>               ;
;;;		                                                       ;
;;;          Usage:  (vlasel)                                          ;
;;;--------------------------------------------------------------------;
(defun vlasel (/ sel)
  (if (setq sel (entsel))
    (vlax-ename->vla-object (car sel))
  )
)

;;;--------------------------------------------------------------------;
;;;       Function:  VLA-SEL                                           ;
;;;                                                                    ;
;;;    Description:  This function mimics the AutoLISP entsel function.;
;;;                  The difference is that the return value is a      ;
;;;                  vla-object.                                       ;
;;;                                                                    ;
;;;      Arguments:                                                    ;
;;;           message = A string or nil. If nil the entsel             ;
;;;                     function is called without arguments.          ;
;;;                     If this argument not nil and is a string, the  ;
;;;                     entsel function is passed the string value.    ;
;;;                                                                    ;
;;; Returned Value:  A the selected item as a vla-object               ;
;;;                  such as:                                          ;
;;;		      #<VLA-OBJECT IAcadCircle 01b42790>               ;
;;;		                                                       ;
;;;          Usage:  (vla-sel "\nSelect an Object:") or (vla-sel nil)  ;
;;;--------------------------------------------------------------------;
(defun vla-sel (message / sel)
  (if (setq sel (if (equal (type message) 'STR)
                  (entsel message)
                  (entsel)
                )
      )
    (vlax-ename->vla-object (car sel))
  )
)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;  Special Selection Set Utilities                                   ;
;;;--------------------------------------------------------------------;
;;;       Function:  SELECT-VLA-CIRCLES                                ;
;;;                                                                    ;
;;;    Description:  This function prompt the user to select objects   ;
;;;                  from the ACAD screen and applies a filter to the  ;
;;;                  selection set.                                    ;
;;;                                                                    ;
;;;      Arguments:  none                                              ;
;;;                                                                    ;
;;; Returned Value:  A list of all circles as vla-objects              ;
;;;                  such as:                                          ;
;;;		      (                                                ;
;;;			#<VLA-OBJECT IAcadCircle 01b4211c>             ;
;;;			#<VLA-OBJECT IAcadCircle 01b42790>             ;
;;;			#<VLA-OBJECT IAcadCircle 01b429a0>             ;
;;;		      )                                                ;
;;;		                                                       ;
;;;          Usage: (select-vla-circles)                               ;
;;;--------------------------------------------------------------------;
(defun select-vla-circles ()
  (ssget->vla-list (ssget '((0 . "CIRCLE"))))
)

;;;--------------------------------------------------------------------;
;;;       Function:  SELECT-VLA-CIRCLES-ARC                            ;
;;;                                                                    ;
;;;    Description:  This function prompt the user to select objects   ;
;;;                  from the ACAD screen and applies a filter to the  ;
;;;                  selection set.                                    ;
;;;                                                                    ;
;;;      Arguments:  none                                              ;
;;;                                                                    ;
;;; Returned Value:  A list of all circles or arcs as vla-objects      ;
;;;                  such as:                                          ;
;;;		      (                                                ;
;;;			#<VLA-OBJECT IAcadCircle 01b4211c>             ;
;;;			#<VLA-OBJECT IAcadCircle 01b42790>             ;
;;;			#<VLA-OBJECT IAcadCircle 01b429a0>             ;
;;;		      )                                                ;
;;;		                                                       ;
;;;          Usage: (select-vla-circles-arc)                           ;
;;;--------------------------------------------------------------------;
(defun select-vla-circles-arc ()
  (ssget->vla-list
    (ssget
      '((-4 . "<OR") (0 . "CIRCLE") (0 . "ARC") (-4 . "OR>"))
    )
  )
)


;;;--------------------------------------------------------------------;
;;;       Function:  REMOVE-FROM-ALL-REACTORS                          ;
;;;                                                                    ;
;;;    Description:  This function removes all associations with       ;
;;;                  any object reactor that pertains to the object.   ;
;;;                                                                    ;
;;;      Arguments:                                                    ;
;;;           vla-obj  =  a valid vla object                           ;
;;;                                                                    ;
;;; Returned Value:  The last reactor which was modified.              ;
;;;		                                                       ;
;;;          Usage: (remove-from-all-reactors  my-vla-object )         ;
;;;--------------------------------------------------------------------;
(defun remove-from-all-reactors (vla-obj)
  (foreach reactor (vlr-reactors :vlr-object-reactor)
    (vlr-owner-remove reactor vla-obj)
  )
)


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;  Geometry Utilities                                                ;
;;;--------------------------------------------------------------------;
;;;       Function:  ADD-VECTOR                                        ;
;;;                                                                    ;
;;;    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:  SUBTRACT-VECTOR                                   ;
;;;                                                                    ;
;;;    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:  MULT-BY-SCALAR                                    ;
;;;                                                                    ;
;;;    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)))
)

;;;--------------------------------------------------------------------;
;;;       Function:  UNIT-VECTOR                                       ;
;;;                                                                    ;
;;;    Description:  This function returns the normal for the          ;
;;;                  vector supplied.                                  ;
;;;                                                                    ;