;wclip.LSP JMD
;
;WORK IN PROGRESS. NOT FULLY TESTED.
;finish testing the filename entering and related stuff.
;     Known bugs:
;	-Does not work if the file exists. will not overwrite. <-- really? sometimes?
;	-It should not include the clip rectangle in the wblock.
;       -Something weird happens and offset does not work. Using the offset command (outside of the lisp routine) 
;       gives an error. The program verifies that a new ent was actually created before assuming entlast is 
;       safe to delete. 
;       -There are some things that should be changed to be more crash resistant. What happens if you don't pick
;        a lwpline? etc.
;**************************************************
; v0.0 1/14/99
;Cuts a clip out of a drawing.
;Copyright (c) 1999 by J. Marsden DeLapp
;
; REVISIONS:
; v0.01 7/23/99 Fixed so osmode is set to 0
; v1.00 3/17/00 Added funtionality to clip using a pline
;**************************************************
; Functions defined elsewhere
; Uses (dxf)
;=============== GLOBAL VARIABLES =======================
;No global variables used.
;**************** DXF needs to be included **********
(defun dxf (code elist)
  (cdr (assoc code elist))
)
;;; INTERNAL ERROR HANDLER
;;;
(defun MDL_er (s)                     ; If an error (such as CTRL-C) occurs
  (if (/= s "Function cancelled")     ; while this command is active...
    (princ (strcat "\nError: " s))
    (princ "\nDeLapp Software Function cancelled.")
  )
  (if olderr
    (setq *error* olderr)
  )   ; Restore old *error* handler
  (princ)
)
;======================================================================
; wclip
;======================================================================
(defun c:wclip ( / cmde ed_fence en_clip ent_fence fencestr fnam nextpt of1 oldentlast olderr pt1 ss1)
  (setq olderr *error*
	*error* MDL_er
	cmde (getvar "CMDECHO")
  )

;-------Delete this warning when ICAD undo bugs are fixed.---------
  (alert "\n  **   Warning   ** \nThis uses UNDO back command. \nSave your drawing before running if\nyou are using ICAD with undo bugs.")

  (princ "\nWclip v1.00 Copyright 2000 by J. Marsden DeLapp ")
  (setvar "CMDECHO" 0)
;set offset based on dimscale
  (if (/= 0 (getvar "DIMSCALE"))
    (setq of1 (/ (getvar "DIMSCALE") 10))
    (setq of1 .01)
  )
  (setq en_clip (entsel "\nPick a LWpline for the clip area: :")
	pt1 (getpoint "\nPick a point outside of clip area: ")
        oldentlast (entlast) ;this is used to be sure we don't delete the wrong thing later.
  );setq
  (command "._offset" of1 en_clip pt1 "");offset to create the fence line for trimming
  (setq ent_fence (entlast);get the fence line and store the points
	ed_fence (entget ent_fence)
	fencestr "" 
  )
  (if (= (dxf 0 ed_fence) "LWPOLYLINE")
    (while (> (length ed_fence) 0)
      (if (= 10 (caar ed_fence)); if the next item is a point
	(progn
	  (setq nextpt (dxf 10 ed_fence); get the point
	        fence (append fence (list nextpt))
	        fencestr (strcat fencestr " " (rtos (car nextpt)) "," (rtos (cadr nextpt)))
	  );add it to the point list
	)
      )
      (setq ed_fence (cdr ed_fence));get rid of the first item which is nil.
    );while
  )
  (setq fence (append fence (list (car fence))));Add the first point to the end to close it
  (setq fencestr  (strcat fencestr " " (rtos (caar fence)) "," (rtos (cadar fence)))) 
  (if (/= ent_fence oldentlast);Make sure we actually created the ent before deleting it
    (entdel ent_fence);delete the fence entity. It is not needed anymore.
  )
  (command "._undo" "mark");set mark for undo
;----------
;We could use some code here to select all blocks that cross the clip boundary and
;explode them. 
;
;Code should create ss1 of blocks using fence mode and the fence points that we just created.
;then explode ss1. Should actually "lexpolode" so entities end up on the block's layers. See Lexplode.lsp file.
;Could also get creative and do it over until no more blocks cross the line to handle nested blocks. 
;-----------
;Trim all the entities using a fence
  (command "._trim" en_clip "" "f" fence "" "" )
;select the entities for the wblock using a crossing polygon.  
  (setq ss1 (ssget "cp" fence))
;Now do the wblock.
  (if (Setq fnam (getfiled "Wblock to file" "" "dwg" 3))
    (progn  ;; check if file exists and prompt to overwrite.
      (if (= (strcat fnam ".DWG") (findfile (strcat fnam ".DWG")))
	(progn
	  (initget 0 "Yes No")
	  (if (= "Yes" (getkword "\nFile exists. Overwrite? <No> "))
	    (command "._wblock" fnam "y" "" '(0 0) ss1 "")
	  )
	)
	(progn
	  (princ "\nFile did not exist. Writing new file.... ")
	  (command "._wblock" fnam "" '(0 0) ss1 "")
	)
      )
    )
  );if fnam
  (command "._undo" "Back")
  (setvar "CMDECHO" cmde)
  (setq *error* olderr)
  (princ)
)
;defun===========================
(princ "\nWclip.lsp loaded. ")
(princ)