Topic: Update Code to accept nested Xref

[HasanCAD]

HI all
I want to Change color and LWeight for layers of Xrefs which in Model only. It is working good. but one or more of xrefs has nested Xref.
So, How to do the same for nested Xrefs.

Code - Auto/Visual Lisp: [Select]

1. (if (Setq ss (ssget "_x" (list (cons 0 "INSERT") (cons 410 (if (eq 1 (getvar 'CVPORT)) (getvar 'CTAB) "Model")))))
2.     (repeat (setq i (sslength ss))
3.       (setq s (ssname ss (setq i (1- i))))
4.       (setq ent (entget s))
5.       (setq xrn (cdr (assoc 2 ent)))
6.       (setq xrn (strcat xrn "|*"))
7.       (progn
8.         (vlax-for i (vla-get-Layers Doc)
9.           (if (wcmatch (vla-get-Name i) xrn)
10.             (progn
11.               (vla-put-Color i Clr)
12.               (vla-put-lineweight i acLnWt009)
13.               )))
14.         (vla-Regen Doc acActiveViewport)
15.         )))

[HasanCAD]

This is what I ended to
comments will be valuable

Code - Auto/Visual Lisp: [Select]

1. (defun c:XrefLayerColor ( / adoc ACTLAY CLR DOC ENAMES I LAYOUTS PLOT SS XR XREN XRN XRNB XRS XRSS)
2.   (vl-load-com)
3.   (defun *error* ( msg )
4.   (vla-endundomark doc)
5.   (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
6.     (princ (strcat "\nError: " msg))
7.     )
8.   (princ)
9.   )
10. (setq clr 252)
11.   (setq doc (vla-get-activedocument (vlax-get-acad-object)))
12.   (vla-startundomark doc)
13.  
14.   (if (Setq ss (ssget "_x" (list (cons 0 "INSERT") (cons 410 (if (eq 1 (getvar 'CVPORT)) (getvar 'CTAB) "Model")))))
15.     (repeat (setq i (sslength ss))
16.       (setq s (ssname ss (setq i (1- i))))
17.       (setq ent (entget s))
18.       (setq xrnn (cdr (assoc 2 ent)))
19.       (setq xrn (strcat xrnn "|*"))
20.       (vlax-for i (vla-get-Layers Doc)
21.         (if (wcmatch (vla-get-Name i) xrn)
22.           (progn
23.             (vla-put-Color i Clr)
24.             (vla-put-lineweight i acLnWt009)
25.             )))
26.       (if (setq ent (tblobjname "block" xrnn))
27.         (while (setq ent (entnext ent))
28.           (if (and             
29.                 (eq "INSERT" (cdr (assoc 0 (entget ent))))
30.                 (setq entnm  (cdr (assoc 2 (entget ent))))
31.                 (= (vla-get-IsXRef (vla-item (vla-get-blocks doc) entnm) ) :vlax-true)
32.                 )
33.             (progn           
34.               (setq xrn (strcat entnm "|*"))
35.               (vlax-for i (vla-get-Layers Doc)
36.                 (if (wcmatch (vla-get-Name i) xrn)
37.                   (progn
38.                     (vla-put-Color i Clr)
39.                     (vla-put-lineweight i acLnWt009)
40.                     )))))))))
41.   (vla-Regen doc acActiveViewport)
42.   (vla-endundomark doc)
43.   (princ)
44.   )
45.