Full path to Relative Lisp/VBA

Hi again,

i was wondering if there is a lisp routine, or VBA to be able to change the path of multiple xrefs for all drawings from Attachment to overlay or full path to relative path.

cheers

Emily

Check the 'Similar threads' below.

i am looking through a few but have not found a thread yet relating to what i need, do you know the name of the thread and will search it.???

You can change full to relative with Reference manager. You may want to look here for attachment to overlay.

Thankyou Ipseifert,

much appreciated,

Emily

We do not use XREFS any more but here is some code we used when we did. There may be some you can use. I have not checked it through so let me know if I left out a snippet.

;------------------------------------------------------------------------------
;REM_XREF_PATH: Remove external reference path
;------------------------------------------------------------------------------
(defun REM_XREF_PATH (/ NEWPATH PPOS XPATH XREF XREFNAME XREFS)
 (if (= (setq XREFS (GETXREF)) nil)
   ;(alert "No XREF's are present")
   (princ)
   (progn
     (if (= (setq LISTLEN (length XREFS)) 1)
       (progn
         (setq XREFNAME (car XREFS))
         (setq XREF (tblsearch "BLOCK" XREFNAME))
         (setq XPATH (cdr (assoc 1 XREF)))
     (setq PPOS (pp_LastCharPosInString XPATH "\\"))
     (if PPOS
       (progn
         (setq NEWPATH (substr XPATH (1+ PPOS)))
             (if (not (FILE_EXIST_CURR_FOLDER NEWPATH))
               (alert "XREF drawing does not reside in folder with this drawing,
                 \nor the name of the file does not match the XREF path.
                 \nPlease correct this before proceeding.")
               (progn
                 (command "-XREF" "PATH" XREFNAME NEWPATH)
                 (princ "\nXREF path changed")
                 );progn            
               );if
         );progn
           ;(princ "\nXREF path is correct already.")
       );if
         );progn
       (alert "More than 1 XREF exists.\nPlease correct this before processing")
       );if
     );progn
   );if
 (princ)
 );defun
;------------------------------------------------------------------------------
;GETXREF: Get external reference path
;------------------------------------------------------------------------------
(defun GETXREF (/ ABLOCK ACTIVEDOC ITEM THEBLOCKS THELIST YESXREF)
 ;retrieve a reference to the Active Document
 (setq ACTIVEDOC (vla-get-activedocument (vlax-get-acad-object)))
 ;retrieve a reference to the blocks
 (setq THEBLOCKS (vla-get-blocks ACTIVEDOC))
 ;create an empty list
 (setq THELIST '())
 ;process each block
 (vlax-for ITEM THEBLOCKS

 ;check if it's an Xref
   (setq YESXREF (vlax-get-property ITEM 'ISXREF))
 ;if it is
   (if    (= YESXREF :vlax-true)
 ;do the following
     (progn
 ;get the Xref name
   (setq ABLOCK (vlax-get-property ITEM 'NAME))
 ;store it in the list
   (setq THELIST (append (list ABLOCK) THELIST))
     ) ;progn
   ) ;if
 ) ;vlax-for
 ;print the list
 THELIST
) ;defun
;------------------------------------------------------------------------------
;LISTXREFS: List all external references
;------------------------------------------------------------------------------
(defun LISTXREFS (/ CODE ENT)
 (apply
   'append
   (mapcar
     '(lambda (X / ENT CODE)
        (if (= (logand
                 (setq CODE
                   (cdr (assoc 70 (setq ENT (entget (tblobjname "BLOCK" X)))
                          );assoc
                        );cdr
                   );setq
                 4);logand compare to see if 4 is present in dotted 70
                   ;if 4 is present, it is an xref
               4);equal to
          ;if the logand = 4 then create the list of properties
          (list (list (cdr (assoc 2 ENT))
                      (if (= (logand CODE  8)
                        "Overlay"
                        "Attachment"
                      );if
                      (if (= (logand CODE 32) 32)
                        "Loaded"
                        "Unloaded"
                      );if
                      (cdr (assoc 1 ENT))
                );list
          ) ;list
        ) ;if
      ) ;lambda
     (TABLE "BLOCK") ;list all blocks in block table
   );mapcar
 )
)
;------------------------------------------------------------------------------
; TABLE - List all table entries
;------------------------------------------------------------------------------
(defun TABLE (SYM / EN SYMLIST)
 (while (setq EN (tblnext SYM (null EN)))
   (setq SYMLIST (cons (cdr (assoc 2 EN)) SYMLIST))
 )
)
;------------------------------------------------------------------------------
; FILE_EXIST_CURR_FOLDER - Does the file exist in the current dwg folder
;------------------------------------------------------------------------------
(defun FILE_EXIST_CURR_FOLDER (DWG / CURRPATH)
 (setq CURRPATH (getvar "DWGPREFIX"))
 (findfile (strcat CURRPATH DWG))
 );defun

We do not use XREFS any more but here is some code we used when we did. There may be some you can use. I have not checked it through so let me know if I left out a snippet.

Just in case anyone is interested, I have modified the code above to work with multiple XREFs, there is probably a better way to do this, but it works:

;------------------------------------------------------------------------------
;REM_XREF_PATH: Remove external reference path
;------------------------------------------------------------------------------
(defun REM_XREF_PATH (/ NEWPATH PPOS XPATH XREF XREFNAME XREFS)
 (if (= (setq XREFS (GETXREF)) nil)
   ;(alert "No XREF's are present")
   (princ)
   (progn
  (setq XRPT 0)
  (setq XRCT (length XREFS))
     (while (< XRPT XRCT)
       (progn
         (setq XREFNAME (nth XRPT XREFS))
	  (setq XRPT (+ XRPT 1))
         (setq XREF (tblsearch "BLOCK" XREFNAME))
         (setq XPATH (cdr (assoc 1 XREF)))
     (setq PPOS (pp_LastCharPosInString XPATH "\\"))
     (if PPOS
       (progn
         (setq NEWPATH (substr XPATH (1+ PPOS)))
             (if (not (FILE_EXIST_CURR_FOLDER NEWPATH))
               (alert "XREF drawing does not reside in folder with this drawing,
                 \nor the name of the file does not match the XREF path.
                 \nPlease correct this before proceeding.")
               (progn
                 (command "-XREF" "PATH" XREFNAME NEWPATH)
                 (princ "\nXREF path changed")
                 );progn            
               );if
         );progn
           ;(princ "\nXREF path is correct already.")
       );if
         );progn        
       );While
     );progn
   );if
 (princ)
);defun
;------------------------------------------------------------------------------
;GETXREF: Get external reference path
;------------------------------------------------------------------------------
(defun GETXREF (/ ABLOCK ACTIVEDOC ITEM THEBLOCKS THELIST YESXREF)
 ;retrieve a reference to the Active Document
 (setq ACTIVEDOC (vla-get-activedocument (vlax-get-acad-object)))
 ;retrieve a reference to the blocks
 (setq THEBLOCKS (vla-get-blocks ACTIVEDOC))
 ;create an empty list
 (setq THELIST '())
 ;process each block
 (vlax-for ITEM THEBLOCKS

 ;check if it's an Xref
   (setq YESXREF (vlax-get-property ITEM 'ISXREF))
 ;if it is
   (if    (= YESXREF :vlax-true)
 ;do the following
     (progn
 ;get the Xref name
   (setq ABLOCK (vlax-get-property ITEM 'NAME))
 ;store it in the list
   (setq THELIST (append (list ABLOCK) THELIST))
     ) ;progn
   ) ;if
 ) ;vlax-for
 ;print the list
 THELIST
) ;defun
;------------------------------------------------------------------------------
;LISTXREFS: List all external references
;------------------------------------------------------------------------------
(defun LISTXREFS (/ CODE ENT)
 (apply
   'append
   (mapcar
     '(lambda (X / ENT CODE)
        (if (= (logand
                 (setq CODE
                   (cdr (assoc 70 (setq ENT (entget (tblobjname "BLOCK" X)))
                          );assoc
                        );cdr
                   );setq
                 4);logand compare to see if 4 is present in dotted 70
                   ;if 4 is present, it is an xref
               4);equal to
          ;if the logand = 4 then create the list of properties
          (list (list (cdr (assoc 2 ENT))
                      (if (= (logand CODE  8)
                        "Overlay"
                        "Attachment"
                      );if
                      (if (= (logand CODE 32) 32)
                        "Loaded"
                        "Unloaded"
                      );if
                      (cdr (assoc 1 ENT))
                );list
          ) ;list
        ) ;if
      ) ;lambda
     (TABLE "BLOCK") ;list all blocks in block table
   );mapcar
 )
)
;------------------------------------------------------------------------------
; TABLE - List all table entries
;------------------------------------------------------------------------------
(defun TABLE (SYM / EN SYMLIST)
 (while (setq EN (tblnext SYM (null EN)))
   (setq SYMLIST (cons (cdr (assoc 2 EN)) SYMLIST))
 )
)
;------------------------------------------------------------------------------
; FILE_EXIST_CURR_FOLDER - Does the file exist in the current dwg folder
;------------------------------------------------------------------------------
(defun FILE_EXIST_CURR_FOLDER (DWG / CURRPATH)
 (setq CURRPATH (getvar "DWGPREFIX"))
 (findfile (strcat CURRPATH DWG))
 );defun

Repath xrefs full or relative

Relative xref paths