rutils.lsp

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

;;;         arg-list  = a list of arguments.                           ;
;;;                   Filled in by the reactor invoked.                ;
;;;                                                                    ;
;;; Returned Value:  A vla object.                                     ;
;;;		                                                       ;
;;;          Usage:  Should not be used alone.                         ;
;;;                                                                    ;
;;;                (reactor-make-same-radius-color                     ;
;;;                      Object-which-is-notifying                     ;
;;;                      Reactor-which-has-been-invoked                ;
;;;                      Some-list )                                   ;
;;;--------------------------------------------------------------------;
(defun reactor-make-same-radius-color (notifier reactor arg-list)
  (_reactor-make-same-properties-list
    notifier
    (vlr-data reactor)
    '("Radius" "Color")
  )
)


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;  Object Property Utilities                                         ;
;;;--------------------------------------------------------------------;
;;;       Function:  SAVE-OBJECT-PROPERTIES                            ;
;;;                                                                    ;
;;;    Description:  Saves a property in the object extension          ;
;;;                  dictionary.  The property value is saved to the   ;
;;;                  reactor data.                                     ;
;;;                                                                    ;
;;;                  Required Functions:                               ;
;;;                      save-object-properties                        ;
;;;                                                                    ;
;;;      Arguments:                                                    ;
;;;      vla-object = a valid vla object.                              ;
;;;                                                                    ;
;;;   property-list = a list of properties to place in the             ;
;;;                   objects dictionary.                              ;
;;;                                                                    ;
;;; Returned Value:  A vla object.                                     ;
;;;		                                                       ;
;;;          Usage:                                                    ;
;;;                (save-object-properties                             ;
;;;                      Vla-Object                                    ;
;;;                      properties-list                               ;
;;;                  )                                                 ;
;;;--------------------------------------------------------------------;
(defun save-object-properties (vla-obj property-list)
  (if (and (eq 'VLA-OBJECT (type vla-obj))
           (vlax-read-enabled-p vla-obj)
      )
    (foreach property property-list
      (if (vlax-property-available-p vla-obj property)
        (vlax-ldata-put
          vla-obj
          property
          (vlax-get vla-obj property)
        )
      )
    )
  )
)

;;;--------------------------------------------------------------------;
;;;       Function:  REACTOR-SAVE-CENTER                               ;
;;;                                                                    ;
;;;    Description:  This function is used as a call back function to  ;
;;;                  an event.                                         ;
;;;                                                                    ;
;;;                  Required Functions:                               ;
;;;                      save-object-properties                        ;
;;;                                                                    ;
;;;      Arguments:                                                    ;
;;;        notifier = a valid vla object. Filled in by the reactor     ;
;;;                   invoked.                                         ;
;;;        reactor  = a valid reactor that triggered the call back.    ;
;;;                   (this argument is ignored) but must be supplied. ;
;;;         arg-list  = a list of arguments.                           ;
;;;                   (this argument is ignored) but must be supplied. ;
;;;                                                                    ;
;;; Returned Value:  A vlr object reactor.                             ;
;;;                  such as:                                          ;
;;;			#<VLR-XXXXXX-reactor>                          ;
;;;		                                                       ;
;;;          Usage:  Should not be used alone.                         ;
;;;                                                                    ;
;;;                (reactor-save-center                                ;
;;;                      Object-which-is-notifying                     ;
;;;                      Reactor-which-has-been-invoked                ;
;;;                      Some-list )                                   ;
;;;--------------------------------------------------------------------;
(defun reactor-save-center (notifier reactor arg-list)
  (save-object-properties notifier '("Center"))
)

;;;--------------------------------------------------------------------;
;;;       Function:  REACTOR-SAVE-CENTER-COLOR                         ;
;;;                                                                    ;
;;;    Description:  This function is used as a call back function to  ;
;;;                  an event.                                         ;
;;;                                                                    ;
;;;                  Required Functions:                               ;
;;;                      save-object-properties                        ;
;;;                                                                    ;
;;;      Arguments:                                                    ;
;;;        notifier = a valid vla object. Filled in by the reactor     ;
;;;                   invoked.                                         ;
;;;        reactor  = a valid reactor that triggered the call back.    ;
;;;                   (this argument is ignored) but must be supplied. ;
;;;         arg-list  = a list of arguments.                           ;
;;;                   (this argument is ignored) but must be supplied. ;
;;;                                                                    ;
;;; Returned Value:  A vlr object reactor.                             ;
;;;                  such as:                                          ;
;;;			#<VLR-XXXXXX-reactor>                          ;
;;;		                                                       ;
;;;          Usage:  Should not be used alone.                         ;
;;;                                                                    ;
;;;                (reactor-save-center-color                          ;
;;;                      Object-which-is-notifying                     ;
;;;                      Reactor-which-has-been-invoked                ;
;;;                      Some-list )                                   ;
;;;--------------------------------------------------------------------;
(defun reactor-save-center-color (notifier reactor arg-list)
  (save-object-properties notifier '("Center" "Color"))
)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Sometimes it is useful to place reactors into selected objects     ;
;;; Here are some constructors to work with                            ;
;;;--------------------------------------------------------------------;
;;;       Function:  CREATE-SAME-REACTOR                               ;
;;;                                                                    ;
;;;    Description:  This creates a duplicate modified event for a     ;
;;;                  list of vla-objects.                              ;
;;;                                                                    ;
;;;      Arguments:                                                    ;
;;;         obj-list  a valid list of vla objects.                     ;
;;;        reaction = a valid function to invoke as a call back.       ;
;;;                                                                    ;
;;; Returned Value:  A vlr object reactor.                             ;
;;;                  such as:                                          ;
;;;			#<VLR-Object-reactor>                          ;
;;;		                                                       ;
;;;          Usage:  Where ac1 and ac2 are valid vla-object and        ;
;;;                  reaction is a function call back.                 ;
;;;                 (setq r                                            ;
;;;                     (create-same-reactor (list ac1 ac2)            ;
;;;                       'reactor-save-center-color))                 ;
;;;--------------------------------------------------------------------;
(defun create-same-reactor (obj-list reaction)
  (vlr-object-reactor
    obj-list
    obj-list
    (list (cons :vlr-modified reaction))
  )
)

;;;--------------------------------------------------------------------;
;;;       Function:  CREATE-SAFE-PROPERTY-REACTOR                      ;
;;;                                                                    ;
;;;    Description:  This creates a duplicate objectclosed event for   ;
;;;                  a vla-object.                                     ;
;;;                                                                    ;
;;;      Arguments:                                                    ;
;;;             obj = a valid vla object                               ;
;;;        reaction = a valid function to invoke as a call back.       ;
;;;                                                                    ;
;;; Returned Value:  A vlr object reactor.                             ;
;;;                  such as:                                          ;
;;;			#<VLR-Object-reactor>                          ;
;;;		                                                       ;
;;;          Usage:  Where ac1 is a valid vla object and               ;
;;;                  reaction is a function call back.                 ;
;;;                 (setq r                                            ;
;;;                     (create-safe-property-reactor ac1              ;
;;;                       'reactor-save-center-color))                 ;
;;;--------------------------------------------------------------------;
(defun create-safe-property-reactor (obj reaction)
  (vlr-object-reactor
    obj
    nil
    (list (cons :vlr-objectclosed reaction))
  )
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Selection Set Manipulations                                        ;
;;;--------------------------------------------------------------------;
;;;       Function:  SSGET->VLA-LIST                                   ;
;;;                                                                    ;
;;;    Description:  This function converts a valid ACAD selction      ;
;;;                  set to a list of vla-objects.                     ;
;;;                                                                    ;
;;;      Arguments:                                                    ;
;;;        selection-list = a valid ACAD selection set returned by     ;
;;;                         ssget.                                     ;
;;;                                                                    ;
;;; 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: (ssget->vla-list (ssget))                          ;
;;;--------------------------------------------------------------------;
(defun ssget->vla-list (selection-set / index vla-list)
  (setq index (if selection-set
                (1- (sslength selection-set))
                -1
              )
  )
  (while (>= index 0)
    (setq vla-list (cons (vlax-ename->vla-object (ssname selection-set index))
                         vla-list
                   )
          index    (1- index)
    )
  )
  vla-list
)

;;;--------------------------------------------------------------------;
;;;       Function:  VLASEL                                            ;
;;;                                                                    ;