gppoly.lsp

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

;;;                                                                    ;
;;;  GPPOLY.LSP                                                        ;
;;;                                                                    ;
;;;  Copyright 1987, 1988, 1990, 1992, 1994, 1996, 1997, 1998          ;
;;;  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.                            ;
;;;                                                                    ;

;;;--------------------------------------------------------------------;
;;;  This file is from the Garden Path tutorial, and represents the    ;
;;;  final state of the application at the end of Lesson 7. Use this   ;
;;;  file to check your work.                                          ;
;;;--------------------------------------------------------------------;


;;;--------------------------------------------------------------------;
;;;     Function: gp:ZeroSmallNum                                      ;
;;;--------------------------------------------------------------------;
;;;  Description:  This function tests and "fixes" very small numbers  ;
;;;                This is required when comparing reals to take care  ;
;;;                of rounding problems.  The granularity of the       ;
;;;                comparison is very fine, which should guarantee     ;
;;;                that this function will work for any garden path    ;
;;;                situation.  However, if this is applied to other    ;
;;;                applications, be sure to check for tolerances and   ;
;;;                numeric accuracy.                                   ;
;;;--------------------------------------------------------------------;
(defun gp:ZeroSmallNum (num)
  (setq num (rtos num 2 24))
  (distof
    (if	(or (wcmatch num "*e-*")
	    (wcmatch num "*E-*")
	) ;_ end of or
      "0.0"
      num
    ) ;_ end of if
  ) ;_ end of distof
) ;_ end of defun


;;;--------------------------------------------------------------------;
;;;     Function: gp:Rtos2                                             ;
;;;--------------------------------------------------------------------;
;;;  Description:  This function converts any real or interger number  ;
;;;                into a string decimal.                              ;
;;;--------------------------------------------------------------------;
(defun gp:Rtos2 (AnyNumber) (rtos AnyNumber 2))


