LISP to change layer, copy, and prepare to paste on a different layer

[GOT19S]

Whats up guys? First off, appreciate everything that all of you do here. We have used various LISPs found on this site that has made our lives at work so much easier! That being said I was looking to see if someone may be able to help with what I think would be a simple LISP (simple for some of you at least).

 

Working on some building remodel drawings and have to relocate some items. The relocated items are blue + layer named "ETR"  and the new location for them is green + layer named "RNL". Id like to be able to type in the command (lets say relocate) and it would change whatever is selected to blue and the "ETR" layer, then have it ready to paste (similar to a CTRL+V command) into the new location layer "RNL".

 

Is this something that someone may be able to help with? If so it would be greatly appreciated!

[Steven P]

Filter should be able to do this, select items on a layer and colour.

 

As a learning exercise, look through the code, it is not working exactly as you want, some customisation required... which should be obvious. 

 

(defun c:relocate ( / MySS MyEnt ed acount)

  (setq MySS (ssget '((8 . "OldLayername")(62 . ColourCodeNumber))))  ;; Select items. Use ssget "_X" to select all. Change filters as needed

  (setq acount 0)                     ;; a counter
  (while (< acount (sslength MySS))   ;; a while loop
    (setq MyEnt (ssname MySS acount)) ;; nth position entity of selection set
    (setq ed (entget MyEnt))          ;; nth entity definition

    (setq ed (subst (cons 8 "NewLayername") (assoc 8 ed) ed ))    ;; modify entity definition. User to change NewLayerName to suit

    (entmod ed)                       ;; update the entitiy with the new definition
    (setq acount (+ acount 1))        ;; counter + 1
  ) ; end while                       ;; end while loop
  (princ)                             ;;exit silently
) ;end defun

 

[GOT19S]

Thanks Steven. I tried that and its giving me a bad ssget value error which is way over my head. 

 

Attached is a DWG if that helps with kind of what I was hoping for. I know i can use the copytolayer command to get where id like to be however running through that command and specifying the same layer hundreds of times a day is not as fun.

TEST 12-17-24.dwg

[BIGAL]

Just making it a bit more global. Or do you only have 1 layer to change if so ignore this suggestion.

 

Select existing object and then change properties. Can use new layer color as a bylayer. 

 

 

 

 

[Steven P]

15 hours ago, GOT19S said:

Thanks Steven. I tried that and its giving me a bad ssget value error which is way over my head. 

 

Attached is a DWG if that helps with kind of what I was hoping for. I know i can use the copytolayer command to get where id like to be however running through that command and specifying the same layer hundreds of times a day is not as fun.

TEST 12-17-24.dwg 279.93 kB · 0 downloads

 

It seams to work for me... but you'll need to change the LISP to suit your own requirements.

 

If you've changed the LISP to suit, post a copy of what you did below, probably something simple.

 

Big-Als pop up box is a good solution if you have to do this many times with different layer and colour combinations... we can work you through building that up as well.

 

 

[GOT19S]

Below in green and caps is what I changed. I'm extremely green when it comes to lisps like these. I like what Big Al posted but I do in fact only need this to change an existing object to the "1 Existing to Relo" layer and then let me paste a copy of the same item and have it paste to the "1 Relo New Location" layer. Currently we just do a copy, paste and match attributes. While that works fine I was just trying to help the lesser experienced designers and make it easier.

(defun c:relocate ( / MySS MyEnt ed acount)

  (setq MySS (ssget '((5 . "1 EXISTING TO RELO")(5 . ColourCodeNumber))))  ;; Select items. Use ssget "_X" to select all. Change filters as needed

  (setq acount 0)                     ;; a counter
  (while (< acount (sslength MySS))   ;; a while loop
    (setq MyEnt (ssname MySS acount)) ;; nth position entity of selection set
    (setq ed (entget MyEnt))          ;; nth entity definition

    (setq ed (subst (cons 3 "1 RELO NEW LOCATION") (assoc 3 ed) ed ))    ;; modify entity definition. User to change NewLayerName to suit

    (entmod ed)                       ;; update the entitiy with the new definition
    (setq acount (+ acount 1))        ;; counter + 1
  ) ; end while                       ;; end while loop
  (princ)                             ;;exit silently
) ;end defun

 

Edited December 19, 2024 by SLW210
Added Code Tags!

[Steven P]

Try again... changing only "OldLayerName", ColourCodeNumber and "NewLayerName" - leave in the " " to indicate what is in the middle is a text string, and ColourCodeNumber is a value, 1-255 representing the index colour  (5 ?, 256 I think is by-layer, 0 is by-block, I'd need to confirm that)

 

(8 . "OldLayerName") -> (8 . "1 EXISTING TO RELO") for example.

 

There are no checks that the new layer name exists in the above, if you want to go further with this - guided of course - we can add that check in

 

 

For info, the (8 . .... ) 8 refers to the part of entity description, the dxf code we are searching for and after the dot (dotted pair list) is the value we want, here '8' refers to the layer the entity is on 62 refers to it's colour, change these and it will be looking for other things, 5 being the unique entity handle (so your search was for the entity named "1 Existing To Relo" AND also entity named ColourCodeNumber (which is not a valid number or variable, no " " means it is a number of variable ) Entity can't have 2 names at once either). Just so you know why it didn't work.

[GOT19S]

Thank you for the help and explanation! Still get the same error for whatever reason..... bad ssget list value.

(defun c:relocate ( / MySS MyEnt ed acount)

  (setq MySS (ssget '((8 . "1 EXISTING TO RELO")(62 . 5))))  ;; Select items. Use ssget "_X" to select all. Change filters as needed

  (setq acount 0)                     ;; a counter
  (while (< acount (sslength MySS))   ;; a while loop
    (setq MyEnt (ssname MySS acount)) ;; nth position entity of selection set
    (setq ed (entget MyEnt))          ;; nth entity definition

    (setq ed (subst (cons 8 "1 RELO NEW LOCATION") (assoc 8 ed) ed ))    ;; modify entity definition. User to change NewLayerName to suit

    (entmod ed)                       ;; update the entitiy with the new definition
    (setq acount (+ acount 1))        ;; counter + 1
  ) ; end while                       ;; end while loop
  (princ)                             ;;exit silently
) ;end defun

 

Edited December 19, 2024 by SLW210
Added Code Tags!

[Steven P]

Try this one, 

I've added in 3 lines at the top to make updating for other layers and colours slightly easier... but will join up with a selection pop-up box in the future if needed. (that means that the 'ssget' line needs a small change)

Also added an 'if' statement, in the case that there are no entities coloured blue and on layer 'OldLayer' it will report 'nothing selected' - that might be where your error was, nothing on the layer in your example drawing. 

 

 

(defun c:relocate ( / MySS MyEnt ed acount)
  (setq OldLayer "1 EXISTING TO RELO" )
  (setq OldColour 5 )
  (setq NewLayer "1 RELO NEW LOCATION" )

  (if (setq MySS (ssget (list (cons 8  OldLayer)(cons 62 OldColour))))
    (progn
      (setq acount 0)                     ;; a counter
      (while (< acount (sslength MySS))   ;; a while loop
        (setq MyEnt (ssname MySS acount)) ;; nth position entity of selection set
        (setq ed (entget MyEnt))          ;; nth entity definition
        (setq ed (subst (cons 8 NewLayer) (assoc 8 ed) ed ))
        (entmod ed)                       ;; update the entitiy with the new definition
        (setq acount (+ acount 1))        ;; counter + 1
      ) ; end while                       ;; end while loop
    )   ; end progn
    (princ "Nothing Selected")            ;; Error if nothing seleted in selection set
  )     ; end if
  (princ)                             ;;exit silently
)

 

[BIGAL]

I would add a does new layer exist ? The oldlayer ssget will fail if the layer does not exist so that is handled.

 

(if (= (tblsearch "LAYER" newlayer) nil)
(command "-layer" "m" newlayer "C" 3 "" "")
)

 

 

 

 

[SLW210]

Please use Code Tags! (<> in the editor toolbar)

[GOT19S]

Ok sooooo I added the part that BIGAL suggested shown below and the ssget error is gone. It now says select objects but will not allow me to select anything. I tried a CTRL+A which worked for selecting in this instance however nothing happens after that. Who knew it would be such a tough one to get to work.

(defun c:relocate ( / MySS MyEnt ed acount)
  (setq OldLayer "1 EXISTING TO RELO" )
  (setq OldColour 5 )
  (setq NewLayer "1 RELO NEW LOCATION" )

(if (= (tblsearch "LAYER" newlayer) nil)
(command "-layer" "m" newlayer "C" 3 "" "")
)

  (if (setq MySS (ssget (list (cons 8  OldLayer)(cons 62 OldColour))))
    (progn
      (setq acount 0)                     ;; a counter
      (while (< acount (sslength MySS))   ;; a while loop
        (setq MyEnt (ssname MySS acount)) ;; nth position entity of selection set
        (setq ed (entget MyEnt))          ;; nth entity definition
        (setq ed (subst (cons 8 NewLayer) (assoc 8 ed) ed ))
        (entmod ed)                       ;; update the entitiy with the new definition
        (setq acount (+ acount 1))        ;; counter + 1
      ) ; end while                       ;; end while loop
    )   ; end progn
    (princ "Nothing Selected")            ;; Error if nothing seleted in selection set
  )     ; end if
  (princ)                             ;;exit silently
)

 

Edited December 20, 2024 by SLW210
Added Code Tags!!!

[Steven P]

Someone is going to get upset... when you are adding code press the <> button to open the code box and put the code in there - gives the blue box - it makes it far easier to read!

 

Nice, modified the code and it didn't break...

 

No errors means it is working ... as written...

 

So after you do the selection and hit enter does it report "Nothing Selected" ? The filter is currently looking for objects that are coloured Blue (colour book colour 5) AND on layer '1 EXISTING TO RELO'. I suspect that your selection doesn't contain anything that matches both criteria

 

Perhaps create a new item that is both blue and on the layer an try again - see if it picks that up

 

If that all goes wrong and you are able, post a snippet (as a DWG) of the drawing you are trying to change and I can have a look

[BIGAL]

Change to this will make it more obvious has not worked. Check dwg you may have the colour matching but it is bylayer. 

 

(princ "Nothing Selected")  

 (Alert "Nothing Selected")