pipe.lsp

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

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

;;;--------------------------------------------------------------------;
;;; General Note:  THIS FILE IS A MEMBER OF THE REAC-TST PROJECT       ;
;;;--------------------------------------------------------------------;
;;;    This file contains a demonstration of a path based on a         ;
;;;    polyline.                                                       ;
;;;                                                                    ;
;;;    Creates a path - polyline and a base curve - circle.            ;
;;;                                                                    ;
;;;    The 3d figure will be created as an extrusion of the circle     ;
;;;    along the polyline (they are colored red). When you change the  ;
;;;    path or the circle the 3d figure will be updated.               ;
;;;--------------------------------------------------------------------;

;;;--------------------------------------------------------------------;
;;;       Function:  GET-VECTOR-ALONG                                  ;
;;;                                                                    ;
;;;    Description:  This function performs a subtraction of the       ;
;;;                  startPoint and EndPoint of a vla line object.     ;
;;;                                                                    ;
;;;      Arguments:                                                    ;
;;;            line = a valid vla line object.                         ;
;;;                                                                    ;
;;; Returned Value:  A vector list.                                    ;
;;;                                                                    ;
;;;          Usage:                                                    ;
;;;                   (get-vector-along vla-line-Object )              ;
;;;--------------------------------------------------------------------;
(defun get-vector-along	(line / from to)
  (setq	from (vla-get-startPoint line)
	to   (vla-get-EndPoint line)
  )
  (mapcar '- to from)
)

;;;--------------------------------------------------------------------;
;;;       Function:  MAKE-PIPE                                         ;
;;;                                                                    ;
;;;    Description:  This function extrudes a circle in the direction  ;
;;;                  of a path line. Note: Line and circle can not be  ;
;;;                  coplanar.                                         ;
;;;                                                                    ;
;;;                  Required Functions:                               ;
;;;                     get-model-space                                ;
;;;                                                                    ;
;;;      Arguments:                                                    ;
;;;            line = a valid vla line object.                         ;
;;;          circle = a valid vla circle object.                       ;
;;;                                                                    ;
;;; Returned Value:  A list of a vla 3d Solid Object. Such as:         ;
;;;                  (#<VLA-OBJECT IAcad3DSolid 02d23f2c>)             ;
;;;                                                                    ;
;;;          Usage:                                                    ;
;;;                   (make-pipe vla-line-Object vla-circle-object)    ;
;;;--------------------------------------------------------------------;
(defun make-pipe
       (line circle / mSpace region-list normal-vector exrude-list)
  (vla-move circle
	    (vlax-3d-point (vlax-curve-getstartPoint circle))
	    (vlax-3d-point (vlax-curve-getstartPoint line))
  )
(setvar "ISOLINES" 25)
(setq circleAa (vlax-make-safearray vlax-vbObject '(0 . 0)))
(vlax-safearray-put-element circleAa 0 circle)
(setq circleA (vlax-make-variant circleAa (logior vlax-vbarray vlax-vbObject)))  

  (setq	mSpace	    (get-model-space))
  (setq	region-list (vlax-safearray->list
		      (vlax-variant-value
			(vla-AddRegion mSpace circleA)
		      )
		     )
  )
  (setq	exrude-list (mapcar
		      (function
			(lambda	(region)
			  (vla-AddExtrudedSolidAlongPath mSpace region line)
			)
		      )
		      region-list
		    )
  )
  (foreach region region-list
    (if	(not (vlax-erased-p region))
      (vla-Erase region)
    )
  )
  exrude-list
)

;;;--------------------------------------------------------------------;
;;;       Function:  PROPERTY-CHANGED-P                                ;
;;;                                                                    ;
;;;    Description:  This function serves as a predicate. Testing for  ;
;;;                  the integrity of the data retreived from the      ;
;;;                  object to be the same as the supplied property.   ;
;;;                                                                    ;
;;;      Arguments:                                                    ;
;;;         vla-obj = a valid vla object.                              ;
;;;        property = a property list to compare.                      ;
;;;                                                                    ;
;;; Returned Value:  T if the property has changed. Nil otherwise.     ;
;;;                                                                    ;
;;;          Usage:                                                    ;
;;;                 (property-changed-p vla-line-Object prop-List)     ;
;;;--------------------------------------------------------------------;
(defun property-changed-p (vla-obj property)
  (and (eq 'VLA-OBJECT (type vla-obj))
       (vlax-read-enabled-p vla-obj)
       (vlax-property-available-p vla-obj property)
       (not (equal (vlax-get vla-obj property)
		   (vlax-ldata-get vla-obj property)
	    )
       )
  )
)

;;;--------------------------------------------------------------------;
;;;       Function:  REACTOR-PIPE-CIRCLE                               ;
;;;                                                                    ;
;;;    Description:  This function will be called inside a             ;
;;;                  :vlr-modified event.                              ;
;;;                                                                    ;
;;;                  Required Functions:                               ;
;;;                     reactor-pipe-line                              ;
;;;                                                                    ;
;;;      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:  A valid vlr reactor object.                       ;
;;;                                                                    ;
;;;          Usage:  Intended to be called from a reactor call back.   ;
;;;     (reactor-pipe-circle notifier reactor arg-list)                ;
;;;--------------------------------------------------------------------;
(defun reactor-pipe-circle (notifier reactor arg-list)
  (reactor-pipe-line
    (vlax-ldata-get notifier "line")
    reactor
    arg-list
  )
)

;;;--------------------------------------------------------------------;
;;;       Function:  REACTOR-PIPE-LINE                                 ;
;;;                                                                    ;
;;;    Description:  This function will be called inside a             ;
;;;                  :vlr-modified event and is invoked by             ;
;;;                  reactor-pipe-circle reactor call back. Its        ;
;;;                  purpose is to modify the reactor which            ;
;;;                  was invoked.                                      ;
;;;                                                                    ;
;;;                  Required Functions:                               ;
;;;                     property-changed-p                             ;
;;;                     change-pipe-list                               ;
;;;                                                                    ;
;;;      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:  A valid vlr reactor object.                       ;
;;;                                                                    ;
;;;          Usage:  Intended to be called from a reactor call back.   ;
;;;       (reactor-pipe-line notifier reactor arg-list)                ;
;;;--------------------------------------------------------------------;
(defun reactor-pipe-line (notifier reactor arg-list)
  (if (or t
	  (property-changed-p notifier "StartPoint")
	  (property-changed-p notifier "EndPoint")
      )
    ;;    (change-pipe notifier)
    ;|{|;
    (progn
      (if (null *editor-pipe-updating-reactor*)
	(setq *editor-pipe-updating-reactor* (VLR-Editor-reactor))
      )
      (if (not (VLR-added-p *editor-pipe-updating-reactor*))
	(vlr-add *editor-pipe-updating-reactor*)
      )
      (VLR-Data-Set
	*editor-pipe-updating-reactor*
	(cons notifier (VLR-Data *editor-pipe-updating-reactor*))
      )
      (vlr-reaction-set
	*editor-pipe-updating-reactor*
	:vlr-commandEnded
	(function change-pipe-list)
      )
    )
    ;|}|;
  )
)