LISP - Select XREFs by Wildcard and put on specific/relevent layer

[sambaldan]

Hi,

I've looked everywhere and can't find anything that seems to work.

Currently, my company has various different building XREFS loaded for each project to keep things tidy. They are as follows:

XA-2D-*FLOOR*

XA-3D-*FLOOR*

XS-2D-*FLOOR*

XS-3D-*FLOOR*

These XREFS should be on layers as follows:

XA-2D-*Floor Level* -----> XREF - ARCH

XA-3D-*Floor Level* -----> XREF - ARCH

XS-2D-*Floor Level* -----> XREF - STRUCTURAL

XS-3D-*Floor Level* -----> XREF - STRUCTURAL

We all already operate a lisp that will lock our XREF layers which ultimately is what we want, However we need a quick way to get all xrefs on their correct layers prior to their layers being locked. I am looking to find a lisp that will select all XREFS in a DWG with a wildcard of 'XA' or 'XS' and put them on their corresponding layers. If anyone could help me out that would be great.

Thanks in advance

SB

[john.uhden]

Since you may have other conditions as well, I would first organize a list of dotted pairs such as

'(("XA-#D-*FLOOR*" . "XREF-ARCH")("XS-#D-*Floor*" . "XREF-STRUCTURAL") etc.)  as in don't forget the mechanicals and electricals.

I noticed your use of wildcards so I replaced "2" and "3" with "#".  Just don't go over 9 stories.

The following is off the top of my head (not tested).

