gpreact.lsp

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

;;;     Function: gp:outline-erased                                    ;
;;;--------------------------------------------------------------------;
;;;  Description: This reactor function is triggered if the path       ;
;;;               outline is being erased.  In this case, store the    ;
;;;               reactor to the global list *reactorsToRemove*        ;
;;;--------------------------------------------------------------------;
(defun gp:outline-erased (outlinePoly reactor parameterList)
  (setq	*reactorsToRemove*
	 (cons reactor *reactorsToRemove*)
	*OwnerReactorsToRemove*
	 (cons outlinePoly *OwnerReactorsToRemove*)
	)
  )



;;;--------------------------------------------------------------------;
;;;     Function: gp:outline-changed                                   ;
;;;--------------------------------------------------------------------;
;;;  Description: This reactor function is fired if the path outline   ;
;;;               is changed, or if the path is being moved, rotated,  ;
;;;               or altered in some way (other than being erased).    ;
;;;               If the command is a grip stretch, the path will      ;
;;;               retain its associativity with the tiles, so the      ;
;;;               function must act differently in this situation,     ;
;;;               by saving a pointer to the polyline border, so that  ;
;;;               it can be updated during the commandEnded callback.  ;
;;;--------------------------------------------------------------------;
(defun gp:outline-changed (outlinePoly reactor parameterList)
  (if *lostAssociativity*
    (setq *reactorsToRemove*
	   (cons reactor *reactorsToRemove*)
	  )
    (setq *polytochange*     outlinePoly
	  *reactorsToChange* (cons reactor *reactorsToChange*)
	  )
    )
  )



