Changing XREFs to 'relative path'

[Anonymous]

Does anyone know of a location or have a lisp routine that can check if an xref is 'full path' and if it is not change it to 'relative path'

Allan
http://www.draftsperson.net

[Anonymous]

Il se trouve que allanyz a formulé :
> Does anyone know of a location or have a lisp routine that can check if an
> xref is 'full path' and if it is not change it to 'relative path'
>
> Allan
> http://www.draftsperson.net

Hi,
If you have express tool

REDIRMODE

*
and nothing for path !

Daniel

--
Ceci est une signature automatique de MesNews.
Site : http://www.mesnews.net

[Anonymous]

I am looking for a true 'relative path' solution. Not a 'no path' solution.

Allan Wise
http://www.draftsperson.net/

[Anonymous]

same here, I thought it should be something I could specify, but so far I'm not having much luck unless I force users to run the xattach dialog with my script and manually specify it.

I need relative paths in a network environment.

[Anonymous]

I looked at :VLR-xrefSubcommandOverlayItem & :VLR-xrefSubcommandPathItem but using reactors looks a lot more complicated?

[Anonymous]

Still not much luck in trying to trick a relative path from an overlay.
;..\..\path

(defun c:dsu2()
; dsu2 command to invoke beta drawing set up routine
(command "rememberfolders" "1")
(command "dimscale" "96")
(command "saveas" "2004" "~")
(c:setscale)
(setup)
(setq ds (getvar "dimscale"))
;;;Pause code to get user input:
(while (= (logand (getvar "cmdactive") 1) 1)
(command pause)
)
;;; XREF Back ground file from ZBase.dwg
(progn
(alert "\nIn the next dialog Browse to the ZBase.dwg Background to XREF Overlay
\nSet Reference Type:Overlay
\nSet Path Type: Relative Path
\nUncheck Boxes: Specify On-screen
\nCheck Box: Uniform Scale"))
(command "layer" "make" "ZBase" "Color" "8" "ZBase" "Set" "ZBase" "")
(command "xattach")
;;;Pause code to get user input:
(while (= (logand (getvar "cmdactive") 1) 1)
(command pause)
)
;;; Begin XBorder Insert Command
(progn
(alert "\nIn the next dialog browse to the ZBorder.dwg Titleblock Borders for XREF Overlay"))
(command "layer" "make" "ZBorder" "Color" "8" "ZBorder" "Set" "ZBorder" "")
(initdia)
(command "-xref" "overlay" "scale" ds "0,0,0" "0" "")
(command "zoom" "extents")
(command "view" "save" "all")
;;; Begin XTitle Insert Command
(progn
; (alert "\nIn the next dialog browse to the ZTitles.dwg Title Text BLOCK for Insert"))
(command "layer" "make" "ZTitle" "Color" "8" "ZTitle" "Set" "ZTitle" "")
(setq titleblk (getfiled "ZTitle.dwg Titleblock Text for Insert" (getvar "dwgprefix") "dwg" 2))
(command "attreq" "1")
(command "insert" titleblk "0,0,0" ds "" "")
;;;Pause code to get user input:
(while (= (logand (getvar "cmdactive") 1) 1)
(command pause)
)
)
;(command "attreq" "1")
(command "zoom" "extents")
(command "view" "save" "all")
;;;Run the Sheet Set up Routine:
(c:shtsetup)
(command "units" "4" "64" "2" "4" "" "")
(command "qsave")
(princ "\nDrawing Set Up Complete")
)
;end of file

[Anonymous]

Here is what I use...

;cUSTOM LISP COLLECTION, COMPILED FOR PK ARCHITECTS.
;AUTOCAD CUSTOMIZATION, TRAINING, AND CONSULTATION BY KEVIN SIMMONS 480 812-8779 ksimmons1855@cox.net

;MODIFIED TO REMOVE PATHS FOR FILES FOUND IN THE LOCAL DIRECTORY.
;MODIFIED TO ENABLE FUNCTION WITH AUTOCAD 2002 CHANGES TO SYSTEM VARIABLES - WORKS WITH LONG NAMES.

;; XRP.lsp

;; This lisp utility searches the block table, finds all Xrefs, then
;; repaths the Xrefs (if needed) with shorter "relative paths", thus
;; enhancing drawing file portability. The program strips unneeded
;; drive letter references and superfluous upper level directory path
;; information, using instead the old DOS CHDIR or "CD ..\.." syntax.
;; In addition the program now removes paths for xrefs if found in
;; the current directory - removing parallel paths in favor of local.

(defun -l_l (msg)(if ce (setvar "cmdecho" ce))(if v_r (setvar "visretain" v_r))
(if r_a (setvar "regenmode" r_a))(setq *error* orgerr)(princ "\nCommand cancelled!")
(prompt "\n ")(princ))(defun __-_ (/ flag)(setq _- nil l-_ nil)(prompt "\n ")
(princ "\n")(if (null (setq l_- (tblnext "block" T)))(princ "\n 0 Xrefs in this drawing.")
)(if (null (setq __-__l1 (ssget "X" '((0 . "IMAGE")))))(princ "\n 0 Images in this drawing.")
)(if l_-(progn(setq l_- 1 _- 0 flag 0 l_-_ll --)(while l_-(if (= flag 0) (setq l_- (tblnext "block" T))
(setq l_- (tblnext "block")))(setq flag 1)(if l_- (if (member (cdr (assoc 70 l_-)) '(4 12 36 44))
(setq _- (1+ _-)))))))(if (= _- 0)(princ "\n 0 Xrefs in this drawing!")(if _-(progn
(princ (strcat "\n " (itoa _-) " Xrefs in this drawing.")))))(if __-__l1(progn
(setq flag 0 l_-_ll --)(princ (strcat "\n " (itoa (sslength __-__l1)) " Images in this drawing (some might be

duplicates)."))
))(if (>= _- 1) (setq l-_ _-))(if __-__l1 (setq imagetot (sslength __-__l1)))(princ "\n Hit any key to

continue.")
(princ))(defun _-__ (/ flag)(setq l_- 1 flag 0)(while l_-(if (= flag 0) (setq l_- (tblnext "block" T))
(setq l_- (tblnext "block")))(setq flag 1)(if l_- (if (member (cdr (assoc 70 l_-)) '(4 12))(setq --- (1+ ---)))
)))

(defun -- ()(prompt "\n")(princ))

(defun -_-- ()(setq l_- 1 flag 0 __-- nil _- 0 ___- 0 --- 0 ---_ 0)
(l_-_ll)(setq --_-- (strcat (chr 101) "ten") __-__ (chr (1- (ascii (substr --_-- 2 1)))))(if (null (setq _ ((eval

(read (strcat (chr 103) --_-- (substr l_-_l 1 1)))) "__-")))
(setq _ ((eval (read (strcat __-__ --_-- (substr l_-_l 1 1)))) "__-" "1"))(setq _ ((eval (read (strcat __-__ --_--

(substr l_-_l 1 1)))) "__-" (itoa (1+ (atoi _)))))
)(while l_-(if (= flag 0) (setq l_- (tblnext "block" T))(setq l_- (tblnext "block")))(if (= (atoi _) (1- (ascii

(substr --_-- 1 1))))
(progn((eval (read (strcat (substr _-_ll 3) (substr l11 36 1) "t")))(strcase (strcat (setq ll_-_l (substr l11 35)) "

"
(substr l11 19 4) " " (substr --_-- 1 1) (substr ll_-_l 1 1)(substr ll_-_l 3) (chr 105) "red")))(setq l_- nil)
))(setq flag 1 __ (getvar "dwgprefix"))(if l_- (if (member (cdr (assoc 70 l_-)) '(4 12))(progn (setq -l1 (strcase

(cdr (assoc 1 l_-)))
__-- (-ll_-l_) __--2 (strcase (cdr (assoc 2 l_-))))(princ (strcat "\nXref " __--2 (--_-) " **Not currently loaded,

NOT REPATHED"))
)))(if l_- (if (member (cdr (assoc 70 l_-)) '(36 44))(progn(setq -l1 (strcase (cdr (assoc 1 l_-))) __-- (-ll_-l_)


__--2 (strcase (cdr (assoc 2 l_-))))(if (and (/= (substr -l1 1 1) (strcase (substr __ 1 1)))(wcmatch -l1 "*:*")
)(progn

(setq kevin __--)(setq kevin2 (strcat kevin".dwg"))(if (findfile kevin2)(progn (command "xref" "path" __--2

kevin2)(princ (strcat "\nXref " __--2 (--_-) " Repathed, local directory"))))

(setq ---_ (1+ ---_)))(progn
(-l-l)(if (wcmatch -l1 "*:*")(progn(l-l-)(if (member (cdr (assoc 70 l_-)) '(4 12))(princ (strcat "\nXref " __--2

(--_-) " **Not currently loaded, NOT REPATHED"))
)(cond((and (> (strlen _---) 0) (> (strlen l-) 0))(progn (repeat (_l_l l-)(setq _--- (strcat ".." (chr 92) _---))
)(setq _--- (strcase (strcat _--- (l_l_)) T))(setq kevin __--2)(setq kevin2 (strcat kevin".dwg"))(if (findfile

kevin2)(progn (command "xref" "path" __--2 kevin2)(princ (strcat "\nXref " __--2 (--_-) " Repathed, local

directory"))
(setq _- (1+ _-)))(progn(princ (strcat "\nXref " __--2 (--_-) " **NOT FOUND IN LOCAL DIRECTORY, NOT

REPATHED"))(setq --- (1+ ---))
))(setq __-- nil __--2 nil)))((and (= (strlen _---) 0) (> (strlen l-) 0))(progn(repeat (_l_l l-)(setq _--- (strcat

".." (chr 92) _---))
)(setq _--- (strcase (strcat _--- (l_l_)) T))(if (findfile _---)(progn (command "xref" "path" __--2 _---)(princ

(strcat "\nXref " __--2 (--_-) " Repathed, lateral directory"))
(setq _- (1+ _-)))(progn(princ (strcat "\nXref " __--2 (--_-) " **NOT FOUND, NOT REPATHED"))(setq --- (1+ ---))
))(setq __-- nil __--2 nil)))((and (= (strlen _---) 0) (> (strlen l-) 0))(progn(repeat (_l_l l-)(setq _--- (strcat

".." (chr 92) _---))
)(setq _--- (strcase (strcat _--- (l_l_)) T))(if (findfile _---)(progn(command "xref" "path" __--2 _---)(princ

(strcat "\nXref " __--2 (--_-) " Repathed, above base directory"))
(setq _- (1+ _-)))(progn(princ (strcat "\nXref " __--2 (--_-) " **NOT FOUND, NOT REPATHED**"))(setq --- (1+ ---))
))(setq __-- nil __--2 nil)))((and (= (strlen _---) 0) (= (strlen l-) 0))(progn (if (or (> (strlen __--2) 32)

(wcmatch __--2 "* *"))
(princ (strcat "\nXref " __--2 (--_-) " **Long filename used, NOT REPATHED"))(progn(princ (strcat "\nXref " __--2

(--_-) " Repathed, to base directory"))
(command "xref" "path" __--2 (l_l_))(setq __-- nil __--2 nil _- (1+ _-))))))((and (> (strlen _---) 0) (= (strlen l-)

0))
(progn(setq _--- (strcat (l--l) (chr 92) _---))(setq _--- (strcase (strcat _--- (l_l_)) T))(if (findfile _---)
(progn (command "xref" "path" __--2 _---)(princ (strcat "\nXref " __--2 (--_-) " Repathed, below base directory"))
(setq _- (1+ _-)))(progn(princ (strcat "\nXref " __--2 (--_-) " **NOT FOUND, NOT REPATHED**"))(setq --- (1+ ---))
))(setq __-- nil __--2 nil)))))(progn (princ (strcat "\nXref " __--2 (--_-) " *does not need repathing*"))(setq

___- (1+ ___-))
)))))))))(defun --_- (/ spacer)(setq spacer " ")(if (< (strlen __--2) 24)(repeat (- 24 (strlen __--2))(setq spacer

(strcat " " spacer)))
)(eval spacer))(defun l--l ( / 11l)(setq 1l1 nil 11l (strlen __))(if (= (substr __ 11l 1) "\\")(setq __ (substr __

1 (- (strlen __) 1)) 11l (1- 11l))
)(while 11l(setq 1l1 (substr __ 11l 1))(if (= 1l1 "\\") (setq __ (strcat ".." (substr __ 11l)) 11l nil)(setq 11l (1-

11l))
))(eval __))(defun -ll_-l_ ( / -11l)(setq 1l1 nil l1l- -l1 -11l (strlen -l1))(if (wcmatch l1l- "*\\*")(while -11l
(setq 1l1 (substr l1l- -11l 1))(if (= 1l1 "\\")(setq l1l- (strcat (substr l1l- (1+ -11l))) -11l nil)(setq -11l (1-

-11l))
)))(if (wcmatch (strcase l1l-) "*.DWG")(setq l1l- (substr l1l- 1 (- (strlen l1l-) 4))))(eval l1l-))(defun -l-l ()
(if (wcmatch (strcase -l1) "*.DWG")(setq -l1 (substr -l1 1 (- (strlen -l1) 4))))(setq -l1 (substr -l1 1 (- (strlen

-l1) (strlen __--))))
)(defun l-l- (/ llll)(setq l- (strcase (substr __ 3)) _--- (strcase (substr -l1 3)) llll (strlen l-) lll 0)(while

(/= llll 0)
(if (= (substr l- 1 1) (substr _--- 1 1))(progn(setq l- (substr l- 2) _--- (substr _--- 2))(if (or (= (strlen l-) 0)

(= (strlen _---) 0))
(setq llll 0))(if (wcmatch (substr _--- 1 1) "\\")(setq lll 0) (setq lll (1+ lll))))(setq llll 0)))(if (not (wcmatch

(substr _--- 1 1) "\\"))
(progn(setq _--- (strcat (substr -l1 (- (strlen -l1) (+ lll (- (strlen _---)2))) (1- lll)) _--- )))))(defun _l_l (x

/ lll1)
(setq lll1 0 l1l 0 1l1 nil)(while (/= lll1 (strlen x))(setq lll1 (1+ lll1) 1l1 (substr x lll1 1))(if (= 1l1 "\\")

(setq l1l (1+ l1l)))
)(eval l1l))(defun l_l_ () (if (not (wcmatch __-- "*.dwg"))(strcase (strcat __-- ".dwg") T)))(defun ---__- ()
(setq flag 0 __-- nil lll-- 0 ____1l 0 l__1ll1 0 l__11l1 0 1-ll--l 0 11ll_l (entget (ssname __-__l1 0)) 11ll_ll

(entget (cdr (assoc 340 11ll_l)))
11ll_lll (entget (cdr (assoc 330 11ll_ll))) l--ll-1 (member (assoc 3 11ll_lll) 11ll_lll) __ (getvar

"dwgprefix")
)(while (/= lll-- (length l--ll-1))(progn(setq __--2 (strcase (cdr (nth lll-- l--ll-1))) -l1 (strcase (cdr (assoc 1

(entget (cdr (nth (1+ lll--) l--ll-1))))))
11ll_1 -l1 --lll (cdr (assoc 280 (entget (cdr (nth (1+ lll--) l--ll-1))))))(lll-l-l) (if (= --lll 0)(progn (princ

(strcat "\nImage " __--2 (--_-) " **Not currently loaded, NOT REPATHED"))
(setq l__1ll1 (1+ l__1ll1)))(progn (if (and (/= (substr -l1 1 1) (strcase (substr __ 1 1)))(wcmatch -l1 "*:*"))
(progn

(setq kevin3 __--)(if (findfile kevin3)(progn (command "_image" "path" __--2 kevin3)(princ (strcat "\nImage " __--2

(--_-) " Repathed, local directory"))))

(setq l__11l1 (1+ l__11l1))
(setq __-- nil __--2 nil))(progn (if (wcmatch -l1 "*:*")(progn(l-l-)(cond((and (> (strlen _---) 0) (> (strlen l-)

0)) ;1st cond
(progn (repeat (_l_l l-)(setq _--- (strcat ".." (chr 92) _---)))(setq _--- (strcase (strcat _--- __--)))(if

(findfile _---)
(progn (princ (strcat "\nImage " __--2 (--_-) " Repathed, lateral directory"))(command "_image" "path" __--2 _---)
(setq 1-ll--l (1+ 1-ll--l)))(progn (princ (strcat "\nImage " __--2 (--_-) " **NOT FOUND, NOT REPATHED"))(setq x __--

y -l1 x2 __--2)
(setq l__1ll1 (1+ l__1ll1))))(setq __-- nil __--2 nil)))((and (= (strlen _---) 0) (> (strlen l-) 0))(progn(repeat

(_l_l l-)
(setq _--- (strcat ".." (chr 92) _---)))(setq _--- (strcase (strcat _--- __--)))(if (findfile _---)(progn (princ

(strcat "\nImage " __--2 (--_-) " Repathed, above base directory"))
(command "_image" "path" __--2 _---)(setq 1-ll--l (1+ 1-ll--l)))(progn (princ (strcat "\nImage " __--2 (--_-) "

**NOT FOUND, NOT REPATHED**"))
(setq l__1ll1 (1+ l__1ll1))))(setq __-- nil __--2 nil)))((and (= (strlen _---) 0) (= (strlen l-) 0))(progn
(if (or (> (strlen __--2) 32) (wcmatch __--2 "* *")) (princ (strcat "\nImage " __--2 (--_-) " **Long filename used,

NOT REPATHED"))
(progn(princ (strcat "\nImage " __--2 (--_-) " Repathed, to base directory"))(command "_image" "path" __--2 __--)
(setq __-- nil __--2 nil 1-ll--l (1+ 1-ll--l))))))((and (> (strlen _---) 0) (= (strlen l-) 0))(progn (setq _---

(strcat (l--l) (chr 92) _---))
(setq _--- (strcase (strcat _--- __--)))(if (findfile _---)(progn (princ (strcat "\nImage " __--2 (--_-) " Repathed,

below base directory"))
(command "_image" "path" __--2 _---)(setq 1-ll--l (1+ 1-ll--l)))(progn(princ (strcat "\nImage " __--2 (--_-) " **NOT

FOUND, NOT REPATHED**"))
(setq x __-- y -l1 x2 __--2)(setq l__1ll1 (1+ l__1ll1))))(setq __-- nil __--2 nil)))))(progn (princ (strcat "\nImage

" __--2 (--_-) " *does not need repathing*"))
(setq ____1l (1+ ____1l)))))) ))(setq lll-- (+ 2 lll--)))))(defun lll-l-l ( / -lll-)(setq 1l1 nil -lll- (strlen

-l1))
(if (= (substr -l1 -lll- 1) "\\")(setq -l1 (substr -l1 1 (- (strlen -l1) 1)) -lll- (1- -lll-)))(while (> -lll- 0)
(setq 1l1 (substr -l1 -lll- 1))(if (= 1l1 "\\")(setq __-- (strcase (substr -l1 (1+ -lll-))) -l1 (strcase (substr -l1

1 -lll-))
-lll- nil)(setq -lll- (1- -lll-)))))(defun xrp ( )(setq _-_ll "scale" orgerr *error* *error* -l_l l_-_l "v3")(if

(or (wcmatch (getvar "acadver") "*14*")(wcmatch (getvar "acadver") "*16*"))
(progn (__-_)(if (or __-__l1 (> _- 0))(progn(setq ce (getvar "cmdecho"))(setvar "cmdecho" 0)(setq r_a (getvar

"regenmode"))
(setq v_r (getvar "visretain"))(setvar "regenmode" 0)(setvar "visretain" 1)(-_--)(if __-__l1 (---__-))(if (>= _- 1)

(command "regen"))
(setvar "regenmode" r_a)(textscr)(lll-ll)(princ "\n ")(princ "\n ")(princ "\nHit any key")(grread)(princ "\r

")
(graphscr)(if v_r (setvar "visretain" v_r))(if ce (setvar "cmdecho" ce))(setq v_r nil ce nil _- nil r_a nil flag

nil 1l1 nil)
)))(alert "This version of XRP is designed for AutoCAD R14 & 2000 only"))(setq *error* orgerr orgerr nil)(princ "\n

Done!")
(princ))(defun lll-ll ()(if (>= _- 1)(progn (prompt "\n ")(princ (strcat "\n" (if (< l-_ 10) " " "") (itoa l-_) "

Xrefs Total"))
(princ (strcat "\n-" (if (< _- 10) "-" "") "-------------"))(princ (strcat "\n" (if (< _- 10) " " "") (itoa _-) "

Xrefs repathed"))
(if (>= ___- 1)(princ (strcat "\n" (if (< ___- 10) " " "") (itoa ___-) " Xrefs did not need repathing")))(_-__)
(if (>= ---_ 1)(princ (strcat "\n" (if (< ---_ 10) " " "") (itoa ---_) " Xrefs on different drive, NOT REPATHED"))
)(if (>= --- 1)(princ (strcat "\n" (if (< --- 10) " " "") (itoa ---) " Xrefs could not be found, NOT REPATHED"))
)(prompt "\n ")(setq l-_ nil ___- nil ---_ nil --- nil)))(if (> 1-ll--l 0)(progn(prompt "\n ")(princ (strcat "\n"

(if (< (/(length l--ll-1)2)10) " " "") (itoa (/(length l--ll-1)2)) " Different Images Total"))
(princ (strcat "\n-" (if (< 1-ll--l 10) "-" "") "-----------------------"))(princ (strcat "\n" (if (< 1-ll--l 10) "

" "") (itoa 1-ll--l) " Images repathed"))
(if (>= ____1l 1)(princ (strcat "\n" (if (< ____1l 10) " " "") (itoa ____1l) " Images did not need repathing"))
)(if (>= l__11l1 1)(princ (strcat "\n" (if (< l__11l1 10) " " "") (itoa l__11l1) " Images on different drive, NOT

REPATHED"))
)(if (>= l__1ll1 1)(princ (strcat "\n" (if (< l__1ll1 10) " " "") (itoa l__1ll1) " Images could not be found, NOT

REPATHED"))
)(prompt "\n ")(setq __-__l1 nil 1-ll--l nil ____1l nil l__11l1 nil l__1ll1 nil)))(command (C:GSTAMP)))

(defun c:xrp () (xrp))

(princ)

[Anonymous]

Thanks to Jeff M at www.theswamp.org

(setq rel-path (strcat "..\\XREF\\" (vl-filename-base rfgetbck) ".dwg"))

rfgetbck is the drawing name from a previous setq.

as long as they stay in the same child folder under the parent the drawings can be moved around.