Topic: Every Object On A Separate Layer?

[stusic]

Hello All,

I try not to just ask for lisp routines, but I'm not sure how to write what I want or modify something similar I've found. Some direction would be great.

I'd like to move every object in modelspace to its own layer, maintaining its color/lineweight/etc. I've found a nifty routine from Lee Mac (posted below), but it's got a couple of problems:
1.) I don't want it to assign a random color, but inherit the layer's properties from the object,
2.) it looks at the number of objects in the selection and prefixes the layer name with the appropriate amount of zeros, where I just want to prefix the layer name with 4 zeros; right now, if I run the routine and select all the objects, it'll assign a layer name like "3d004" if there's more than a hundred objects, but if I rerun the routine and select less than 10 objects, it'll move those objects to layers similar to "3d4". If an object's already on a "3d0000" layer, I don't want to ever assign it to another layer (so ignore objects that are already on a "3dxxxx" layer).

Can anyone offer some advice to get this done?

I appreciate it,

stu

Code: [Select]

(defun c:Solids2Layers ( / _padzeros a b e i l n p s )
    (setq p "3d")

    (defun _padzeros ( s l )
        (if (< (strlen s) l) (_padzeros (strcat "0" s) l) s)
    )
    (if (setq s (ssget "_:L" '((0 . "*SOLID"))))
        (progn
            (setq
                i (sslength s)
                l (1+ (fix (/ (log i) (log 10))))
                n 0
            )
            (repeat i
                (setq e (entget (ssname s (setq i (1- i)))))
                (entmod
                    (subst
                        (cons  8 (strcat p (_padzeros (itoa (setq n (1+ n))) l)))
                        (assoc 8 e)
                        e
                    )
                )
            )
            (setq n 0)
            (while (setq a (tblnext "LAYER" (null a)))
                (if (wcmatch (setq b (cdr (assoc 2 a))) (strcat p "*"))
                    (entmod
                        (setq b (entget (tblobjname "LAYER" b))
                              b (subst (cons 62 (setq n (1+ (rem n 254)))) (assoc 62 b) b)
                        )
                    )
                )
            )
        )
    )
    (princ)
)

[stevej]

As a quick test, I changed the routine to apply to TEXT, because I don't work with solids,
and made the following code alteration:

Code: [Select]

b (subst (cons 62 (setq n (1+ (rem n 254)))) (assoc 62 b) b)
to

Code: [Select]

b (subst (cons 62 (setq n (256))) (assoc 62 b) b)
That stopped the color cycling and seemed to address your issue number 1.
EDIT: Not entirely, though. My TEXT objects retained their assigned color if they were not colored BYLAYER, and each text object was given its own layer, but the Layer Properties Manager showed their respective layer colors to be WHITE. Probably not the desired result.

Not savvy enough to help much beyond that, but thought I'd at least chime in with what I could contribute.

Steve

[ronjonp]

To exclude items that are already on a 3d* layer change your filter to this:

Code - Auto/Visual Lisp: [Select]

1. (setq s (ssget "_:L" '((0 . "*SOLID")(8 . "~3D*"))))

This might be what you're looking for.

Code - Auto/Visual Lisp: [Select]

1. (defun c:solids2layers (/ e i le n p s)
2.   ;; RJP Hardcoded 4 zeroes after the '3d' prefix
3.   (setq p "3d0000")
4.   ;; RJP update filter to exclude items already renamed
5.   (if (setq s (ssget "_:L" (list '(0 . "*SOLID") (cons 8 (strcat "~" p "*")))))
6.     (progn (setq i (sslength s)
7.                  n 0
8.            )
9.            (repeat i
10.              (setq e (entget (ssname s (setq i (1- i)))))
11.              (setq le (vl-remove-if-not
12.                         '(lambda (x) (vl-position (car x) '(0 100 70 2 62 6 290)))
13.                         (entget (tblobjname "layer" (cdr (assoc 8 e))))
14.                       )
15.              )
16.              ;; Create new layer matching a few properties of the existing layer
17.              (entmakex (subst (cons 2 (strcat p (itoa (setq n (1+ n))))) (assoc 2 le) le))
18.              ;; Move item to our new layer
19.              (entmod (subst (cons 8 (strcat p (itoa n))) (assoc 8 e) e))
20.            )
21.     )
22.   )
23.   (princ)
24. )

[stusic]

To exclude items that are already on a 3d* layer change your filter to this:

Code - Auto/Visual Lisp: [Select]

1. (setq s (ssget "_:L" '((0 . "*SOLID")(8 . "~3D*"))))

Hey, that's pretty cool. By filtering out the "3D*" layers, I can get rid of the leading zeros altogether.

This might be what you're looking for.

Code - Auto/Visual Lisp: [Select]

1. (defun c:solids2layers (/ e i le n p s)
2.   ;; RJP Hardcoded 4 zeroes after the '3d' prefix
3.   (setq p "3d0000")
4.   ;; RJP update filter to exclude items already renamed
5.   (if (setq s (ssget "_:L" (list '(0 . "*SOLID") (cons 8 (strcat "~" p "*")))))
6.     (progn (setq i (sslength s)
7.                  n 0
8.            )
9.            (repeat i
10.              (setq e (entget (ssname s (setq i (1- i)))))
11.              (setq le (vl-remove-if-not
12.                         '(lambda (x) (vl-position (car x) '(0 100 70 2 62 6 290)))
13.                         (entget (tblobjname "layer" (cdr (assoc 8 e))))
14.                       )
15.              )
16.              ;; Create new layer matching a few properties of the existing layer
17.              (entmakex (subst (cons 2 (strcat p (itoa (setq n (1+ n))))) (assoc 2 le) le))
18.              ;; Move item to our new layer
19.              (entmod (subst (cons 8 (strcat p (itoa n))) (assoc 8 e) e))
20.            )
21.     )
22.   )
23.   (princ)
24. )

This works pretty good, but if I run it on an set of objects making say, "3D00001", "3D00002", and "3D00003", then if I run it again, it will begin the new selections with "3D00001" instead of "3D00004".

;; Create new layer matching a few properties of the existing layer
        (entmakex (subst (cons 2 (strcat p (itoa (setq n (1+ n))))) (assoc 2 le) le))

Too much trouble to make it grab the properties of the object, not the layer it's originally on?

I'm having a hard time following what a lot of this code is doing. I'm no expert by any means, but most of the time I can find something similar and nudge it to do what I want. Not this time. Especially with Lee's stuff - man, he's friggin' amazing, but his code almost always looks like sanskrit to me.

Hey thanks for the help ronjonp, I do appreciate it.

[stusic]

Not savvy enough to help much beyond that, but thought I'd at least chime in with what I could contribute.

Steve

I appreciate it. You've gotten farther than I did

[ronjonp]

If someone else does not give you an answer before morning, I'll take another look when I'm back at my computer. 

[Kerry]

Something to play with for the case where you want to just increment the last used layerName matching the pattern required.
I'll leave testing for not-used names in the list  for later.
Work through the code so that you understand the process.

Code - Auto/Visual Lisp: [Select]

1. (setq *:acapp     (vlax-get-acad-object)
2.       *:activedoc (vla-get-activedocument *:acapp)
3.       *:layers    (vla-get-layers *:activedoc)
4. )
5. ;;;------------------------------------------------------------------
6. ;;;------------------------------------------------------------------
7. ;;;
8. (defun kdub:padLeftWith (st len pad / tmp)
9.   (setq tmp "")
10.   (strcat (repeat (- len (strlen st)) (setq tmp (strcat pad tmp))) st)
11. )
12. ;;;------------------------------------------------------------------
13. ;;;------------------------------------------------------------------
14. ;;; Return list of all collection member names
15. ;;;
16. (defun kdub:listcollmbrnames (collection / itemname returnvalue)
17.   (setq returnvalue '())
18.   (vlax-for each collection
19.     (setq itemname    (vla-get-name each)
20.           returnvalue (cons itemname returnvalue)
21.     )
22.   )
23.   (reverse returnvalue)
24. )
25. ;;;------------------------------------------------------------------
26. ;;;------------------------------------------------------------------
27. ;;;
28. ;; determine the last used Layer Name to match the pattern
29. ;; '3D' and 5 digits
30. (setq 3DLayerNames (vl-remove-if-not
31.            '(lambda (x) (wcmatch x "3D#####") ) (kdub:listcollmbrnames *:layers)
32.          )
33. )
34. (if (setq last3DLayerName (last 3DLayerNames))
35.   (setq digit (atoi (vl-string-trim "3D" last3DLayerName)))
36. )
37.  
38. ;; set the next Layer Name
39. ;;
40. (or digit (setq digit 0))
41.  
42. (setq nextdigit (1+ digit)
43.       nextLayer (strcat "3D" (kdub:padleftwith (itoa nextdigit) 5 "0"))
44. )
45.  

[ronjonp]

Give this version a try

Code - Auto/Visual Lisp: [Select]

1. (defun c:solids2layers (/ c e i lt n p pre s)
2.   ;; RJP Hardcoded 4 zeroes after the '3d' prefix
3.   (setq p "3d0000")
4.   ;; RJP update filter to exclude items already renamed
5.   (if (setq s (ssget "_:L" (list '(0 . "*SOLID") (cons 8 (strcat "~" p "*")))))
6.     (progn (setq i (sslength s)
7.                  n 0
8.            )
9.            (repeat i
10.              ;; While loop to find next available number
11.              (while (tblobjname "layer" (setq pre (strcat p (itoa (setq n (1+ n)))))))
12.              ;; Get entity list
13.              (setq e (entget (ssname s (setq i (1- i)))))
14.              ;; Get color by object
15.              (setq c (assoc 62 e))
16.              ;; Get linetype
17.              (setq lt (assoc 6 e))
18.              ;; Create layer with color & linetype of item ( if found )
19.              (entmakex (list '(0 . "LAYER")
20.                              '(100 . "AcDbSymbolTableRecord")
21.                              '(100 . "AcDbLayerTableRecord")
22.                              '(70 . 0)
23.                              (cons 2 pre)
24.                              (if c
25.                                c
26.                                '(62 . 7)
27.                              )
28.                              (if lt
29.                                lt
30.                                '(6 . "continuous")
31.                              )
32.                        )
33.              )
34.              ;; Move item to our new layer
35.              (entmod (subst (cons 8 pre) (assoc 8 e) e))
36.            )
37.     )
38.   )
39.   (princ)
40. )

[WillCAD]

Instead of trying to create a new layer name with a random or sequential numeric sequence, why not create the new layer name by extracting each object's entity handle? You could run it through some string modifications to prepend 3D- to it so it sorts properly with other layers.

You would insert this at line 14:

;; Get entity handle string
(setq en (cdr (assoc 5 e)))

This extracts the entity handle of the object and assigns it to a new variable called en. You'd use en as the layer name when creating the new layer. Handles are unique within each drawing, which would make each of the new layer names unique to its sole occupant, and you won't have to worry about having duplicate layer names or prepending the appropriate number of zeroes.

[Kerry]

Will,
The Object ID is not designed to be the same from session to session ... in fact, it can change as a result of a save-as.

Therefore a reliance on the relationship and uniqueness may fail.

[roy_043]

Object ID and handle are different properties. A handle should be constant from session to session (in the same dwg).

[Kerry]

I must be going batty ... I'm sure I read that as Object ID.

Did the editing fairies strike again ??