utils.lsp

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

;;;                                                                    ;
;;;  UTILS.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.                                          ;
;;;--------------------------------------------------------------------;


;;;--------------------------------------------------------------------;
;;;  First step is to load ActiveX functionality.  If ActiveX support  ;
;;;  already exists in document (can occur when Bonus tools have been  ;
;;;  loaded into AutoCAD), nothing happens.                            ;
;;;--------------------------------------------------------------------;

(progn
    (vl-load-com)
    (vl-load-reactors)
)

;;;--------------------------------------------------------------------;
;;;  For ActiveX functions, we need to define a global variable which  ;
;;;  "points" to the Model Space portion of the active drawing.  This  ;
;;;  variable, named *ModelSpace* will be created at load time.        ;
;;;--------------------------------------------------------------------;
(setq *ModelSpace*
       (vla-get-ModelSpace
	 (vla-get-ActiveDocument (vlax-get-acad-object))
       ) ;_ end of vla-get-ModelSpace
) ;_ end of setq



;;;--------------------------------------------------------------------;
;;;     Function: Degrees->Radians                                     ;
;;;--------------------------------------------------------------------;
;;;  Description: This function converts a number representing an      ;
;;;               angular measurement in degrees, into its radian      ;
;;;               equivalent.  There is no error checking done on the  ;
;;;               numberOfDegrees parameter -- it is always expected   ;
;;;               to be a valid number.                                ;
;;;--------------------------------------------------------------------;
(defun Degrees->Radians	(numberOfDegrees)
  (* pi (/ numberOfDegrees 180.0))
) ;_ end of defun


;;;--------------------------------------------------------------------;
;;;     Function: 3dPoint->2dPoint                                     ;
;;;--------------------------------------------------------------------;
;;;  Description: This function takes one parameter representing a     ;
;;;               3D point (a list of three integers or reals), and    ;
;;;               converts it into a 2D point (a list of two reals).   ;
;;;               There is no error checking done on the 3dpt          ;
;;;               parameter --  it is always expected to be a valid    ;
;;;               point.                                               ;
;;;--------------------------------------------------------------------;
;;;   Work to do: Add some kind of parameter checking so that this     ;
;;;               function won't crash a program if it is passed a     ;
;;;               null value, or some other kind of data type than a   ;
;;;               3D point.                                            ;
;;;--------------------------------------------------------------------;
(defun 3dPoint->2dPoint	(3dpt)
  (list (float(car 3dpt)) (float(cadr 3dpt)))
) ;_ end of defun

;;;--------------------------------------------------------------------;
;;;     Function: list->variantArray                                   ;
;;;--------------------------------------------------------------------;
;;;  Description: This function takes one parameter representing a     ;
;;;               list of double values, e.g. a list of 2D points:     ;
;;;               '(p1.X p1.Y p2.X p2.Y p3.X p3.Y p4.X p4.Y).          ;
;;;		  The list is converted into an ActiveX                ;
;;;		  variant based on a safearray.                        ;
;;;               No error checking is performed on the parameter --   ;
;;;               it is assumed to consist of a list of doubles.       ;
;;;------------------------------------------------------------------- ;
(defun gp:list->variantArray (ptsList / arraySpace sArray)
					; allocate space for an array of 2d points stored as doubles
  (setq	arraySpace
	 (vlax-make-safearray
	   vlax-vbdouble		; element type
	   (cons 0
		 (- (length ptsList) 1)
	   )				; array dimension
	 )

  )
  (setq sArray (vlax-safearray-fill arraySpace ptsList))
					; return array variant
  (vlax-make-variant sArray)
)


;;;--------------------------------------------------------------------;
;;;     Function: xyzList->ListOfPoints                                ;
;;;--------------------------------------------------------------------;
;;;  Description: This function extracts and formats 3D point lists    ;
;;;               from one big list of reals, in the form:             ;
;;;                   (x y z x y z x y z ...)                          ;
;;;               This is the format of the data returned by the       ;
;;;               vla-get-coordinates function when applied to a       ;
;;;               standard polyline object.                            ;
;;;--------------------------------------------------------------------;
;;;               The return value will be a list in the format:       ;
;;;                    ((x y z) (x y z) (x y z) ... )                  ;
;;;--------------------------------------------------------------------;
(defun xyzList->ListOfPoints (coordList / ptlist)
  (while coordList
    (setq ptlist (append ptlist
			 (list (list (car coordList) (cadr coordList) (caddr coordList)))
		 ) ;_ end of append
	  coordList	 (cdddr coordList)
    ) ;_ end of setq
  ) ;_ end of while
  ptlist
  ;;; (setq ptlist ptlist)
) ;_ end of defun