;;;--------------------------------------------------------------------;
;;;     Function: gp:PointEqual                                        ;
;;;--------------------------------------------------------------------;
;;;  Description:  This function tests if points p1 and p2 are equal,  ;
;;;                given the accuracy defined in gp:ZeroSmallNum.      ;
;;;--------------------------------------------------------------------;
(defun gp:PointEqual (p1 p2 /)
  (setq	p1 (mapcar 'gp:ZeroSmallNum p1)	; check for very small numbers in p1 and fix them
	p2 (mapcar 'gp:ZeroSmallNum p2)	; check for very small numbers in p2 and fix them
	p1 (mapcar 'gp:Rtos2 p1)
	p2 (mapcar 'gp:Rtos2 p2)
  ) ;_ end of setq
  ;; Does every element the list p1 and p2 equal T
  (Vl-Every '(lambda (x) (equal x 'T)) (mapcar 'equal p1 p2))
) ;_ end of defun


;;;--------------------------------------------------------------------;
;;;     Function: gp:recalcPolyCorners                                 ;
;;;--------------------------------------------------------------------;
;;;  Description:  This function sorts out the changes made to the     ;
;;;                polyline border when one of its corner points has   ;
;;;                been dragged to a new location.  What we know going ;
;;;                in to this function is the point value of the moved ;
;;;                point, which we can compare to the keyed List of    ;
;;;                that record how the polyline had been arranged      ;
;;;                prior to the move.                                  ;
;;;--------------------------------------------------------------------;
(defun gp:recalcPolyCorners (MovedPoint KeyedList / movedKey testSet1 testSet2
		    result1 result2 )
  ;; From the MovedPoint, i.e., (15 (3.45 2.32)), extract just the
  ;; key value
  (setq movedKey (car MovedKeyPoint))

  ;; Set up the points that need to be recalculated.  The first value
  ;; in each test set is a point adjacent to the moved point.  The
  ;; second value in each test set is the point opposite to the moved
  ;; point.
  (cond	((equal movedKey 12)
	 (setq testSet1 '(13 14)
	       testSet2 '(15 14)))
	((equal movedKey 13)
	 (setq testSet1 '(12 15)
	       testSet2 '(14 15)))
	((equal movedKey 14)
	 (setq testSet1 '(15 12)
	       testSet2 '(13 12)))
	((equal movedKey 15)
	 (setq testSet1 '(14 13)
	       testSet2 '(12 13)))
	)
  (setq result1 (getPerp-Distance-and-Angle
		  (cdr (assoc (nth 0 testSet1) KeyedList))
		  (cdr (assoc (nth 1 testSet1) KeyedList))
		  (cdr MovedPoint))
	result2 (getPerp-Distance-and-Angle
		  (cdr (assoc (nth 0 testSet2) keyedList))
		  (cdr (assoc (nth 1 testSet2) keyedList))
		  (cdr MovedPoint))
	
	;; replace the moved point
  	keyedList (subst MovedPoint
			 (assoc movedKey KeyedList) keyedList)
	;; replace the first "opposite the moved point" point
  	keyedList (subst (cons (nth 0 testSet1) (car Result1))
			 (assoc (nth 0 testSet1) keyedList) keyedList)
	;; replace the second "opposite the moved point" point
	;; this will be the return value of the entire function
  	keyedList (subst (cons (nth 0 testSet2) (car Result2))
			 (assoc (nth 0 testSet2) keyedList) keyedList))
) ;_ end of defun





;;;--------------------------------------------------------------------;
;;;     Function: gp:FindPointInList                                   ;
;;;--------------------------------------------------------------------;
;;;  Description: This function will search for a testpoint, ex.       ;
;;;               '(4.05253 6.28481), searching in a gpath boundary    ;
;;;               list which is in the form:                           ;
;;;                     ((12 4.05253 3.62658)                          ;
;;;                      (15 4.05253 6.28481)                          ;
;;;                      (13 12.6903 3.62658)                          ;
;;;                      (14 12.6903 6.28481)                          ;
;;;                     )                                              ;
;;;--------------------------------------------------------------------;
;;;  If the point is found this function returns the matching assoc    ;
;;;  value within a list, for example: ((15 4.05253 6.28481))          ;
;;;  If no match is made, the function returns nil                     ;
;;;--------------------------------------------------------------------;
;;;  Required Arguments:                                               ;
;;;        TestPoint is a 2D point (list of 2 reals                    ;
;;;        TestList contains the fields and the points to test against ;
;;;--------------------------------------------------------------------;
(defun gp:FindPointInList (TestPoint TestList / result)
  ;; Since every point in TestList needs to be evaluated, use mapcar
  ;; to apply a function to be evaluated to every point in the TestList. 
  ;; Mapcar has the advantage over foreach and while due to its ability
  ;; to apply a function to all items in a list without having to determine
  ;; a loop test condition, or to determine the number of iterations required.
  (setq	result (mapcar '(lambda	(pointToExamine)
			  (if (gp:PointEqual
				TestPoint
				(cdr pointToExamine)
			      ) ;_ end of gp:PointEqual
			    ;; this will return the point with the assoc key
			    ;; if the TestPoint is equal to the cdr of pointToExamine
			    pointToExamine
			  ) ;_ end of if
			) ;_ end of lambda
		       Testlist
	       ) ;_ end of mapcar
  ) ;_ end of setq
  ;; --------------------------------------------------------------------------
  ;;  What has happened above:
  ;;     We passed FindPoint two arguments.
  ;;     The first was the testPoint to look for, such as 
  ;;         was '(4.05253 6.28481).
  ;;     The second argument was a list of consed points such as
  ;;  		((12 4.05253 3.62658)
  ;;  		  (15 4.05253 6.28481)
  ;;  		  (13 12.6903 3.62658)
  ;;  		  (14 12.6903 6.28481)
  ;;  		)
  ;;  The purpose of this function was to determine if the point to be
  ;;  searched <testPoint> is present in the list Testlist. In this case
  ;;  the function FindPoint would return:
  ;;          (nil (15 4.05253 6.28481) nil nil)
  ;;  As you can see TestPoint matches the point in the field 15 above.

  ;;  At this moment we are not interested in the nils present in the list.
  ;;  So we remove the nils using Visual Lisp's vl-remove function.
  ;;   (vl-remove nil Result) 

  ;;  Now the return value would be:
  ;;  ( (15 4.05253 6.28481) )
  ;;  which is excactly what we are expecting

  ;; Note if the variable <Result> is full of nils the expression
  ;; (vl-remove nil Result) would return nil
  ;; Example:
  ;;  _$ (vl-remove nil '( nil nil nil nil ))
  ;;     nil
  ;;  _$ 
  ;; So the duty of this function is to return a found Point or nil

  ;; remove any nil value from the resulting list
  (vl-remove nil Result)
) ;_ end of defun



;;;--------------------------------------------------------------------;