rolls.lsp

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

;;;                                                                    ;
;;;    Description:  This function is responsible for passing          ;
;;;                  information to other procedures that display      ;
;;;                  the circles on the screen. Furthermore, this      ;
;;;                  function creates the neccesary reactor.           ;
;;;                                                                    ;
;;;                  Required Functions:                               ;
;;;                        num-of-circles                              ;
;;;                        circles-tied-to-curve                       ;
;;;                        create-same-reactor                         ;
;;;                        reactor-make-same-center                    ;
;;;                        reactor-m-circle-radius                     ;
;;;                                                                    ;
;;;      Arguments:                                                    ;
;;;         circle1 = a valid vla circle object.                       ;
;;;         circle2 = a valid vla circle object.                       ;
;;;                                                                    ;
;;; Returned Value:  A valid vlr object reactor                        ;
;;;                                                                    ;
;;;          Usage:                                                    ;
;;;               (create-rolls vla-circle1 vla-circle2)               ;
;;;--------------------------------------------------------------------;
(defun create-rolls (circle1	   circle2	 /
		     m-circle	   circles-list	 circle-reactor
		     rad	   num-circles	 acadModel
		    )
  (setq	acadModel      (get-model-space)
	m-circle       (make-middle-circle circle1 circle2)
	rad	       (/ (abs (- (vla-get-radius circle1) (vla-get-radius circle2)))
			  2
		       )
	num-circles    (num-of-circles (vla-get-radius m-circle) rad)
	circle-reactor (circles-tied-to-curve m-circle rad num-circles)
	circles-list   (vlax-ldata-get m-circle "circles")
  )
  (list
    (create-same-reactor
      (list circle1 circle2 m-circle)
      (function reactor-make-same-center)
    )
    (VLR-Object-reactor
      (list circle1 circle2)
      m-circle
      (list
	(cons :vlr-modified (function reactor-m-circle-radius))
      )
    )
    circle-reactor
  )
)

;;;--------------------------------------------------------------------;
;;;       Function:  MAKE-MIDDLE-CIRCLE                                ;
;;;                                                                    ;
;;;    Description:  This function is responsible for creating         ;
;;;                  a small circle between the two vla                ;
;;;                  circle objects.                                   ;
;;;                                                                    ;
;;;                  Required Functions:                               ;
;;;                        load-line-types                             ;
;;;                        get-model-space                             ;
;;;                                                                    ;
;;;      Arguments:                                                    ;
;;;         circle1 = a valid vla circle object.                       ;
;;;         circle2 = a valid vla circle object.                       ;
;;;                                                                    ;
;;; Returned Value:  A valid vla circle object.                        ;
;;;                                                                    ;
;;;          Usage:                                                    ;
;;;               (make-middle-circle vla-circle1 vla-circle2)         ;
;;;--------------------------------------------------------------------;
(defun make-middle-circle (circle1 circle2 / middle-circle)
  (setq	middle-circle
	 (vla-AddCircle
	   (get-model-space)
	   (vla-get-center circle1)
	   (/ (+ (vla-get-radius circle1) (vla-get-radius circle2)) 2)
	 )
  )
  (if (load-line-types "Dashdot" "acad.lin")
    (vla-put-Linetype middle-circle "Dashdot"))
  (vlax-ldata-put middle-circle "circle1" circle1)
  (vlax-ldata-put middle-circle "circle2" circle2)
  (vla-put-Color circle1 acRed)
  (vla-put-Color circle2 acRed)
  middle-circle
)

;;;--------------------------------------------------------------------;
;;;       Function:  C:ROLLS-TST                                       ;
;;;                                                                    ;
;;;    Description:  This function will create 4 circles. One outer    ;
;;;                  circle and three inner circles.                   ;
;;;                                                                    ;
;;;                  Required Functions:                               ;
;;;                    get-model-space                                 ;
;;;                    create-rolls                                    ;
;;;                                                                    ;
;;;      Arguments:  none                                              ;
;;;                                                                    ;
;;; Returned Value:  A valid reactor object.                           ;
;;;                                                                    ;
;;;          Usage: (C:ROLLS-TST) or ROLLS-TST from                    ;
;;;                 the ACAD Command: prompt.                          ;
;;;--------------------------------------------------------------------;
(defun C:ROLLS-TST (/ center circle1 circle2 radius1 radius2 acadModel)
  (initget 1)				
  (setq center (GETPOINT "\nSelect center"))
  (initget 103)				;(+ 1 2 4 32 64)
  (setq rad1 (GETDIST center "\nSelect first raduis"))
  (initget 103)				;(+ 1 2 4 32 64)
  (setq rad2 (GETDIST center "\nSelect second raduis"))
  (terpri)
  (setq	acadModel (get-model-space)
	circle1	  (vla-AddCircle acadModel (vlax-3d-point center) rad1)
	circle2	  (vla-AddCircle acadModel (vlax-3d-point center) rad2)
  )
  (create-rolls circle1 circle2)
)


;;;--------------------------------------------------------------------;
;;;       Function:  C:ROLLS-INFO                                      ;
;;;                                                                    ;
;;;    Description:  This function displays a help file in the ACAD    ;
;;;                  Command: prompt.                                  ;
;;;                                                                    ;
;;;      Arguments:  none                                              ;
;;;                                                                    ;
;;; Returned Value:  none                                              ;
;;;                                                                    ;
;;;          Usage: (C:ROLLS-INFO) or ROLLS-INFO from                  ;
;;;                 the ACAD Command: prompt.                          ;
;;;--------------------------------------------------------------------;
(defun C:ROLLS-INFO ()
  (princ "\nTo run test call ROLLS-TST")
  (princ "\nYou will be asked to select a center,")
  (princ "\na radius of the first circle and the radius of the second circle.")
  (princ "\nTwo circles (colored red) will be drawn.")
  (princ "\nThe space between them will be filled with rolls (circles)")
  (princ "\nEach time you change position of one of the red circles the")
  (princ "\nscheme will also change.")
  (princ "\nEach time you change radius of one of the red circles ")
  (princ "\nthe optimal number of rolls will be recalculated and if needed")
  (princ "\nchanged.")
  (princ "\n")
  (princ)
)


;;;--------------------------------------------------------------------;
;;; Add the functions within this file to the global functions list    ;
;;; to be used by the C:REACT-TEST-INFO function in R-INFO.LSP         ;
;;;--------------------------------------------------------------------;
(setq *REACT-TEST-COMMANDS-INFO*
       (cons (list "ROLLS-TST" "ROLLS-INFO")
	     *REACT-TEST-COMMANDS-INFO*))
	     
;; EOF