[编程交流] 外部参照重定位和重命名LSP-输出

;................................................. ..............................
;
; << Replace old xref files with a set of new xref files >>
; 
; << Version 1.0 >>
; 
; NOTE: If new xrefs are in a different folder, you must call out
; XrefPathChange.lsp from the code below.
;
;................................................. ..............................
(defun c:xrefR (/ b bcol path )
(vl-load-com)
(setq bcol (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object))))
(foreach blk '(
;>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
;>>>>> Enter all xref names below in this format >>>>>>
;>>>>> ("OldXrefName" . "NewXrefName") >>>>>>
;>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
("X-TEST-2A" . "X-TEST-2B")
("X-TEST-3A" . "X-TEST-3B")
;>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
)
(if
(and 
(not (vl-catch-all-error-p (setq b (vl-catch-all-apply 'vla-item (list bcol (car blk))))))
(= (vla-get-isxref b) :vlax-true)
)
(progn (vla-put-name b (cdr blk))
(if (= (setq path (vl-filename-directory (vla-get-path b))) "")
(vla-put-path b (strcat (cdr blk) ".dwg"))
(vla-put-path b (strcat path "\" (cdr blk) ".dwg"))
)
(vla-reload b)
)
)
)
;>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
;>>> XrefPathChange.lsp call out here. >>>>
;>>> Enter all xref paths to be changed in this format. >>>>
;>>> (xrefpathchange "c:\\Oldfolder\\oldfolder" "c:\\newfolder\\newfolder") >>>>
;>>> Note: Remove code if new xref path is unchanged. >>>>
;>>> Add ; infront of each line to block code. >>>>
;>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
(xrefpathchange "S:\\DWG\\TEXT" "[b]R:\\DWGA\\[/b]")
(XReload)
;>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
(princ)
);end of c:xrefR
;................................................. ..........
;.... Xref Path Change sub routine by ronjonp ....
;................................................. ..........
(defun xrefpathchange (path1 path2 / newpath xrpath)
(vl-load-com)
(vlax-map-collection
(vla-get-blocks (vla-get-activedocument (vlax-get-acad-object)))
(function
(lambda (x)
(if (= (vla-get-isxref x) :vlax-true)
(progn (setq xrpath (strcase (vlax-get x 'path) t)
path1 (strcase path1 t)
path2 (strcase path2 t)
)
(if (and (vl-string-search path1 xrpath)
(setq newpath (vl-string-subst path2 path1 xrpath))
(findfile newpath)
)
(if (vl-catch-all-error-p (vl-catch-all-apply 'vla-put-path (list x newpath)))
(princ (strcat "\n**OLD path found but was not changed!\n" xrpath))
(princ (strcat "\n" newpath))
)
)
)
)
)
)
)
(princ)
); end of XrefPathChange
;................................................. ............
;.... Xref Reload sub routine .......
;................................................. ............
(defun XReload (/ cObj cName); Updated 2007-10-1: added error trap
(defun *error*(msg)
(setvar "modemacro" ".")
(setvar "cmdecho" 1)
(princ "\n...Reload xref terminated!!!  ")
(princ)
); end of *error*
(setvar "modemacro" "Reloading loaded xrefs......please wait......")
(setvar "cmdecho" 0)
(setq cObj(tblnext "BLOCK" T))
(while cObj
(setq cName(cdr(assoc 2 cObj)))
(if
(and
(=(logand(cdr(assoc 70 cObj))32)32)
(=(logand(cdr(assoc 70 cObj))4)4)
); end and
(progn
(vl-cmdf "_.xref" "_unload" cName)
(vl-cmdf "_.xref" "_reload" cName)
); end progn
); wnd if
(setq cObj(tblnext "BLOCK"))
); end while
(setvar "modemacro" ".")
(setvar "cmdecho" 1)
(prompt "\n--- Xref change finished! ---")
(princ)
); end of XReload