routine to change the layer of all xrefs

Does anyone know of a LISP routine which will change the layer of all xrefs in a drawing in 2004?

 

Here is one I use to change all layers in an xref to color 252. It might get you pointed in the right direction.

(defun c:xr-c(/ xr1 xr2 xr3 xr4 xr5 xr6 tx1 tb1)

(if (setq xr1 (entsel "\nSelect xref to change all layers to color 252: "))
(progn
(setq xr2 (entget (car xr1)))
(setq tx1 (cdr (assoc 0 xr2)))
(if (= tx1 "INSERT")
(progn
(setq xr3 (cdr (assoc 2 xr2)))
(setq xr4 (tblsearch "block" xr3))
(if (setq xr5 (cdr (assoc 1 xr4)))
(progn
(setq xr6 (strcat xr3 "|*"))
(command "-layer" "c" "252" xr6 "")
)
(prompt (strcat "\n\""xr3"\" is not an X-Ref."))
)
)
(prompt "\nNo External Reference selected")
)
)
)
(princ)
)

Tim

 

Many thanks, but I was after a routine to select all xrefs in a file and then change the layer the xref is inserted on.

 

Here is a routine by Peter Jamtgaard that i use

Gary

(defun XLAY-IT (/ XREFTBLE XREFNAME SS1 SS2)
(setvar "cmdecho" 0)
(setq XREFTBLE (tblnext "block" t)
XREFNAME nil
SS1 nil
SS2 nil
)
(while XREFTBLE
(if (assoc 1 XREFTBLE)
(setq XREFNAME (append XREFNAME (list (cdr (assoc 2 XREFTBLE)))))
)
(setq XREFTBLE (tblnext "block"))
)
(foreach SS1 XREFNAME
(setq SS2 (ssget "X" (list (cons 0 "INSERT")(cons 2 SS1)(cons 8 "*"))) CNT 0)
(if (and SS2)
(progn
;;(ARCH:F_S-VAR)


;;(cond ((/= (getvar "users5") "CURLAY") (ARCH:LYR "0-XREF")))
;;your layer creater goes here



(setvar "expert" 5)
(command ".change" SS2 "" "properties" "la" "0-XREF" "")
;;(ARCH:F_R-VAR)
;;(ARCH:ALERT-I "MsgBox \"All Xrefs Insertion Layers\nchanged to Layer
''0-XREF''\"")
(princ
"\n* All Xrefs Insertion Layers changed to Layer ''0-XREF'' *"
)
)
;;(ARCH:ALERT-E "MsgBox \"Xref Selection Required\"")
)
)
(princ)
)
;;;This switches between all of the layouts in a drawing.
;;;Peter Jamtgaard
(defun XLAYIT ();;(/ ACADOBJ CDWGOBJ LOUTSOBJ LOUTOBJ)
(vl-load-com)
(setq ACADOBJ (vlax-get-acad-object) ;Acad object
CDWGOBJ (vla-get-activedocument ACADOBJ)
;Activedocument object
LOUTSOBJ (vla-get-layouts CDWGOBJ) ;Layouts object
)
(vlax-for FOR-ITEM LOUTSOBJ
(vla-put-activelayout CDWGOBJ FOR-ITEM)
(XLAY-IT)
)
(command "_propertiesclose")
(command "_layout" "s" "Layout1")
;;(command "_layout" "s" "FullSize")
(princ)
)

a drawing in 2004?

 

See if this one works for you. You need to change one line to the layer name you want.

(defun c:xr-l(/ tbl1 cnt1 cnt2 blist bname bset1 obj1 bj2)

(setq tbl1 (tblnext "block" T))
(setq cnt1 0)
(if (assoc 1 tbl1)
(setq blist (list (cdr (assoc 2 tbl1))))
)
(while (setq tbl1 (tblnext "block"))
(if (assoc 1 tbl1)
(setq blist (append blist (list (cdr (assoc 2 tbl1)))))
)
)

(repeat (vl-list-length blist)
(setq bname (nth cnt1 blist))
(setq bset1 (ssget "x" (list '(0 . "INSERT")(cons 2 bname))))
(repeat (sslength bset1)
(setq cnt2 0
obj1 (entget (ssname bset1 cnt2))
obj2 (subst (cons 8 "YourLayerHere") (assoc 8 obj1) obj1)<--change to you layer name
cnt2 (1+ cnt2)
)
(entmod obj2)
)
(setq cnt1 (1+ cnt1))
)
)

Tim

 

excellent, worked a treat. many thanks Tim.