;;;--------------------------------------------------------------------;
;;;     Function: gp:command-ended                                     ;
;;;--------------------------------------------------------------------;
;;;  Description: This reactor function is called at the end of any    ;
;;;               command.                                             ;
;;;--------------------------------------------------------------------;
;;;  This is where the majority of work is done.  Once the command     ;
;;;  that the user is performing has ended, we can get to work.  (We   ;
;;;  cannot modify entities while they are being modified by AutoCAD   ;
;;;  itself, so we have to wait until we get a notification that the   ;
;;;  command in progress is complete, and we can have access to the    ;
;;;  entities.)                                                        ;
;;;--------------------------------------------------------------------;
(defun gp:command-ended	(reactor	  command-list
			 /		  objReactor
			 reactorToChange  reactorData
			 coordinateValues currentPoints
			 newReactorData	  newPts
			 tileList
			 )

  (cond
    ;; CONDITION 1 - POLYLINE ERASED (Erase command)
    ;; If one or more polyline borders are being erased (indicated
    ;; by the presence of *reactorsToRemove*), erase the tiles within
    ;; the border, then remove the reactor.
    (*reactorsToRemove*
     (foreach objReactor *reactorsToRemove*
       (gp:erase-tiles objReactor)
       )
     (setq *reactorsToRemove* nil)
     )

    ;; CONDITION 2 - LOST ASSOCIATIVITY (Move, Rotate, etc.)
    ;; If the associatvity has been lost (undo, move, etc.) then erase
    ;; the tiles within each border
    ;; 
    ((and *lostassociativity* *reactorsToChange*)
     (foreach reactorToChange *reactorsToChange*
       (gp:erase-tiles reactorToChange)
       )
     (setq *reactorsToChange* nil)
     )

    ;; CONDITION 3 - GRIP_STRETCH 
    ;; In this case, we are keeping the associativity of the tiles to
    ;; the path, but the path and the tiles will need to be recalculated
    ;; and redrawn.  A GRIP_STRETCH can only be performed on a single
    ;; POLYLINE at a time.
    ((and (not *lostassociativity*)
	  *polytochange*
	  *reactorsToChange*
	  (member "GRIP_STRETCH" command-list)
	  ;; for a GRIP_STRETCH, there will be only one reactor in
	  ;; the global *reactorsToChange*
	  (setq	reactorData
		 (vlr-data (setq reactorToChange
				  (car *reactorsToChange*)
				 )
			   )
		)
	  )

     ;; First, erase the tiles within the polyline border
     (gp:erase-tiles reactorToChange)

     ;; Next, get the current coordinate values of the polyline
     ;; vertices
     (setq coordinateValues
	    (vlax-safearray->list
	      (vlax-variant-value
		(vla-get-coordinates *polyToChange*)
		)
	      )
	   )


     ;; If the outline is a lightweight polyline, you'll have 2d points,
     ;; so use the utility function xyList->ListOfPoints to convert the
     ;; list of coordinate data into lists of ((x y) (x y) ...) points.
     ;; Otherwise, use the xyzList->ListOfPoints function that deals
     ;; with 3d points, and converts the coordinate data into lists of
     ;; ((x y z) (x y z) ... ) points.
     (setq CurrentPoints
	    (if	(= (vla-get-ObjectName *polytochange*) "AcDbPolyline")
	      (xyList->ListOfPoints coordinateValues)
	      (xyzList->ListOfPoints coordinateValues)
	      )
	   )

     ;; Send this new information to RedefinePolyBorder -- this will
     ;; return the new Polyline Border
     (setq NewReactorData
	    (gp:RedefinePolyBorder CurrentPoints reactorData)
	   )

     ;; Get all the border Points and ...
     (setq newpts (list	(cdr (assoc 12 NewReactorData))
			(cdr (assoc 13 NewReactorData))
			(cdr (assoc 14 NewReactorData))
			(cdr (assoc 15 NewReactorData))
			)
	   )

     ;; ...update the outline of the polyline with the new points
     ;; calculated above.  If you're dealing with a lightweight polyline,
     ;; convert these points to 2d (since all of the points in newpts are
     ;; 3D) otherwise leave them alone.
     (if (= (cdr (assoc 4 NewReactorData)) "LIGHT")
       (setq newpts (mapcar '(lambda (point)
			       (3dPoint->2dPoint Point)
			       )
			    newpts
			    )
	     )
       )


     ;; Now update the polyline with the correct points
     (vla-put-coordinates
	  *polytochange*
	  ;; For description of the list->variantArray see utils.lsp
	  (gp:list->variantArray (apply 'append newpts))
	)

       
     ;; We now use the current definition of the NewReactorData which is
     ;; really the same as the Garden path data structure. The only
     ;; exception is that the field (100) containing the list of
     ;; tiles is nil.  This is ok since gp:Calculate-and-Draw-Tiles
     ;; does not require this field to draw the tiles. In fact this
     ;; function creates the tiles and returns a list of drawn tiles.
     (setq tileList (gp:Calculate-and-Draw-Tiles
		      ;; path data list without correct tile list
		      NewReactorData
		      ;; Object creation function
		      ;; Within a reactor this *MUST* be ActiveX
		      "ActiveX"
		      )
	   )


     ;; Now that we have received all the tiles drawn we'll rebuild
     ;; the data structure with the correct tileList value and reset
     ;; the data property in the reactor

     ;; Update the tiles associated with the polyline border
     (setq NewReactorData
	    (subst (cons 100 tileList)
		   (assoc 100 NewReactorData)
		   NewReactorData
		   )
	   )

     ;; By now we have the new data associated with the polyline.
     ;; All there is left to do is associate it with the reactor
     ;; using vlr-data-set
     (vlr-data-set (car *reactorsToChange*) NewReactorData)

     ;; remove all references to the temporary
     ;; variables *polytochange* and *reactorsToChange*
     (setq *polytochange*     nil
	   *reactorsToChange* nil
	   )
     )
    )
  ;; safely delete any items in the *Safe-to-Delete* global if you can!!!
  (Gp:Safe-Delete (car command-list))
  (setq *OwnerReactorsToRemove* nil)
  (princ)
  )



;;;--------------------------------------------------------------------;
;;;     Function: gp:clean-all-reactors                                ;
;;;--------------------------------------------------------------------;
;;;  Description: Used to clean all reactors before exiting AutoCAD.   ;
;;;               This is a Very Important Function!                   ;
;;;--------------------------------------------------------------------;
(defun gp:clean-all-reactors (reactor command-list)
  (terpri)
  (princ (list 'gp:clean-all-reactors reactor command-list))
  (terpri)
  (princ (setq reactorData (vlr-data reactor)))
  (terpri)
  (princ (list command-list " has been issued"))
  (cleanReactors)
  )