Decided to try it in lisp and here's what i got so far. Still needs "clean up".
If in the model layout, it will close the active drawing and open the selected reference file with the same orientation/screen coords.
If in another layout, it will add the choice of switching to the model layout with the same orientation/screen coords.
Must be in model space (whether it's the model layout tab or an active viewport.)
Currently writes dcl and scr files to c:\temp. Suggestions are welcome.
Type XC to run.
[code;; NOTES:
;; The intent is similar to that of refedit
;; "xc" or "exchange" allows user to pick an xref to open and display the view/orientation of the current drawing.
;; If executed in a layout tab, option to exchange with Model Space is available
;; "sv" or "saveview" will capture view/orientation of current drawing
;; "gv" or "getview" will match view/orientation saved by "saveview" or "exchange" (only functions in modelspace)
;; Xref path found by using several functions by Joe Burke
;; Coordinates acquired by using VPCords by MP
(defun c:saveview()
(if (/= (getvar 'ctab) "Model")(vla-put-mspace (vla-get-ActiveDocument (vlax-get-Acad-Object)) :vlax-true))
(vl-cmdf "ucs" "v")
(setq *VLISP-NEW-FULL-INIT* (vpcords))
(if xlist
(setq *VLISP-NEW-FULL-INIT* (append *VLISP-NEW-FULL-INIT* xlist))
(setq *VLISP-NEW-FULL-INIT* (append *VLISP-NEW-FULL-INIT* (list (getvar 'ucsxdir))))
);
);defun
(defun c:sv()(c:saveview))
(defun c:getview()
(vl-cmdf "ucs" "w")
(vl-cmdf "ucs" "0,0")
(vl-cmdf (nth 2 *VLISP-NEW-FULL-INIT*) "")
(vl-cmdf "plan" "c")
(vl-cmdf "zoom" "window")
(vl-cmdf (nth 0 *VLISP-NEW-FULL-INIT*))
(vl-cmdf (nth 1 *VLISP-NEW-FULL-INIT*))
(vl-cmdf "ucs" "w")
);defun
(defun c:gv()(c:getview))
(defun VPCords (/ viewctr vphps vphms vpscale psvpctr difference psviewctr halfHeight aspectRatio offset)
(if (= (getvar 'ctab) "Model")
(progn
( (lambda (offset)
( (lambda (viewctr)
(list
(mapcar '- viewctr offset)
(mapcar '+ viewctr offset)
)
)
(getvar "viewctr") ;VPCords by MP
)
)
( (lambda (halfHeight aspectRatio)
(list
(* halfHeight aspectRatio)
halfHeight
)
)
(* 0.5 (getvar "viewsize"))
(apply '/ (getvar "screensize"))
)
)
);progn
(progn ;Acquired through VPCords-this version used to get model space coords while in a viewport
(setq viewctr (getvar "viewctr");Viewport Center in drawing units
vphps (cdr (assoc 41 (entget (acet-currentviewport-ename) '("ACAD"))))
vphms (getvar "viewsize")
vpscale (/ vphms vphps)
psvpctr (cdr (assoc 10 (entget (acet-currentviewport-ename) '("ACAD"))))
difference (mapcar (function (lambda (x y)(- y (* vpscale x)))) psvpctr viewctr)
xlist (list (getvar 'ucsxdir))
);setq
(vla-put-mspace (vla-get-ActiveDocument (vlax-get-Acad-Object)) :vlax-false)
(vl-cmdf "ucs" "w")
(setq psviewctr (mapcar (function (lambda (x y) (+ y (* vpscale x)))) (getvar "viewctr") difference)
halfHeight (* (* 0.5 (getvar "viewsize")) vpscale)
aspectRatio (apply '/ (getvar "screensize"))
offset (list (* halfHeight aspectRatio) halfheight)
)
(list (mapcar '- psviewctr offset)
(mapcar '+ psviewctr offset)
)
)
)
)
(defun c:switch (/ )
(if (and (= (getvar 'sdi) 1)(not Model))
(vl-cmdf
"_.vbastmt"
(strcat "AcadApplication.Documents.Open \"" xrefpath "\"")
);vl
)
);defun
(defun Is_ReadOnly (path / dwlfile x )
(setq dwlfile (vl-string-subst ".dwl" ".dwg" path))
(if (setq x (open dwlfile "r"))(progn (alert (strcat "The selected Xref is occupied by " (read-line x) ". Try again later."))(close x)(exit)))
);
(defun c:xc ()(c:exchange))
(defun c:exchange (/ blocks datalst cnt nestcnt doc xpathlst openscrfile file dwgpre dwglist *error* xrefpathlist
userclick xreflist BlkCol xrefinfo xrefselection xrefname xlist Model what)
(vl-load-com)
(defun *error* ( msg )
(cond
((not msg))
((wcmatch (strcase msg) "*QUIT*,*CANCEL*"))
(T (princ (strcat "\nError: " msg)))
)
(setvar "cmdecho" 1)
(princ)
);defun *error*
(if (and (/= (getvar 'ctab) "Model")(= (vla-get-mspace (vla-get-ActiveDocument (vlax-get-Acad-Object))) :vlax-false))(progn (alert "\nViewport must be active! Exiting XC.lsp... ")(exit)))
;; Argument: path string
;; Returns the path portion as a list of strings in reverse order.
;; (setq s "..\\..\\Common ABC\\XRefs ABC\\Plan Unit 3BR KLSC.dwg")
;; ("\\XRefs ABC" "\\Common ABC" "\\.." "\\..")
;; The file name is not included.
(defun PathList (str / idx pat pos lst)
(setq idx 0 pat "\\")
(while (setq pos (vl-string-search pat str idx))
(setq lst (cons (strcat pat (substr str (1+ idx) (- pos idx))) lst)
idx (1+ pos)
)
)
lst
) ;end
;; Returns a list of lists: (fullname fn blockname expath)
(defun XrefsData ( / blkname expath fullname fn xlst NestedXref)
;; Argument: block definition vla-object.
;; Returns a count number if the xref is nested, otherwise nil.
;; Based on code by Stephan Koster in a program named XrefTree.
;; Function renamed from nested_p.
;; The nestcnt variable is local to the primary routine.
;; There is a known flaw in the function which Jason pointed out.
;; If an xref is both nested and referenced as a parent, the
;; function does not flag it as nested. The fallout from that situation,
;; if it occurs, is handled near the end of the primary routine.
(defun NestedXref (blkdef / elst)
(setq elst (entget (vlax-vla-object->ename blkdef)))
(if
(or
(not (vl-position '(102 . "{BLKREFS") elst))
(and
(vl-position '(102 . "{BLKREFS") elst)
(not (cdr (assoc 331 elst)))
)
)
(setq nestcnt (1+ nestcnt))
;; Else return nil to the parent function.
)
) ;end
(vlax-for x blocks
(if
(and
(= -1 (vlax-get x 'IsXref))
(setq blkname (vlax-get x 'Name))
;; Filter out nested xrefs.
(not (NestedXref x))
(setq expath (cdr (assoc 1 (tblsearch "block" blkname))))
(setq fn (strcat (vl-filename-base expath) ".dwg"))
)
(progn
(cond
;; Xref found at full or relative path.
((setq fullname (findfile expath)))
;; Xref found in the same folder as the active file
;; and it the xref has not been renamed.
((setq fullname (findfile fn)))
;; Xref not found so far. Substitute the path for full name.
(T (setq fullname expath))
)
(setq xlst (cons (list fullname fn blkname expath) xlst))
)
)
)
xlst
) ;end
(defun XrefSearch (strlst path dot / xpath)
(if (and strlst path dot)
(progn
(setq path (strcat "\\" path))
(while
(and
strlst
(not (findfile (setq xpath (strcat dot
(substr (setq path (strcat (car strlst) path)) 2))))
)
)
(setq strlst (cdr strlst))
(setq dot (strcat dot dot))
)
(if (and xpath (findfile xpath))
xpath
)
)
)
) ;end
;;;; END SUB-FUNCTIONS ;;;;
;;;; START PRIMARY FUNCTION ;;;
(setq doc (vla-get-ActiveDocument (vlax-get-acad-object)))
(setvar "cmdecho" 0)
(setq blocks (vla-get-blocks doc)
cnt 0
nestcnt 0
datalst (XrefsData)
)
(foreach x datalst
(setq XrefList (append XrefList (list (caddr x))))
(setq xpathlst (append xpathlst (list (car x))))
)
(if XrefList (setq XrefList (acad_strlsort xreflist)))
(if (/= (getvar 'ctab) "Model")
(progn (initget "Reference Mspace")(setq what (getkword "\nExchange with [ Reference / Mspace] ?:<R> ")));progn
);if
(if (or (= what "Reference")(= what nil))
(progn
(if (/= (getvar 'ctab) "Model")(vla-put-mspace doc :vlax-true))
(setq xrefinfo (entget (car (entsel "\nSelect Xref to exchange with..."))))
(setq xrefselection (cdr (assoc 2 xrefinfo)))
(if (null xrefselection)(progn (alert "Selected object is not an xref.Try again.")(exit)))
(if Xpathlst (setq Xpathlst (acad_strlsort xpathlst)))
(foreach x xpathlst
(if (/= (vl-string-search xrefselection x) nil)(setq xrefpathlist (append xrefpathlist (list x))))
);
(setq xrefpath (nth 0 xrefpathlist))
(Is_Readonly xrefpath)
)
);if
(vl-cmdf "ucs" "v")
(setq *VLISP-NEW-FULL-INIT* (vpcords))
(if xlist
(setq *VLISP-NEW-FULL-INIT* (append *VLISP-NEW-FULL-INIT* xlist))
(setq *VLISP-NEW-FULL-INIT* (append *VLISP-NEW-FULL-INIT* (list (getvar 'ucsxdir))))
);
(if (= what "Mspace")(progn (setvar 'ctab "Model")(setq Model 1)(setq xrefpath 1)))
(progn (setq openscrfile (open (setq file (strcat "c:\\temp\\temp.scr")) "w")) ;derived from post by Ronjonp
(progn (foreach f (list xrefpath)
(if (and (= (getvar 'sdi) 0)(not Model))(write-line (strcat "_.open \"" f "\"") openscrfile))
(write-line "switch" openscrfile)
(if (and (= (getvar 'sdi) 1)(not Model))(write-line "Y" openscrfile))
(write-line "ucs w" openscrfile) ;
(write-line "ucs 0,0 (nth 2 *VLISP-NEW-FULL-INIT*) " openscrfile) ;
(write-line "plan c" openscrfile) ;
(write-line "zoom window" openscrfile) ;
(write-line "(nth 0 *VLISP-NEW-FULL-INIT*) (nth 1 *VLISP-NEW-FULL-INIT*)" openscrfile);
(write-line "ucs w" openscrfile)
)
(close openscrfile)
(command ".script" file)
)
(vl-file-delete file)
)
);defun
replaced code