;;;--------------------------------------------------------------------;
;;;     Function: xyList->ListOfPoints                                 ;
;;;--------------------------------------------------------------------;
;;;  Description: This function extracts and formats 2D point lists    ;
;;;               from one big list of reals, in the form:             ;
;;;                   (x y x y x y ...)                                ;
;;;               This is the format of the data returned by the       ;
;;;               vla-get-coordinates function when applied to a       ;
;;;               lightweight polyline object.                         ;
;;;--------------------------------------------------------------------;
;;;               The return value will be a list in the format:       ;
;;;                    ((x y) (x y) (x y) ... )                        ;
;;;--------------------------------------------------------------------;
(defun xyList->ListOfPoints (coordList / ptlist)
  (while coordList
    (setq ptlist (append ptlist
			 (list (list (car coordList) (cadr coordList)))
		 ) ;_ end of append
	  coordList	 (cddr coordList)
    ) ;_ end of setq
  ) ;_ end of while
    ptlist
  ;;; (setq ptlist ptlist)
) ;_ end of defun


;;;--------------------------------------------------------------------;
;;;     Function: CleanReactors                                        ;
;;;--------------------------------------------------------------------;
;;;  Description: This is a general utility function used for cleaning ;
;;;               up reactors. It can be used during debugging, as     ;
;;;               well as cleaning up any open reactors before a       ;
;;;               drawing is closed.                                   ;
;;;--------------------------------------------------------------------;
(defun CleanReactors ()
  (setq	*commandReactor* nil		; clear the variable
	*DrawingReactor* nil		; clear the variable
	)

  (mapcar 'vlr-remove-all
	  '(:VLR-AcDb-reactor		 :VLR-Editor-reactor
	    :VLR-Linker-reactor		 :VLR-Object-reactor
	    :VLR-Command-Reactor	 :VLR-DeepClone-Reactor
	    :VLR-DocManager-Reactor	 :VLR-DWG-Reactor
	    :VLR-DXF-Reactor		 :VLR-Editor-reactor
	    :VLR-Insert-Reactor		 :VLR-Linker-Reactor
	    :VLR-Lisp-Reactor		 :VLR-Miscellaneous-Reactor
	    :VLR-Mouse-Reactor		 :VLR-Object-Reactor
	    :VLR-SysVar-Reactor		 :VLR-Toolbar-Reactor
	    :VLR-Undo-Reactor		 :VLR-Wblock-Reactor
	    :VLR-Window-Reactor		 :VLR-XREF-Reactor
	    )
	  ) ;_ end of mapcar
  ) ;_ end of defun


;;;--------------------------------------------------------------------;
;;;     Function: square                                               ;
;;;--------------------------------------------------------------------;
;;;  Description: This function returns the square of a number         ;
;;;               example:  (square 7) returns 49                      ;
;;;--------------------------------------------------------------------;
(defun square (aNumber)
  (* aNumber aNumber)
) ;_ end of defun


;;;--------------------------------------------------------------------;
;;;     Function: getPerp-Distance-and-Angle                           ;
;;;--------------------------------------------------------------------;
;;;  Description: This function returns a list with the distance and   ;
;;;               perpendicular angle to user pt3, and is determined   ;
;;;               by supplied points pt1 pt2.  Pt3 is "user input"     ;
;;;               and need not be at right angles.  This allows us to  ;
;;;               solve for cases where ortho mode is off.             ;
;;;  Example usage:                                                    ;
;;;        (setq Data  (getPerp-Distance-and-Angle pt1 pt2 pt3) )      ;
;;;--------------------------------------------------------------------;
;;;      Arguments:                                                    ;
;;;          pt1  seed point                                           ;
;;;          pt2  seed point                                           ;
;;;      Note:  pt1 and pt2 denote a "line" segment                    ;
;;;          pt3  "user point" (point to solve for)                    ;
;;;--------------------------------------------------------------------;
(defun getPerp-Distance-and-Angle (linept1 linept2 userpt3 / dist:pt1->pt2
				   dist:pt1->pt3 dist:pt2->pt3
				   dist:pt2->ToPerpPt)
  (setq	dist:pt1->pt2    (distance linept1 linept2)
	dist:pt1->pt3    (distance linept1 userpt3)
	dist:pt2->pt3    (distance linept2 userpt3)
	dist:pt2->ToPerpPt  (/ (- (+ (SQUARE dist:pt2->pt3)
				  (SQUARE dist:pt1->pt2))
			       (SQUARE dist:pt1->pt3))
			    (* 2.0 dist:pt1->pt2))  
  ) ;_ end of setq

  ;; return a list of the point perpendicular from userpt3
  ;; on line segment between linept1 and linept2, as well
  ;; as the angle & distance between userpt3 and perpPt
  (list
    (setq perpPt(polar linept2 (angle linept2 linept1) dist:pt2->ToPerpPt))
    (distance userpt3 perpPt)
    (angle userpt3 perpPt)
  ) ;_ end of list
) ;_end of defun


;;;--------------------------------------------------------------------;
;;;     Function: midPoint                                             ;
;;;--------------------------------------------------------------------;
;;;  Description: This function returns the point at the middle        ;
;;;               between two give points                              ;
;;;--------------------------------------------------------------------;
(defun midPoint	(pt1 pt2)
  (polar pt1 (angle pt1 pt2) (/ (distance pt1 pt2) 2.00))
) ;_ end of defun
;|玍isual LISP