@bsanada
I found this topic interested... I've changed @Moshe-A code slightly - added selecting for Xrefs and exporting master DWG along with Xrefs in that empty choosen folder for which you navigate by using Lee Mac browseforfolder sub...
Please, can you test it now with this code posted here in code tags...
; Save xref back to disk to 0,0,0
(defun c:xrefout ( / *error* LM:blockname ssxrf LM:browseforfolder is_acetutil_modula_exist objects_counter get_last_ent ; local functions
adoc ss ii blocks ucsname folder ctr pbar_ctr AcDbEntity xname rr rx bt ex cm ; local variables
AcDbBlkTblRec xrefname newxrefname s ename lst masterdwg ) ; local variables
(or (not (vl-catch-all-error-p (vl-catch-all-apply (function vlax-get-acad-object) nil))) (vl-load-com))
(defun *error* ( msg )
(if (and msg (not (wcmatch (strcase msg t) "*break*,*cancel*,*exit*")))
(princ (strcat "\nError: " msg))
)
(if (= *isAcetUtil* :vlax-true)
(acet-ui-progress-done); close progress meter
)
(if ucsname
(progn
(if command-s
(command-s "_.ucs" "_restore" ucsname)
(vl-cmdf "_.ucs" "_restore" ucsname)
)
(if command-s
(command-s "_.ucs" "_delete" ucsname)
(vl-cmdf "_.ucs" "_delete" ucsname)
)
)
)
(if bt
(setvar (quote bindtype) bt)
)
(if ex
(setvar (quote expert) ex)
)
(if cm
(setvar (quote cmdecho) cm)
)
(if (and blocks (= (type blocks) (quote vla-object)))
(vlax-release-object blocks)
)
(if (and adoc (= (type adoc) (quote vla-object)))
(progn
(vla-endundomark adoc)
(vlax-release-object adoc)
)
)
(princ "\nDone.")
(princ)
); *error*
;; Block Name - Lee Mac
;; Returns the true (effective) name of a supplied block reference
(defun LM:blockname ( obj )
(if (vlax-property-available-p obj (quote effectivename))
(defun LM:blockname ( obj ) (vla-get-effectivename obj))
(defun LM:blockname ( obj ) (vla-get-name obj))
)
(LM:blockname obj)
)
; https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/selecting-xref-in-ssget/m-p/11865848#M446035
(defun ssxrf ( / blocks blknam blktbl ss sx )
(setq blocks (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object))))
(if (setq ss (ssget (list (cons 0 "INSERT"))))
(progn
(setq sx (ssadd)) ; initialize xref selection set
(foreach itm (vl-remove-if (function listp) (mapcar (function cadr) (ssnamex ss))) ; create list of all entities from selection set & cycle through
(setq blknam (LM:blockname (vlax-ename->vla-object itm))) ; get block name
(setq blktbl (vla-item blocks blknam)) ; get block table
(if (= (vla-get-isxref blktbl) :vlax-true) ; if xref
(ssadd itm sx) ; add to xref selection set
) ; if
) ; foreach
(if (zerop (sslength sx)) (setq sx nil)) ; nullify when there are no selections
) ; progn
) ; if inserts
(vlax-release-object blocks)
sx ; return xref selection set
) ; defun
;; Browse for Folder - Lee Mac
;; Displays a dialog prompting the user to select a folder.
;; msg - [str] message to display at top of dialog
;; dir - [str] [optional] root directory (or nil)
;; bit - [int] bit-coded flag specifying dialog display settings
;; Returns: [str] Selected folder filepath, else nil.
(defun LM:browseforfolder ( msg dir bit / err fld pth shl slf )
(setq err
(vl-catch-all-apply
(function
(lambda ( / app hwd )
(if
(setq app (vlax-get-acad-object)
shl (vla-getinterfaceobject app "shell.application")
hwd (vl-catch-all-apply 'vla-get-hwnd (list app))
fld (vlax-invoke-method shl 'browseforfolder (if (vl-catch-all-error-p hwd) 0 hwd) msg bit dir)
)
(setq slf (vlax-get-property fld 'self)
pth (vlax-get-property slf 'path)
pth (vl-string-right-trim "\\" (vl-string-translate "/" "\\" pth))
)
)
)
)
)
)
(if slf (vlax-release-object slf))
(if fld (vlax-release-object fld))
(if shl (vlax-release-object shl))
(if (vl-catch-all-error-p err)
(prompt (vl-catch-all-error-message err))
pth
)
)
; check if aceutil.arx is loaded?
(defun is_acetutil_modula_exist ()
(if (not (vl-position "acetutil.arx" (arx)))
(progn
(setq *isAcetUtil* :vlax-false)
(repeat 3
(vlr-beep-reaction)
)
(prompt "\nacetutil.arx modula is not loaded.")
)
(setq *isAcetUtil* :vlax-true)
)
); is_acetutil_modula_exist
; return cumulate number of objects in xrefs
(defun objects_counter ( / counter AcDbBlkTblRec )
(setq counter -1)
(vlax-for AcDbBlkTblRec blocks
(if
(and
(= (vla-get-isxref AcDbBlkTblRec) :vlax-true)
; make sure it is attached
(ssget "_X" (list (cons 0 "INSERT") (cons 2 (vla-get-name AcDbBlkTblRec))))
)
;(setq counter (+ counter (vla-get-count AcDbBlkTblRec)))
(setq counter (1+ counter))
)
); vlax-for
counter
); objects_counter
; make sure last entity is founded
; even if drawing is empty
(defun get_last_entity ( / el ) ; rr - lexical global
(setq el (entlast))
(if (and el (entnext el))
(while (setq el (entnext el))
(setq rr el)
)
(if el
(setq rr el)
(setq rr (entmakex (list (cons 0 "POINT") (list 10 0.0 0.0 0.0))))
)
)
rr
); get_last_entity
; Here start c:xrefout
(setq adoc (vla-get-activedocument (vlax-get-acad-object)))
(vla-startundomark adoc)
(setq blocks (vla-get-blocks adoc))
(setq cm (getvar (quote cmdecho)))
(setvar (quote cmdecho) 0)
(setq ex (getvar (quote expert)))
(setvar (quote expert) 5)
(setq bt (getvar (quote bindtype)))
(setvar (quote bindtype) 1)
(command "_.ucs" "_save" "$xrefout")
(setq ucsname (getvar (quote ucsname)))
(if (= 0 (getvar (quote worlducs)))
(command "_.ucs" "_world")
)
(if (setq folder (LM:browseforfolder "Select a folder" nil 0))
(progn
(is_acetutil_modula_exist)
(setq ctr (objects_counter))
; init progress meter
(if (= *isAcetUtil* :vlax-true)
(progn
; progress bar init requires bigger value
(acet-ui-progress-init "Processing" ctr)
(setq pbar_ctr -1) ; progress bar counter
); progn
); if
(prompt "\nSelect Xref entities to which you want to apply changing base point to WCS origin 0,0,0 point...")
(setq ss (ssxrf))
(repeat (setq ii (sslength ss))
(setq AcDbEntity (vlax-ename->vla-object (ssname ss (setq ii (1- ii)))))
(if
(and
(= (vla-get-objectname AcDbEntity) "AcDbBlockReference")
(not (wcmatch (setq xname (vla-get-name AcDbEntity)) "`*U*")) ; not anonymous block
(not (vl-position xname lst)) ; not processed yet
(setq AcDbBlkTblRec (vla-item blocks xname)) ; get BTR
(= (vla-get-isxref AcDbBlkTblRec) :vlax-true) ; is it xref?
(setq xrefname (vla-get-path AcDbBlkTblRec))
(setq newxrefname (strcat folder "\\" (vl-filename-base xrefname) ".dwg"))
)
(progn
(vlax-release-object AcDbBlkTblRec)
(setq AcDbBlkTblRec nil)
; update progress meter
(if (= *isAcetUtil* :vlax-true)
(progn
(setq pbar_ctr (1+ pbar_ctr)) ; inc progress bar
(acet-ui-progress-safe pbar_ctr)
); progn
); if
(command "_.undo" "_begin")
(setq s (ssadd) ename (get_last_entity))
; make sure the xref will be saved at X=1,Y=1,Z=1,R=0
;|
(vla-put-XScaleFactor AcDbEntity 1.0)
(vla-put-YScaleFactor AcDbEntity 1.0)
(vla-put-ZScaleFactor AcDbEntity 1.0)
(vla-put-rotation AcDbEntity 0.0)
|;
(command "_.xref" "_bind" xname)
(command "_.explode" (vlax-vla-object->ename AcDbEntity))
; make sure all objects selected
(command "_.layer" "_thaw" "*" "_on" "*" "_unlock" "*" "")
; collecting all objects
(while (setq ename (entnext ename))
(ssadd ename s)
); while
(if (and rr (= (cdr (assoc 0 (setq rx (entget rr)))) "POINT") (= (list 10 0.0 0.0 0.0) (assoc 10 rx)) (not (vlax-erased-p rr)))
(entdel rr)
); get rid of last entity that is WCS 0,0,0 point
; write out wblock\xref
(command "_.wblock" (strcat folder "\\" xname) "" "0,0,0" "_si" s)
(command "_.undo" "_end")
(command "_.u") ; restore actions
(setq lst (cons xname lst))
); then progn
(if
(and
AcDbBlkTblRec
(= (type AcDbBlkTblRec) (quote vla-object))
)
(progn
(vlax-release-object AcDbBlkTblRec)
(setq AcDbBlkTblRec nil)
); progn
); else if
); if
); vlax-for
(vlax-for AcDbEntity (vla-get-modelspace adoc)
(if
(and
(= (vla-get-objectname AcDbEntity) "AcDbBlockReference")
(not (wcmatch (setq xname (vla-get-name AcDbEntity)) "`*U*")) ; not anonymous block
(vl-position xname lst) ; already processed
(setq AcDbBlkTblRec (vla-item blocks xname)) ; get BTR
(= (vla-get-isxref AcDbBlkTblRec) :vlax-true) ; is it xref?
)
(progn
(vla-put-insertionpoint AcDbEntity (vlax-3d-point (list 0.0 0.0 0.0)))
(vla-put-rotation AcDbEntity 0.0)
(vla-put-XScaleFactor AcDbEntity 1.0)
(vla-put-YScaleFactor AcDbEntity 1.0)
(vla-put-ZScaleFactor AcDbEntity 1.0)
)
)
(vlax-release-object AcDbEntity)
); vlax-for
(setq masterdwg (strcat folder "\\" (getvar (quote dwgname))))
(vla-saveas adoc masterdwg)
(foreach xref lst
(command "_.-xref" "_re" xref)
)
(if (= *isAcetUtil* :vlax-true)
(acet-ui-progress-done); close progress meter
)
); progn
); if
(*error* nil)
); c:xrefout
HTH.
M.R.
Marko Ribar, d.i.a. (graduated engineer of architecture)
