Topic: (beta test) Change to current layer app

[JohnK]

I need some beta testers please.

I wanted to create a program that will allow me to change an item to the current layer. Something quick and simple. But I havent written a program in a long time so... Could someone break this. (Im looking for its "limits") Once I think its to an acceptable level, I'll re-write it so I can have cleaner code and a bit more optomized progy.

ChangeLayer.lsp

[MP]

No can review --



Grrr. Here's a quick one off for ideas --

Code: [Select]

(defun c:ToCLayer ( / _GetLockedLAyers _MakeLayerFilter _Main )

    (defun _GetUnLockedLayers ( document / result )
        (vlax-for layer (vla-get-layers document)
            (if (eq :vlax-false (vla-get-lock layer))
                (setq result
                    (cons
                        (vla-get-name layer)
                        result
                    )
                )
            )
        )
    )
   
    (defun _MakeLayerFilter ( layers )
        (if layers
            (append
               '((-4 . "<or"))
                (mapcar '(lambda (layer) (cons 8 layer)) layers)
               '((-4 . "or>"))
            )
        )    
    )
   
    (defun _Main ( document / ss i unlocked clayer )
        (cond
            (  
                (and
                    (setq unlocked (_GetUnLockedLayers document))
                    (setq
                        clayer   (getvar "clayer")
                        ss       (ssget (_MakeLayerFilter unlocked))
                    )
                )    
                (repeat (setq i (sslength ss))
                    (vla-put-layer
                        (vlax-ename->vla-object    
                            (ssname ss
                                (setq i (1- i))
                            )
                        )
                        clayer
                    )
                )
            )
            (   (null unlocked)
                (princ
                    (strcat
                        "All layers are locked, thus "
                        "you can't do anything."
                    )    
                )
            )
        )
        (princ)        
    )
   
    (_Main
        (vla-get-activedocument
            (vlax-get-acad-object)
        )
    )
   
)
Nominally tested, cheers.

Edit: Tested for all layers locked scenario.

[JohnK]

Cut and paste ma-friend.

Thanx, i'll look at it now.

[Dommy2Hotty]

Here was my cheap button I made...I was so proud of it *tear*

Code: [Select]

(setq clay (getvar "clayer"));(setq ent (ssget));\\;(command "chprop" ent "" "LA" clay "");

[JohnK]

...locked layer?! Good one.

[MP]

Thanks John. I updated it to deal with the scenario of all layers locked.

[JohnK]

Dommy,  Nice, but a button isnt what i wanted. I also supose i could have used the express tool and made a keyboard shortcut, but i this is more fun.

[Dommy2Hotty]

Oh...I know...just showing how I'm humbled by everyone's abilities here.

[JohnK]

Oh got cha buddy.

*Psst!* No one should feel "less then" cause we all have our strengths and we all start somewhere.

[CAB]

John
Here is my take on the routine.
It does not need the Undo, on my system anyway.
I gave the option of pickfirst or entsel or ssget.

Code: [Select]

;;;*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*
;;; FUNCTION
;;;   To filter a preselected selection set for object types
;;;   listed in the variable list lst
;;;
;;; ARGUMENTS
;;;   lst -> a list of object types like ("TEXT" "MTEXT")
;;;          nil will allow all types
;;;
;;; USAGE
;;;   (setq ss (getpickfirst typs))
;;;
;;; PLATFORMS
;;; 2000+
;;;
;;; AUTHOR
;;; Copyright© 2004 Charles Alan Butler  
;;;          Co-author S. Madsen
;;;   ab2draft@TampaBay.rr.com
;;;
;;; VERSION
;;; 1.1 Sep. 18, 2004
;;;*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*
(defun getpickfirst (lst / ss a ent)
  ;;  lst is a list of object types like ("TEXT" "MTEXT")
  (cond ((and (setq ss (cadr (ssgetfirst))) ; get previously selected sel set
              lst ; nil will allow all types
         )
         (setq a 0) ; set pointer
         (repeat (sslength ss) ; foreach object in sel set
           (setq ent (ssname ss a) ; get obj name
                 a   (1+ a)
           ) ; increment counter
           ;; is obj not a member of the list ?
           (and (not (member (cdr (assoc 0 (entget ent))) lst))
                (ssdel ent ss) ; if not a member remove it from ss
                (setq a (1- a)) ; and deincrement pointer
           ) ; and
         ) ; repeat
        ) ; end cons 1
  ) ; end cond stmt
  ;; if ss is a pick set and has objects then return the selection set
  (if (and (= (type ss) 'pickset) (/= 0 (sslength ss)))
    ss
  )
  ;;  else return nil because when IF fails it returns nil
) ; end defun

(defun IsLocked (lname)
  (= (vlax-get-property
       (vla-item
         (vla-get-Layers
           (vla-get-ActiveDocument
             (vlax-get-acad-object)
           )
         )
         lname
       ) ; layer name
       'Lock
     )
     :vlax-true
  )
)

(defun c:ent2lyr (/ ent ss obj lyr i)
  (if
    (or (setq ss (getpickfirst nil))
        (setq ent (entsel "\nSelect entity to move to current layer."))
        (null (prompt "\nSelect a group of objects to move to current layer."))
        (setq ss (ssget))
    )
     (cond
       (ent
        (if (IsLocked
              (setq lyr (vlax-get-property
                          (setq obj (vlax-ename->vla-object (car ent)))
                          'LAYER
                        )
              )
            )
          (prompt (strcat "\n**  Locked Layer -->" lyr " **"))
          (vlax-put-property obj 'LAYER (getvar "clayer"))
        )
       )
       (T
        (setq i -1)
        (while (setq ent (ssname ss (setq i (1+ i))))
          (if (IsLocked
                (setq lyr (vlax-get-property
                            (setq obj (vlax-ename->vla-object ent))
                            'LAYER
                          )
                )
              )
            (prompt (strcat "\n**  Locked Layer -->" lyr " **"))
            (vlax-put-property obj 'LAYER (getvar "clayer"))
          )
        )
       )
     )
  )
  (princ)
)