mouse-reactor.lsp

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

;;;                                                                    ;
;;;  MOUSE REACTOR.LSP                                                 ;
;;;                                                                    ;
;;;  Copyright 1987, 1988, 1990, 1992, 1994, 1996, 1997, 1998, 1999    ;
;;;  by Autodesk, Inc. All Rights Reserved.                            ;
;;;                                                                    ;
;;;  You are hereby granted permission to use, copy and modify this    ;
;;;  software without charge, provided you do so exclusively for       ;
;;;  your own use or for use by others in your organization in the     ;
;;;  performance of their normal duties, and provided further that     ;
;;;  the above copyright notice appears in all copies and both that    ;
;;;  copyright notice and the limited warranty and restricted rights   ;
;;;  notice below appear in all supporting documentation.              ;
;;;                                                                    ;
;;;  Incorporation of any part of this software into other software,   ;
;;;  except when such incorporation is exclusively for your own use    ;
;;;  or for use by others in your organization in the performance of   ;
;;;  their normal duties, is prohibited without the prior written      ;
;;;  consent of Autodesk, Inc.                                         ;
;;;                                                                    ;
;;;  Copying, modification and distribution of this software or any    ;
;;;  part thereof in any form except as expressly provided herein is   ;
;;;  prohibited without the prior written consent of Autodesk, Inc.    ;
;;;                                                                    ;
;;;  AUTODESK PROVIDES THIS SOFTWARE "AS IS" AND WITH ALL FAULTS.      ;
;;;  AUTODESK SPECIFICALLY DISCLAIMS ANY IMPLIED WARRANTY OF           ;
;;;  MERCHANTABILITY OR FITNESS FOR A PARTICULAR USE.  AUTODESK,       ;
;;;  INC. DOES NOT WARRANT THAT THE OPERATION OF THE SOFTWARE          ;
;;;  WILL BE UNINTERRUPTED OR ERROR FREE.                              ;
;;;                                                                    ;
;;;  Restricted Rights for US Government Users.  This software         ;
;;;  and Documentation are provided with RESTRICTED RIGHTS for US      ;
;;;  US Government users.  Use, duplication, or disclosure by the      ;
;;;  Government is subject to restrictions as set forth in FAR         ;
;;;  12.212 (Commercial Computer Software-Restricted Rights) and       ;
;;;  DFAR 227.7202 (Rights in Technical Data and Computer Software),   ;
;;;  as applicable.  Manufacturer is Autodesk, Inc., 111 McInnis       ;
;;;  Parkway, San Rafael, California 94903.                            ;
;;;                                                                    ;
;;;
;;;
;;;	 Mouse Reactor and Dynamic Custom Popup
;;;
;;;
;;; Sample file supplied by: 	Perceptual Engineering Inc.
;;; web:			www.perceptual-eng.com
;;; Author:			Ralph Gimenez, Perceptual Engineering

;|
Overview:

	This file uses the Visual LISP ActiveX menu API and a
	mouse reactor that enables the creation of a custom
	popup associated with a mouse right click.

    
