gpdraw.lsp

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

	   ((equal ObjectCreationStyle "ENTMAKE")
	    gp:Create_entmake_Circle
	   )
	   ((equal ObjectCreationStyle "COMMAND")
	    gp:Create_command_Circle
	   )
	   (T
	    	(alert (strcat
			 "ObjectCreationStyle in function gp:calculate-Draw-TileRow"
			 "\nis invalid.  Please contact the developer for assistance."
			 "\n        ObjectCreationStyle set to ACTIVEX"
			 )
		 )
	    	(setq objectCreationStyle "ACTIVEX")
	   )
	 )

  )
  ;; Draw the circles to the left of the center
  (while (< (distance startPoint tileCenterPt) HalfWidth)
    ;; Add each tile to the list to return
	(setq tileList
	       (cons
		 (ObjectCreationFunction tileCenterPt TileRadius)
		 tileList
		 )
	      )

    
    ;; Calculate the center point for the next tile
    (setq tileCenterPt
	   (polar tileCenterPt
		  angp90
		  TileSpacing
	   )
    )
  );_ end of while

  ;; Draw the circles to the right of the center
  (setq	tileCenterPt
	 (polar	firstCenterPt
		angm90
		TileSpacing
	 )
  )
  (while (< (distance startPoint tileCenterPt) HalfWidth)
    ;; Add each tile to the list to return
	(setq tileList
	       (cons
		 (ObjectCreationFunction tileCenterPt TileRadius)
		 tileList
		 )
	      )
    
    ;; Calculate the center point for the next tile
    (setq tileCenterPt
	   (polar tileCenterPt
		  angm90
		  TileSpacing
	   )
    )
  );_ end of while
  
  ;; Return the list of tiles
  tileList
) ;_ end of defun

;;;--------------------------------------------------------------------;
;;;     Function: gp:Calculate-and-Draw-Tiles                          ;
;;;--------------------------------------------------------------------;
;;;  Description: This is the main tile drawing function.  It is       ;
;;;               called from C:GPATH.  The function sets up a loop,   ;
;;;               based on the path length and calls the               ;
;;;               gp:calculate-Draw-TileRow function as many times as  ;
;;;               necessary to "fill up" the path boundary.            ;
;;;--------------------------------------------------------------------;
;;;  NOTE: No validity checking is performed on BoundaryData!!!        ;
;;;--------------------------------------------------------------------;
(defun gp:Calculate-and-Draw-Tiles (BoundaryData / PathLength TileSpace
				    TileRadius SpaceFilled SpaceToFill
				    RowSpacing offsetFromCenter
				    rowStartPoint pathWidth pathAngle
				    ObjectCreationStyle	TileList)
  (setq PathLength	     (cdr (assoc 41 BoundaryData))
        TileSpace	     (cdr (assoc 43 BoundaryData))
        TileRadius	     (cdr (assoc 42 BoundaryData))
        SpaceToFill	     (- PathLength TileRadius)
        RowSpacing	     (*	(+ TileSpace (* TileRadius 2.0))
				(sin (Degrees->Radians 60))
		     	     ) ;_ end of *
        SpaceFilled	     RowSpacing
        offsetFromCenter 0.0
        offsetDistance   (/ (+ (* TileRadius 2.0) TileSpace) 2.0)
        rowStartPoint    (cdr (assoc 10 BoundaryData))
        pathWidth	     (cdr (assoc 40 BoundaryData))
        pathAngle	     (cdr (assoc 50 BoundaryData))
	ObjectCreationStyle (strcase (cdr (assoc 3 BoundaryData)))
  ) ;_ end of setq

  ;; Compensate for the very first Start Point!
  (setq	rowStartPoint
	 (polar	rowStartPoint
		(+ pathAngle pi)
		(/ TileRadius 2.0)
	 ) ;_ end of polar
  ) ;_ end of setq
  ;; Draw each row of tiles
  (while (<= SpaceFilled SpaceToFill)
    ;; Get the list of tiles created, adding them to our list
    (setq tileList	   (append tileList
				   (gp:calculate-Draw-TileRow
				     (setq rowStartPoint
					    (polar rowStartPoint
						   pathAngle
						   RowSpacing
					    ) ;_ end of polar
				     ) ;_ end of setq
				     TileRadius
				     TileSpace
				     pathWidth
				     pathAngle
				     offsetFromCenter
				     ObjectCreationStyle
				   ) ;_ end of gp:calculate-Draw-TileRow
			   ) ;_ end of append
	  ;; Calculate the distance along the path for the next row
	  SpaceFilled	   (+ SpaceFilled RowSpacing)
	  ;; Alternate between a zero and a positive offset
	  ;; (causes alternate rows to be indented)
	  offsetFromCenter
			   (if (= offsetFromCenter 0.0)
			     offsetDistance
			     0.0
			   ) ;_ end of if
    ) ;_ end of setq
  ) ;_ end of while
  ;; Return the list of tiles created
  tileList
) ;_ end of defun

;;;--------------------------------------------------------------------;
;;;  The following three functions correspond to the three different   ;
;;;  methods by which the tiles (circles) are drawn in the path.       ;
;;;  NOTE:  Each of these tile creation functions must return the      ;
;;;         ActiveX name of the circle created                         ;
;;;--------------------------------------------------------------------;

;;;--------------------------------------------------------------------;
;;;     Function: gp:Create_activeX_Circle                             ;
;;;--------------------------------------------------------------------;
;;;  Description: Use ActiveX Automation to create a circular tile     ;
;;;--------------------------------------------------------------------;
(defun gp:Create_activeX_Circle	(center radius)
  (vla-addCircle *ModelSpace*
    (vlax-3d-point center) ; creates ActiveX-compatible 3D point structure 
    radius)
) ;_ end of defun

;;;--------------------------------------------------------------------;
;;;     Function: gp:Create_entmake_Circle                             ;
;;;--------------------------------------------------------------------;
;;;  Description: Use (entmake) to create a circular tile              ;
;;;--------------------------------------------------------------------;
(defun gp:Create_entmake_Circle	(center radius)
  (entmake
    (list (cons 0 "CIRCLE") (cons 10 center) (cons 40 radius))
  ) ;_ end of entmake
  (vlax-ename->vla-object (entlast))
) ;_ end of defun

;;;--------------------------------------------------------------------;
;;;     Function: gp:Create_command_Circle                             ;
;;;--------------------------------------------------------------------;
;;;  Description: Use (command) to create a circular tile              ;
;;;--------------------------------------------------------------------;
(defun gp:Create_command_Circle	(center radius)

  (command "_CIRCLE" center radius)
  (vlax-ename->vla-object (entlast))
) ;_ end of defun