;;; unpath.lsp
;;; This will remove the path from an xref or all xrefs
;;; Author: J. Marsden DeLapp 12/8/03 Copyright 2003

; This program is free software; you can redistribute it and/or modify 
; it under the terms of the GNU General Public License as published by 
; the Free Software Foundation; either version 2 of the License, or (at 
; your option) any later version.

; This program is distributed in the hope that it will be useful, but
; WITHOUT ANY WARRANTY; without even the implied warranty of 
; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU 
; General Public License for more details. 

; You should have received a copy of the GNU General Public License along 
; with this program; if not, write to the Free Software Foundation, Inc., 
; 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.

;A copy of the license is available at http://www.gnu.org/licenses/gpl.html

;;;**** Revisions **** -----------------------------------------------
; v1.00 12/8/03
; v1.01 12/8/05 added GPL license
;;;**** Global variables defined **** --------------------------------
; none used
;;;**** Global variables used **** -----------------------------------
; none used
;;;**** Functions defined **** ---------------------------------------
; gen_er getxref chkxref unpathxref unpathall 
;;;**** Functions used **** ------------------------------------------
; (dxf)
;;;**** Commands defined **** ----------------------------------------
; c:unpathxref c:unpathall
;;;**** Any other dependancies, or other files required. **** --------
; required functions are included
;;;**** Detailed Instructions if needed **** -------------------------
; Load it and run unpathxref or unpathall.
;;;

;*****************************************************************
;;; INTERNAL ERROR HANDLER
;;; Generic error handler
(defun gen_er (s)                     ; If an error (such as CTRL-C) occurs
                                      ; while this command is active...
  (if (/= s "Function cancelled")
    (princ (strcat "\nError: " s))
    (princ "\n*Function cancelled*")
  )
  (princ)
)

;======================= getxref ==========================================
;;;; getxref EXAMPLE use:
;
;(setq en (entsel "\nSelect an xref: ")
;      ed (entget (car en))
;)
;(setq xrefname (getxref en))

;;;;EXAMPLE2:
;(setq xrefname (getxref nil))

(defun getxref (en / blknam ed etype idata iflags isxref lstr verbose)
  (setq olderr *error*
	*error* gen_er
  )

; Select an xref if en parameter is nil
  (if (= en nil)
    (setq en (entsel "\nSelect an xref: ")
	  verbose T
    )
  )
  (if (/= en nil)
    (progn
      (setq ed (entget (car en)))

      (setq lstr (dxf 8 ed))
      (setq etype (dxf 0 ed))
      (if (= etype "INSERT")
	(progn
	  (setq blknam (dxf 2 ed);get blockname
		idata (tblsearch "BLOCK" blknam);set insertdata to block def
		iflags (dxf 70 idata) ;get the flags


	  );setq
       ;(boole 1 .....) does a bitwise AND on integer values
	  (setq isxref (boole 1 4 iflags));if flag bit 4 is set it is an xref
	  (if (= (boole 1 4 iflags) 4);if flag bit 4 is set it is an xref
	    (progn
	      (if verbose
		(princ "Selected xref: ")
	      )

	      (eval blknam)
	    );progn
	    (progn
	      (if verbose
		(princ "\nSelected block entity was not an xref!")
	      )
	      (eval nil)
	    )
	  );if
	);progn
	(progn
	  (if verbose
	    (princ "\nEntity was not an xref! (not an insert)")
	  )
	  (eval nil)
	)
      );if - entity is an insert
    )
    (progn
      (princ "\nNothing selected.")
      (eval nil)
    )
  )
)

;======================= chkxref ==========================================
;checks if a block name is an xref, returns xrefname or nil if not an xref
(defun chkxref (blknam /)
  (setq olderr *error*
	*error* gen_er
  )

  (setq idata (tblsearch "BLOCK" blknam);set insertdata to block def
	iflags (dxf 70 idata) ;get the flags
  );setq

  ;(boole 1 .....) does a bitwise AND on integer values
  (if (= (boole 1 4 iflags) 4);if flag bit 4 is set it is an xref
    (eval blknam)
    (eval nil)
  );if
)
;======================= unpathxref ==========================================
(defun unpathxref (blknam / edblk enblk path)
;note that we already verified that we have an xref before calling this function.
  (if (/= blknam nil)
    (progn
      (setq enblk (tblobjname "BLOCK" blknam);Find the block
	    edblk (entget enblk)
	    path (dxf 3 edblk)
      )
      (princ "\nXref: ")(princ blknam)
      (princ " ; old path = ")
      (princ path)
;      (princ "\nedblk =")
;      (princ edblk)      
      
      ; Here we make the assumption that the correct dwg file name is the block name.
      ; This may not always be the case, if the xref has been "repathed" to a different
      ; file name.
      (setq edblk (subst
		    (cons 3 (strcat blknam ".dwg"))
		    (assoc 3 edblk)
		    edblk
		  )
      )

;      (princ "\nedblk =")
;      (princ edblk)
      (entmod edblk)
      (princ " ; new path = ")
      (princ (dxf 3 edblk))
    )
  )
(princ)
)

(defun c:unpathxref (/ blknam count)
  (princ "\nUnPath Xref V1.0 Copyright 2003 by J. Marsden DeLapp.")
  (setq Blknam (getxref nil))
  (if (and (/= blknam nil) (/= (chkxref Blknam) nil))
    (unpathxref Blknam)
  );if we have an xref name
(princ)
)

;======================= c:unpathall ==========================================
(defun unpathall ( / blklst blknam count olderr)
  (setq olderr *error*
	*error* gen_er
  )
  (princ "\nUnPath Xref V1.0 Copyright 2003 by J. Marsden DeLapp.")
  (setq BlkLst (tblnext "BLOCK" T)
	count 0
  )
  (while BlkLst ;step through all blocks in the table
    (setq Blknam (cdr (assoc 2 BlkLst)))
    
    ;only do it for xrefs, not blocks
    (if (/= (chkxref Blknam) nil)
      (progn
	(unpathxref Blknam)
	(setq Count (1+ Count))
      )
    );if we have an xref name
    (setq BlkLst (tblnext "BLOCK"))
  );;while
  (princ "\nStripped ")
  (princ count)
  (princ " xref paths.")
  (setq *error* olderr)
  (princ)
)
(defun c:unpathall () (unpathall)(princ) )
(princ "\nUnPath Xref V1.01 Copyright 2003 by J. Marsden DeLapp.")
(princ "\nUnPath loaded. Commands are UnPathXref or UnPathAll.")(princ)