rutils.lsp

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

;;; Returned Value:  A vla object                                      ;
;;;                                                                    ;
;;;          Usage: (translate-vla-object vla-Object '( 5 5 5))        ;
;;;--------------------------------------------------------------------;
(defun translate-vla-object (vla-obj translation-vector)
  (if (and vla-obj                          ;; is the vla-object
                                            ;; argument not nil?
           
           (eq 'VLA-OBJECT (type vla-obj))  ;; is it a vla-object?
           
           (vlax-write-enabled-p vla-obj)   ;; test if object
                                            ;; can be modified
      )
    (translate-object vla-obj translation-vector) ;; ok safe to
    						  ;; transform
    						  ;; the vectors.
  )
)

;;;--------------------------------------------------------------------;
;;;       Function:  TRANSLATE-OBJECT                                  ;
;;;                                                                    ;
;;;    Description:  This function translates the current              ;
;;;                  transformation values of an object by a supplied  ;
;;;                  vector list.  This vector list is a list of three ;
;;;                  numbers which determine the new values for the    ;
;;;                  existing transformation value.                    ;
;;;                  Translate-Object is similar to                    ;
;;;                  translate-vla-object except this function DOES    ;
;;;                  NOT perform error checking before passing the     ;
;;;                  information to make-translation-matrix.           ;
;;;                                                                    ;
;;;                  Note: This function DOES NOT performs             ;
;;;                        error checking.                             ;
;;;                                                                    ;
;;;                  Required Functions:                               ;
;;;                      make-translation-matrix                       ;
;;;                                                                    ;
;;;                  Example:  A line beginning is anchored at 0,0,0.  ;
;;;                  Its ending point is 1,0,0. The transformation     ;
;;;                  value is '(5 5 5). Hence add 5 to the X value, 5  ;
;;;                  to the Y value and 5 to the Z value. The result   ;
;;;                  will be:                                          ;
;;;                       The beginning point will have 5,5,5          ;
;;;                       The ending point will have 6,5,5             ;
;;;                                                                    ;
;;;                  The example above demonstrates a different method ;
;;;                  for moving an object.                             ;
;;;                                                                    ;
;;;      Arguments:                                                    ;
;;;           vla-obj  =  a vla object that can contain                ;
;;;                       transformation vectors.                      ;
;;; translation-vector =  a valid vector list such as:                 ;
;;;                       '( 5 5 5) or '( 1.2 4.5 200.00)              ;
;;;                                                                    ;
;;;                                                                    ;
;;; Returned Value:  A vla object                                      ;
;;;                                                                    ;
;;;          Usage: (translate-object vla-Object '( 5 5 5))            ;
;;;--------------------------------------------------------------------;
(defun translate-object (obj translation-vector)
  (vla-transformby
    obj
    (make-translation-matrix translation-vector)
  )
)

;;;--------------------------------------------------------------------;
;;;       Function:  GET-MODEL-SPACE                                   ;
;;;                                                                    ;
;;;    Description:  This function test if the global variable         ;
;;;                  *current-model-space* is set. If it is the        ;
;;;                  current value of *current-model-space* is         ;
;;;                  returned. Otherwise the value of the global       ;
;;;                  variable *current-model-space* is created.        ;
;;;                                                                    ;
;;;      Arguments:  none                                              ;
;;;                                                                    ;
;;; Returned Value:  A vla model space object                          ;
;;;                  is returned such as:                              ;
;;;                  #<VLA-OBJECT IAcadModelSpace 027a34c0>            ;
;;;                                                                    ;
;;;          Usage: (get-model-space)                                  ;
;;;--------------------------------------------------------------------;
(defun get-model-space (/ tmp)
  (cond (*current-model-space* *current-model-space*)
        ((and (setq tmp (vlax-get-acad-object))
              (setq tmp (vla-get-activedocument tmp))
              (setq tmp (vla-get-modelspace tmp))
         )
         (setq *current-model-space* tmp)
        )
        (t nil)
  )
)

;;;--------------------------------------------------------------------;
;;;       Function:  GET-PAPER-SPACE                                   ;
;;;                                                                    ;
;;;    Description:  This function test if the global variable         ;
;;;                  *current-paper-space* is set. If it is the        ;
;;;                  current value of *current-paper-space* is         ;
;;;                  returned. Otherwise the value of the global       ;
;;;                  variable *current-paper-space* is created.        ;
;;;                                                                    ;
;;;      Arguments:  none                                              ;
;;;                                                                    ;
;;; Returned Value:  A vla paper space object                          ;
;;;                  is returned such as:                              ;
;;;                  #<VLA-OBJECT IAcadPaperSpace 03131e0c>            ;
;;;                                                                    ;
;;;          Usage: (get-paper-space)                                  ;
;;;--------------------------------------------------------------------;
(defun get-paper-space (/ tmp)
  (cond (*current-paper-space* *current-paper-space*)
        ((and (setq tmp (vlax-get-acad-object))
              (setq tmp (vla-get-activedocument tmp))
              (setq tmp (vla-get-paperspace tmp))
         )
         (setq *current-paper-space* tmp)
        )
        (t nil)
  )
)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Line Type Functions                                                ;
;;;--------------------------------------------------------------------;
;;;       Function:  LOAD-LINE-TYPES                                   ;
;;;                                                                    ;
;;;    Description:  This searches a linetype collection object and    ;
;;;                  determines if the linetype is present in the      ;
;;;                  collection.                                       ;
;;;                                                                    ;
;;;                  Note that l-obj is a "local" variable within the  ;
;;;                  scope of the vlax-for function because it is      ;
;;;                  used within a "for" expression.                   ;
;;;                                                                    ;
;;;      Arguments:                                                    ;
;;;           line-type  =  A string which denotes the linetype        ;
;;;                         to search for in the line-type-collection  ;
;;;                         argument.                                  ;
;;; line-type-collection =  a vla collection object which contains     ;
;;;                         the current linetypes loaded in ACAD.      ;
;;;                                                                    ;
;;; Returned Value:  If the linetype is found a vla linetype object    ;
;;;                  is returned such as:                              ;
;;;                  #<VLA-OBJECT IAcadLineType 03fe0b00>              ;
;;;                  If the linetype search fails this function        ;
;;;                  returns nil.                                      ;
;;;                                                                    ;
;;;          Usage: (load-line-types "CENTER" "acad.lin")              ;
;;;--------------------------------------------------------------------;
(defun find-line-type (line-type line-type-collection / res)
  (setq line-type (strcase line-type))
  (vlax-for l-obj line-type-collection
    (if (= (strcase (vla-get-name l-obj)) line-type)
      (setq res l-obj)
    )
  )
  res
)

;;;--------------------------------------------------------------------;
;;;       Function:  LOAD-LINE-TYPES                                   ;
;;;                                                                    ;
;;;    Description:  This function creates a specified umber of        ;
;;;                  circles in model space.                           ;
;;;                  Required Functions:                               ;
;;;                         find-line-type                             ;
;;;                                                                    ;
;;;      Arguments:                                                    ;
;;;      line-type  =  A string which denotes the linetype to load.    ;
;;;      file-name  =  A string which denotes the linetype file to     ;
;;;                    which to load the requested linetype.           ;
;;;                                                                    ;
;;; Returned Value:  A vla linetype object objects such as:            ;
;;;                  #<VLA-OBJECT IAcadLineType 03fe0b00>              ;
;;;                                                                    ;
;;;          Usage: (load-line-types "CENTER" "acad.lin")              ;
;;;--------------------------------------------------------------------;
(defun load-line-types (line-type file-name / tmp res)
  (if (and (setq tmp (vlax-get-acad-object))
           (setq tmp (vla-get-activedocument tmp))
           (setq tmp (vla-get-linetypes tmp)) 	;; linetypes is the last
           					;; set and the current
           					;; linetype collection
      )
    (if (setq res (find-line-type line-type tmp))
      res
      (progn
		 ;; load the linetype
        (vla-load tmp line-type file-name)
		 ;; since the vla-load function returns nil
		 ;; we force the following function to test if
		 ;; the load was successful. If success the
		 ;; return the vla linetype object
        (if (vla-item tmp line-type)

          (vla-item tmp line-type)

          ;; Nothing was loaded so we return nil
          nil
        )   ;; _test to see if the line was loaded
      )     ;; evaluate when the linetype is not loaded in acad
    )       ;; end if for check if linetype is loaded
    nil
  )         ;; end if for various calls to ACAD
) ;;_end function

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;   Circle Functions                                                 ;
;;;--------------------------------------------------------------------;
;;;       Function:  GET-CENTER                                        ;
;;;                                                                    ;
;;;    Description:  This function prompts the user for a center point ;
;;;                  User input is curtailed via a call to initget     ;
;;;                  whose sum of the bit values determine the         ;
;;;                  behavior of this function.                        ;
;;;                                                                    ;
;;;                Bit value	Description                            ;
;;;                                                                    ;
;;;                1           Prevents the user from responding       ;
;;;                            to the request