rctr.lsp

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

;;;                   rubber-banding visual aid will commence.         ;
;;;                                                                    ;
;;; Returned Value:  a real number denoting a distance                 ;
;;;                                                                    ;
;;;          Usage: (get-radius-from-point '(0 0 0 ))                  ;
;;;--------------------------------------------------------------------;
(defun get-radius-from-point (point)
	 (if point
	   (get-dist point "\nRadius: ")
	   (get-dist nil   "\nRadius: ")
	 )
)

;;;--------------------------------------------------------------------;
;;;       Function:  GET-RUN-RCTR-TST-PARAMETERS                       ;
;;;                                                                    ;
;;;    Description:  This function sets a value of the global:         ;
;;;                  *use-dialog*, calls the dialog for parameters if  ;
;;;                  the user selected yes for "Use dialog? "          ;
;;;                  If the user selected no, a command line           ;
;;;                  interaction with the user commences to retreive   ;
;;;                  neccesary information.                            ;
;;;                                                                    ;
;;;                  Required Functions:                               ;
;;;                    call-GetParams-dlg                              ;
;;;                    prompt-run-rctr-tst-parameters                  ;
;;;                    get-model-space                                 ;
;;;                                                                    ;
;;;      Arguments:  none                                              ;
;;;                                                                    ;
;;; Returned Value:  T if user pressed Ok.                             ;
;;;                  Nil if the user pressed Cancel.                   ;
;;;                                                                    ;
;;;          Usage: (get-run-rctr-tst-parameters)                      ;
;;;--------------------------------------------------------------------;
(defun get-run-rctr-tst-parameters (/ ans)
  (if (setq *use-dialog*
	     (if *use-dialog*
	       (get-Yes/No "Use dialog? ")
	       (not (get-No/Yes "Use dialog? "))
	     )
      )
    (call-GetParams-dlg)
    (prompt-run-rctr-tst-parameters)
  )
)

;;;--------------------------------------------------------------------;
;;;       Function:  CALL-GETPARAMS-DLG                                ;
;;;                                                                    ;
;;;    Description:  This function seeds temporary global varibles     ;
;;;                  from the global variables define previously.      ;
;;;                  Then invokes the dialog function and restores     ;
;;;                  the values from the user interaction to the       ;
;;;                  main global variables.                            ;
;;;                                                                    ;
;;;                  Required Functions:                               ;
;;;                    run-GetParams-dlg                               ;
;;;                                                                    ;
;;;      Arguments:  none                                              ;
;;;                                                                    ;
;;; Returned Value:  T if user pressed Ok.                             ;
;;;                  Nil if the user pressed Cancel.                   ;
;;;                                                                    ;
;;;          Usage: (call-GetParams-dlg)                               ;
;;;--------------------------------------------------------------------;
(defun call-GetParams-dlg (/ ans)
  (setq	radius	      *previous-radius*
	circle-number *previous-circle-number*
	color	      *previous-color*
	ans	      (run-GetParams-dlg)
  )
  (cond
    ((= ans 0) nil)   ;OK button was pressed
    (t
     ;; remember new values as new defaults
     (setq *previous-radius*	    radius
	   *previous-color*	    color
	   *previous-circle-number* circle-number
     )
     ans
    )
  )
)

;;;--------------------------------------------------------------------;
;;;       Function:  PROMPT-RUN-RCTR-TST-PARAMETERS                    ;
;;;                                                                    ;
;;;    Description:  This function invokes a command line              ;
;;;                  interaction with the user commences to retreive   ;
;;;                  neccesary information.                            ;
;;;                                                                    ;
;;;                  Required Functions:                               ;
;;;                    select-a-curve                                  ;
;;;                    get-radius-from-point                           ;
;;;                    get-integer                                     ;
;;;                    get-Yes/No                                      ;
;;;                                                                    ;
;;;      Arguments:  none                                              ;
;;;                                                                    ;
;;; Returned Value:  T if the user input was retreived.                ;
;;;                  Nil if the user did not select a curve object,    ;
;;;                                                                    ;
;;;          Usage: (prompt-run-rctr-tst-parameters)                   ;
;;;--------------------------------------------------------------------;
(defun prompt-run-rctr-tst-parameters ()
  (if (setq aCurve (select-a-curve))
    (progn
      (setq radius (get-radius-from-point (vlax-curve-getStartPoint aCurve)))
      (setq circle-number (get-integer "\nNumber of circles: "))
      (setq color (get-integer "\nColor index: "))
      (setq *use-persistent-reactor*
	     (if *use-persistent-reactor*
	       (get-Yes/No "Make reactor persistent? ")
	       (not (get-No/Yes "Make reactor persistent? "))
	     )
      )
      t
    )
    nil
  )
)

;;;--------------------------------------------------------------------;
;;;       Function:  CREATE-MODEL-SPACE                                ;
;;;                                                                    ;
;;;    Description:  This function creates an ACAD model space object. ;
;;;                  Note: acadModel is global.                        ;
;;;      Arguments:  none                                              ;
;;;                                                                    ;
;;; Returned Value:  a global vla model space object.                  ;
;;;                                                                    ;
;;;          Usage: (create-model-space)                               ;
;;;--------------------------------------------------------------------;
(defun create-model-space (/ acadApp acadDoc)
  (and
    (setq acadApp (vlax-get-acad-object))
    (setq acadDoc (vla-get-ActiveDocument acadApp))
    (setq acadModel(vla-get-ModelSpace acadDoc))
  )
)

;;;--------------------------------------------------------------------;
;;;       Function:  SELECT-A-CURVE                                    ;
;;;                                                                    ;
;;;    Description:  This function prompts the user to select a        ;
;;;                  curve object.                                     ;
;;;                                                                    ;
;;;      Arguments:  none                                              ;
;;;                                                                    ;
;;; Returned Value:  a val curve object.                               ;
;;;                                                                    ;
;;;          Usage: (select-a-curve)                                   ;
;;;--------------------------------------------------------------------;
(defun select-a-curve (/ curve sel)
  (if
    (and
      (setq sel (entsel "Please choose a curve: "))
      (setq curve (vlax-ename->vla-object (car sel)))
      (vlax-curve-getStartPoint curve)	;test on curve
    )
     curve
     nil
  )
)

;;;--------------------------------------------------------------------;
;;;       Function:  RCTR-TST                                          ;
;;;                                                                    ;
;;;    Description:  This function aids the user in:                   ;
;;;                  1. Selecting a curve object.                      ;
;;;                  2. Gather information for circle radius, color    ;
;;;                     and quantity.
;
;;;                  3. Asks for persistency for the curve reactor.    ;
;;;                                                                    ;
;;;                  Required Functions:                               ;
;;;                    get-run-rctr-tst-parameters                     ;
;;;                    create-model-space                              ;
;;;                    circles-tied-to-curve                           ;
;;;                    create-same-reactor                             ;
;;;                    make-same-radius                                ;
;;;                    save-property                                   ;
;;;                    create-translate-curve-reactor                  ;
;;;                                                                    ;
;;;      Arguments:  none                                              ;
;;;                                                                    ;
;;; Returned Value:  a vlr object reactor.                             ;
;;;                                                                    ;
;;;          Usage: (rctr-tst)                                         ;
;;;--------------------------------------------------------------------;

(defun C:rctr-tst (/		  AcadModel    radius
		     circle-number	       start
		     aCurve	  color	       reactors
		     circles-list
		    )
;;; Get parameters from user
;;; and prepare model space
  (if (and (get-run-rctr-tst-parameters) (create-model-space))
    (progn
;;; setup reactor to tie circles on line
      (setq
	reactors (cons
		   (circles-tied-to-curve aCurve radius circle-number)
		   reactors
		 )
      )
;;; setup reactor to make circles have eq, radius
      (setq circles-list (vlax-ldata-get aCurve "circles"))
      (setq reactors (cons
		       (create-same-reactor
			 circles-list
			 (function make-same-radius)
					; prevent name drop
		       )
		       reactors
		     )
      )
;;; put color to circles and curve
      (foreach circle circles-list
	(vla-put-Color circle color)
        (vla-Update circle)
	(save-property circle "Center")	;prepare for the next step
      )
      (vla-put-Color aCurve color)
;;; setup reactor to make aCurve follow circles moves
      (setq reactors
	     (cons (create-translate-curve-reactor circles-list aCurve)
		   reactors
	     )
      )
;;; if needed make all reactors persistent
      (if *use-persistent-reactor*
	(foreach react reactors
	  (vlr-pers react)
	)
      ); if pers
    )
  )
 (vla-Update (vlax-get-acad-object))
 (princ "\nRctr-Tst Finished.")
 (princ)
)


;;; EOF