a-mtext.lsp

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

;;; Returned Value:  Returns the text string value for                 ;
;;;                  the mtext object                                  ;
;;;                                                                    ;
;;;          Usage: (update-mtex-for-circle                            ;
;;;                              vla-circle-Object                     ;
;;;                              vla-mtext-Object                      ;
;;;                                 )                                  ;
;;;--------------------------------------------------------------------;
(defun update-mtex-for-circle
       (vla-mtext vla-circle / inspoint width height text)
  (if (set-mtext-params-for-circle vla-circle)
    (progn
      (update-parameter vla-mtext "InsertionPoint" inspoint)
      (update-parameter vla-mtext "width" width)
      (update-parameter vla-mtext "height" height)
      (update-parameter vla-mtext "TextString" text)
    )
  )
)

;;;--------------------------------------------------------------------;
;;;       Function:  UPDATE-CIRCLE-FOR-MTEX                            ;
;;;                                                                    ;
;;;    Description:  This function is called from the reactor call     ;
;;;                  back function reactor-mtext->circle.              ;
;;;                                                                    ;
;;;                 Required Functions:                                ;
;;;                          set-circle-params-for-mtext               ;
;;;                          update-parameter                          ;
;;;                                                                    ;
;;;      Arguments:                                                    ;
;;;     vla-mtext  = a valid vla mtext  object.                        ;
;;;     vla-circle = a valid vla circle object.                        ;
;;;                                                                    ;
;;; Returned Value:  returns the center of the circle.                 ;
;;;                                                                    ;
;;;          Usage: (update-circle-for-mtex                            ;
;;;                              vla-circle-Object                     ;
;;;                              vla-mtext-Object                      ;
;;;                                 )                                  ;
;;;--------------------------------------------------------------------;
(defun update-circle-for-mtex (vla-circle vla-mtext / rad center)
  (if (set-circle-params-for-mtext vla-mtext)
    (progn
      (if (and rad (> rad 0))
	(update-parameter vla-circle "Radius" rad)
      )
      (update-parameter vla-circle "Center" center)
    )
  )
)

;;;--------------------------------------------------------------------;
;;; reactors                                                           ;
;;;--------------------------------------------------------------------;
;;;       Function:  REACTOR-CIRCLE->MTEXT                             ;
;;;                                                                    ;
;;;    Description:  This function will be called during a             ;
;;;                  :vlr-modified event.                              ;
;;;                                                                    ;
;;;                 Required Functions:                                ;
;;;                          update-mtex-for-circle                    ;
;;;                                                                    ;
;;;      Arguments:                                                    ;
;;;        notifier = a valid vla object. Filled in by the calling     ;
;;;                   reactor.                                         ;
;;;         reactor = a valid vlr object reactor. Filled in by the     ;
;;;                   calling reactor.                                 ;
;;;        arg-list = argument list filled in by the calling reactor.  ;
;;;                   Filled in by the calling reactor.                ;
;;;                                                                    ;
;;; Returned Value:  none                                              ;
;;;                                                                    ;
;;;          Usage:  Intended to be called from a reactor call back.   ;
;;;--------------------------------------------------------------------;
(defun reactor-circle->mtext (notifier reactor arg-list)
  (update-mtex-for-circle (vlr-data reactor) notifier)
)

;;;--------------------------------------------------------------------;
;;;       Function:  REACTOR-MTEXT->CIRCLE                             ;
;;;                                                                    ;
;;;    Description:  This function will be called during a             ;
;;;                  :vlr-modified event.                              ;
;;;                                                                    ;
;;;                 Required Functions:                                ;
;;;                          update-circle-for-mtex                    ;
;;;                                                                    ;
;;;      Arguments:                                                    ;
;;;        notifier = a valid vla object. Filled in by the calling     ;
;;;                   reactor.                                         ;
;;;         reactor = a valid vlr object reactor. Filled in by the     ;
;;;                   calling reactor.                                 ;
;;;        arg-list = argument list filled in by the calling reactor.  ;
;;;                   Filled in by the calling reactor.                ;
;;;                                                                    ;
;;; Returned Value:  none                                              ;
;;;                                                                    ;
;;;          Usage:  Intended to be called from a reactor call back.   ;
;;;--------------------------------------------------------------------;
(defun reactor-mtext->circle (notifier reactor arg-list)
  (update-circle-for-mtex (vlr-data reactor) notifier)
)

;;;--------------------------------------------------------------------;
;;;       Function:  C:A-MTEXT-TEST                                    ;
;;;                                                                    ;
;;;    Description:  This function aids in the creation of a circle    ;
;;;                  object and an Mtext object. Both are linked to    ;
;;;                  one another. If you move, reduce or increase the  ;
;;;                  circle the mtext object updates. If you move the  ;
;;;                  mtext object the circle moves.  The text value    ;
;;;                  displayed is the radius value of the circle.      ;
;;;                                                                    ;
;;;                  Required Functions:                               ;
;;;                    reactor-circle->mtext                           ;
;;;                    reactor-mtext->circle                           ;
;;;                    create-mtex-for-circle                          ;
;;;                                                                    ;
;;;      Arguments:  none                                              ;
;;;                                                                    ;
;;; Returned Value:  A list of two valid reactor objects. The first is ;
;;;                  the circle reactor the sencod the mtext reactor.  ;
;;;                   (#<VLR-Object-reactor> #<VLR-Object-reactor>)    ;
;;;                                                                    ;
;;;          Usage: (C:A-MTEXT-TEST) or C:A-MTEXT-TEST from            ;
;;;                 the ACAD Command: prompt.                          ;
;;;--------------------------------------------------------------------;
(defun C:A-MTEXT-TEST (/ vla-circle vla-mTxT r1 r2)
  (function reactor-circle->mtext)
  (function reactor-mtext->circle)
  (setq vla-circle (add-circle))
  (if vla-circle
    (progn
      (vla-put-color vla-circle acred)
      (setq vla-mTxT (create-mtex-for-circle vla-circle)
	    r1	     (vlr-object-reactor
		       (list vla-circle)
		       vla-mTxT
		       '((:vlr-modified . reactor-circle->mtext))
		     )
	    r2	     (vlr-object-reactor
		       (list vla-mTxT)
		       vla-circle
		       '((:vlr-modified . reactor-mtext->circle))
		     )
      )
      (list r1 r2)
    )
  )
(princ)
)

;;;--------------------------------------------------------------------;
;;;       Function:  C:A-MTEXT-INFO                                    ;
;;;                                                                    ;
;;;    Description:  This function displays a help file in the ACAD    ;
;;;                  Command: prompt.                                  ;
;;;                                                                    ;
;;;      Arguments:  none                                              ;
;;;                                                                    ;
;;; Returned Value:  none                                              ;
;;;                                                                    ;
;;;          Usage: (C:A-MTEXT-INFO ) or A-MTEXT-INFO from             ;
;;;                 the ACAD Command: prompt.                          ;
;;;--------------------------------------------------------------------;
(defun C:A-MTEXT-INFO ()
  (terpri)
  (princ
    "\nThis test binds a circle (colored red) with MTEXT."
  )
  (princ
    "\nYou will be asked to select center and radius of the circle."
  )
  (princ
    "\nWhen the circle radius changes, the MTEXT also changes."
  )
  (princ
    "\nAnd visa versa, when you change the number value of the MTEXT"
  )
  (princ "\nthe radius will be changed.")
  (princ "\n\nRun A-MTEXT-TEST command to test.")
  (terpri)
  (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 "A-MTEXT-TEST" "A-MTEXT-INFO")
	     *REACT-TEST-COMMANDS-INFO*
       )
)