Specifications:

	Provide the end user a different method by which to change object's
	color.
	
	This must be performed without having to first select the object
	(displaying the object's grips) select an object grip, performing a
	right click to display the grips menu, select properties and lastly
	display the properties navigator.

	
	Example Code Goals:	


    	1. Provide a method using a right mouse click to display
    	   a custom menu with the use of a mouse reactor. 

    	2. Create a custom popup menu dynamically at runtime
    	   without the need to write a menu or mns file.
    	
    	3. Create a mouse reactor that displays its actions 
           for a double click and a right click. 


Running the Example:

	1. Open a new drawing
   
	2. Draw a few objects on the screen. The type of object is unimportant.
   
	3. Load Mouse-Reactor.lsp file into Visual LISP. 
   
	4. Once Mouse-Reactor.lsp is loaded, you will receive the message 'Mouse
	Reactor Example Loaded!'
      
	5. Execute the c:mouse-popup-on function at the command prompt to enable
	the mouse reactor and create a custom popup using Visual LISP new
	capability dynamic menu creation.
      
	You will see the menu items printed on the screen as they are created:
      
	Command: mouse-popup-on

	(#<VLA-OBJECT IAcadPopupMenu 022db528> 0 "&Enter" "\n")
	(#<VLA-OBJECT IAcadPopupMenu 022db528> 2 "&Move" "_Move ")
	(#<VLA-OBJECT IAcadPopupMenu 022db528> 3 "&Erase" "_Erase ")
	(#<VLA-OBJECT IAcadPopupMenu 022db528> 4 "&Cop&y" "_Copy ")
	(#<VLA-OBJECT IAcadPopupMenu 022e7c78> 0 "&Bylayer" "(ac:Change-Color 256) ")
	(#<VLA-OBJECT IAcadPopupMenu 022e7c78> 1 "&Red" "(ac:Change-Color 1) ")
	(#<VLA-OBJECT IAcadPopupMenu 022e7c78> 2 "&Yellow" "(ac:Change-Color 2) ")
	(#<VLA-OBJECT IAcadPopupMenu 022e7c78> 3 "&Green" "(ac:Change-Color 3) ")
	(#<VLA-OBJECT IAcadPopupMenu 022e7c78> 4 "&Cyan" "(ac:Change-Color 4) ")
	(#<VLA-OBJECT IAcadPopupMenu 022e7c78> 5 "&Blue" "(ac:Change-Color 5) ")
	(#<VLA-OBJECT IAcadPopupMenu 022e7c78> 6 "&Magenta" "(ac:Change-Color 6) ")
	Custom menu popup enabled!

	------------

	6. Once the mouse reactor is enabled place your crosshairs directly
	   above any object. Now perform a right click with the mouse. You will
	   notice a pop up menu which is different than the default popup displayed
	   by AutoCAD. Once the custom popup is displayed you may select any option
	   on the menu.

	7. To display the default mouse popup simply move the crosshairs away
	   from any object and perform a right click. 

	8. To temporarily disable the popup menu execute mouse-popup-off
	   at the command prompt.

	Command:  MOUSE-POPUP-OFF
	All menu items have been removed from:
	; menugroup = ACAD
	; Name = Custom-Menu

|;




;;; The premise of this example is to provide a mouse reactor that is triggered
;;;	when a right click is issued and an object is directly underneath
;;;	the crosshair's position. If the right click is produced and an object is not
;;; found, the original acad popup is displayed.



;;; This example utilizes the following Visual LISP pragma directives:
;;;
;;; pragma
;;;	unprotect-assign
;;;	protect-assign
;;;
;;;
;;; This example utilizes the following Visual LISP functions:
;;;	
;;;	vl-prin1-to-string 
;;;	vl-princ-to-string 
;;;	vla-add 
;;;	vla-addmenuitem 
;;;	vla-addseparator 
;;;	vla-addsubmenu 
;;;	vla-delete 
;;;	vla-get-color 
;;;	vla-get-menugroups 
;;;	vla-get-menus 
;;;	vla-get-name 
;;;	vla-get-namenomnemonic 
;;;	vla-get-objectname 
;;;	vla-get-parent 
;;;	vla-get-tagstring 
;;;	vla-insertinmenubar 
;;;	vla-put-check 
;;;	vla-put-color 
;;;	vla-saveas 
;;;	vlax-ename->vla-object 
;;;	vlax-for 
;;;	vlax-get-acad-object 
;;;	vlax-property-available-p 
;;;	vlax-variant-type 
;;;	vlaxx-integer-p 
;;;	vlaxx-real-p 
;;;	vlaxx-string-p 
;;;	vlr-mouse-reactor 
;;;	vlr-remove-all 
;;;

;;; to display the current color on the popup set the value of
;;;  *enableColor* to T
;;; --------------------------------------------------------------------------
;;; Start constants
;;; un-protect the global *MenuGroupname*
(pragma '((unprotect-assign *MenuGroupname*)))

;; now set the value of *MenuGroupname*
(setq *MenuGroupname*  "acad")

;; protect the global *MenuGroupname*
(pragma '((protect-assign *MenuGroupname*)))
(setq  *enableColor*  T)
(setvar "cmdecho" 0)

(vl-load-com) 	   ;; load vla ActiveX
(vl-load-reactors) ;; and reactors
;;; End constants
;;; --------------------------------------------------------------------------

;;; Globals
;;;	*Custom-Popup*		Variable that contains the Run-time Custom menu
;;; *MenuGroupname*		The menugroup name we will use to place the custom menu. 
;;; *mouse*				Mouse reactor.

;;; --------------------------------------------------------------------------
;;; clean function during debugging.
;;; Returns T
(defun ac:CleanMouseReactor	()
  (setq *mouse* nil)					; clear the variable
  (vlr-remove-all :VLR-Mouse-Reactor)
   T
  )
;;; --------------------------------------------------------------------------
;;; mouse reactor function
;;; Returns the newly created mouse reactor.
(defun ac:mouse	(data)
  ;; mouse reactors are document based
  (VLR-Mouse-Reactor
	data
	'(
	  (:VLR-beginDoubleClick . ac:beginDoubleClick)
	  (:VLR-beginRightClick . ac:beginRightClick)
	  )
	)
  )
;;; --------------------------------------------------------------------------
;;; reactor call back for a double click
;;; Returns nothing
(defun ac:beginDoubleClick (reactorObject Listofsomething)
  (princ "\nbeginDoubleClick Even Callback: ")
;;;  (princ (list reactorObject Listofsomething))

  (alert (strcat
		   "Begin Double Click"
		   "\nReactor Object: "
		   (vl-princ-to-string reactorObject)
		   "\nClick Point:"
		   (vl-princ-to-string Listofsomething)
		   )
		 )
  (princ)
  )

;;; --------------------------------------------------------------------------
;;; reactor call back for a right click
;;; Returns nothing
(defun ac:beginRightClick (reactorObject Listofsomething)
  (princ "\nbeginRightClick Even Callback: ")
;;;  (princ (list reactorObject Listofsomething))
  (setq	*objectUnderCursor*
		 (if (setq data (nentselp "" (car Listofsomething)))
		   (vlax-ename->vla-object (car data))
		   )
		)

  (if (and *objectUnderCursor*
		   (equal (getvar "cmdnames") "") ; no present command
		   )
	(progn
	  (princ (strcat "\nObject \""
					 (vla-get-ObjectName *objectUnderCursor*)
					 "\"\ under Cursor!\n"
					 )
			 )
;;; if there are too many calculations the original right click menu appears.
;;; To test this out set the variable *enableColor* to T if you want to
;;; peek and check the color of the object. Otherwise set it to nil. If the
;;; variable *enableColor* is T most likely there will be two
;;; popups displayed, one after the other.
	  
(if *enableColor*
  (progn
	  (foreach item *colors*
		   (vla-put-Check (cadr item) :vlax-false)
		)
	  (if (assoc (vla-get-color *objectUnderCursor*) *colors*)
		  (vla-put-check (cadr (assoc (vla-get-color *objectUnderCursor*) *colors*)) :vlax-true)
		)
	))
	  ;; --------

	  
	  (menucmd (strcat "p0=" *MenuGroupname* ".Custom-Menu"))
	  (menucmd "p0=*")
	  )
	
	(progn
	  (princ "\nNo Object under Cursor!\n")
	  ;; always return the pop0 to the acad system.
	  (menucmd "p0=acad.pop0")
	  )
	)
  (princ)
  )




;;; --------------------------------------------------------------------------
;;; enables the custom popup menu
;;; Returns nothing
(defun c:mouse-popup-on ()
  (if (not *mouse*)
	(progn
	  (setq *mouse* (ac:mouse nil))
	  (princ "\nMouse reactor enabled!\n")
	  )
	)
  (if (or (null *Custom-Popup*)
		  (null (ac:get-Menu-Items *Custom-Popup*))