(defun ConvertXlayers ( / pairs ss i e ent old new)
(setq pairs '(("XA-#D-*FLOOR*" . "XREF-ARCH")("XS-#D-*Floor*" . "XREF-STRUCTURAL")))
(and
  (setq ss (ssget "X" '((0 . "INSERT")(1 . "*")))
  (setq i 0)
  (repeat (sslength ss)
    (setq e (ssname ss i)
          ent (entget e)
          new nil
          old (cdr (assoc 8 ent))
          i (1+ i)
    )
    (foreach pair pairs
      (if (wcmatch (strcase old)(strcase (car pair)))
      (setq new (cdr pair))
    )
    (or
      (and
        new
        (vl-cmdf "_.layer" "_New" new "")
        (vl-cmdf "_.layer" "_Un" old "")
        (entmod (subst (cons 8 new)(assoc 8 ent) ent))
      )
      (prompt (strcat "\nLayer " old " not converted."))
    )
  )
)

Please let me know how/if it helps.

[john.uhden]

Oops.  I failed to indent and skipped a closing parenthesis.

Here we go again...

(defun ConvertXlayers ( / pairs ss i e ent old new)
  (setq pairs '(("XA-#D-*FLOOR*" . "XREF-ARCH")("XS-#D-*Floor*" . "XREF-STRUCTURAL")))
  (and
    (setq ss (ssget "X" '((0 . "INSERT")(1 . "*")))
    (setq i 0)
    (repeat (sslength ss)
      (setq e (ssname ss i)
            ent (entget e)
            new nil
            old (cdr (assoc 8 ent))
            i (1+ i)
      )
      (foreach pair pairs
        (if (wcmatch (strcase old)(strcase (car pair)))
        (setq new (cdr pair))
      )
      (or
        (and
          new
          (vl-cmdf "_.layer" "_New" new "")
          (vl-cmdf "_.layer" "_Un" old "")
          (entmod (subst (cons 8 new)(assoc 8 ent) ent))
        )
        (prompt (strcat "\nLayer " old " not converted."))
      )
    )
  )
)

[john.uhden]

I should have paid more attention.  It all has to do with just the first 2 characters of the layer name.

So, just simplify the pairs...

(setq pairs '(("XA-*" . "XREF-ARCH")("XS-*" . "XREF-STRUCTURAL")))

Also, to make it a command function, just change the function's name to prefix it with "C:" as in

(defun C:ConvertXlayers (  etc.
or even just
(defun C:CXL (  etc.
or
(defun C:CXL ()(ConvertXlayers))
-- Note that case is NOT sensitive. --

then your users can enter either "ConvertXlayers" or "CXL" at the command prompt.

BUT, then the function should contain error and undo control.  If you need help with that, I can provide.

[sambaldan]

John,

Currently, this is what i've got.

(defun C:LX2 ( / pairs ss i e ent old new)
  (setq pairs '(("XA-*" . "PIP - XREF - ARCH")("XS-*" . "PIP - XREF - STRUCTURAL")))
  (and
    (setq ss (ssget "X" '((0 . "INSERT")(1 . "*")))
    (setq i 0)
    (repeat (sslength ss)
      (setq e (ssname ss i)
            ent (entget e)
            new nil
            old (cdr (assoc 8 ent))
            i (1+ i)
      )
      (foreach pair pairs
        (if (wcmatch (strcase old)(strcase (car pair)))
        (setq new (cdr pair))
      )
      (or
        (and
          new
          (vl-cmdf "_.layer" "_New" new "")
          (vl-cmdf "_.layer" "_Un" old "")
          (entmod (subst (cons 8 new)(assoc 8 ent) ent))
        )
        (prompt (strcat "\nLayer " old " not converted."))
      )
    )
  )
)

Im getting the Autocad Error: 

Command: lx2
LX2 no function definition: CONVERTXLAYERS
Command:

And the XREFS are not changing layer.

Thanks again for all your help.

SB

[john.uhden]

It seems as though maybe you didn't load the code you just posted, but instead tried my example of (defun C:CXL ()(convertxlayers)) without having loaded ConvertXlayers. If you load your c:LX2 as you posted it should work just fine.

[sambaldan]

I've tried again this morning and from loading to trial, my command line is as follows:

Command: _appload XREFS to Correct Layers(LX2).lsp successfully loaded.
XREFS to Correct Layers(LX2).lsp was added to the Startup Suite.
Command: malformed list on input
Command:
Command:
Command: lx2
Unknown command "LX2". Press F1 for help.

Thanks again, and apologies for not having a clue!

[john.uhden]

We/I had parentheses messed up.

Try this:

(defun C:LX2 ( / pairs ss i e ent old new)
  (setq pairs '(("XA-*" . "PIP - XREF - ARCH")("XS-*" . "PIP - XREF - STRUCTURAL")))
  (and
    (setq ss (ssget "X" '((0 . "INSERT")(1 . "*"))))
    (setq i 0)
    (repeat (sslength ss)
      (setq e (ssname ss i)
            ent (entget e)
            new nil
            old (cdr (assoc 8 ent))
            i (1+ i)
      )
      (foreach pair pairs
        (if (wcmatch (strcase old)(strcase (car pair)))
          (setq new (cdr pair))
        )
      )
      (or
        (and
          new
          (vl-cmdf "_.layer" "_New" new "")
          (vl-cmdf "_.layer" "_Un" old "")
          (entmod (subst (cons 8 new)(assoc 8 ent) ent))
        )
        (prompt (strcat "\nLayer " old " not converted."))
      )
    )
  )
)

[john.uhden]

I received your private message (which didn't need to be private).  There are many others probably following this thread who can help if they can see the conversations.

I tested LX2 in my AutoCAD 2002 and the dxf code 1 for the path did not show up in the entity data even though it shows up in the vla-object's properties.

I don't get it.  But that is the reason why the function returns nil, i.e. because it won't find any xrefs at all because of the missing code 1.

We can compensate for that issue by testing all inserts for the Path object property.

I'll wait a day to see if someone else can explain the reason for the failure before I fix the code as I said in the previous paragraph.  I hope you can wait that long.

[Ranjit_Singh · Accepted solution]

Xref entity data does not have 1 dxf code. Search block table. Try the below code

(defun c:somefunc ( / entdata blname)
(mapcar '(lambda (x)
(setq blname (cdr (assoc 2 (setq entdata (entget x)))))
(cond 	((cdr (assoc 1 (tblsearch "BLOCK" blname)))
	(cond 	((wcmatch blname "XA-*,xa-*,Xa-*,xA-*") entdata (entmod (subst (cons 8 "XREF - ARCH") (assoc 8 entdata) entdata)))
		((wcmatch blname "XS-*,xs-*,Xs-*,xS-*") entdata (entmod (subst (cons 8 "XREF - STRUCTURAL") (assoc 8 entdata) entdata)))
		(T ())
	))
	(T ())
))
(mapcar 'cadr (ssnamex (ssget "_x" '((0 . "INSERT")))))
)
(princ)
)

[sambaldan]

Wouldn't work at first, but after i finished being stupid changed a few of the user specifics e.g. xref name wildcards & layer names, that worked perfectly.

Thanks to you both, really appreciate it.