gpdraw.lsp

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

	    gp:Create_activeX_Circle
	    )
	   ((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
				    ObjectCreationStyle
				    /
;;;				     PathLength	      TileSpace
;;;				     TileRadius	      SpaceFilled
;;;				     SpaceToFill      RowSpacing
;;;				     offsetFromCenter rowStartPoint
;;;				     pathWidth	      pathAngle
;;;				     TileList
				    )
;;;  (princ "\ngp:Calculate-and-Draw-Tiles")
  ;; updated for printability
  (princ "\ngp:Calculate-and-Draw-Tiles: ")
  (setq
;;;    see		     BoundaryData
    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))
			)
    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))
    )
  (if (not ObjectCreationStyle)
    (setq ObjectCreationStyle (strcase (cdr (assoc 3 BoundaryData))))
    )

  ;; Compensate for the very first Start Point!
  (setq	rowStartPoint
	 (polar	rowStartPoint
		(+ pathAngle pi)
		(/ TileRadius 2.0)
		)
	)
  ;; 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
						   )
					   )
				     TileRadius
				     TileSpace
				     pathWidth
				     pathAngle
				     offsetFromCenter
				     ObjectCreationStyle
				     )
				   )
	  ;; 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
			     )
	  )
    )
  ;; Return the list of tiles created
  tileList
  )

;;;--------------------------------------------------------------------;
;;;  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)
;;;-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*
;;; Old pinetop	
;;; (vla-addCircle *ModelSpace*  center radius)
;;;-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*
  ;; Updated for AutoCAD 2000
  (vla-addCircle *ModelSpace* (vlax-3d-point center) radius)
  )
;;;--------------------------------------------------------------------;
;;;     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))
    )
  (vlax-ename->vla-object (entlast))
  )

;;;--------------------------------------------------------------------;
;;;     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))
  )



 ;|玍isual LISP