(defun c:Cl (/ *error* adoc sset e lay layname e changelayer) (defun *error* (s) (if adoc (vla-endundomark adoc)) (if (not (member s '("Function cancelled" "quit / exit abort"))) (princ (strcat "\n---->Error:" s)) ) (princ) ) (defun changelayer (ent name / ss ename i) (if (> (sslength ent) 1) (princ (strcat "\n"(rtos (sslength ent) 2 0) " objects changed Layer to \"" name "\"")) (princ (strcat "\nOne object changed Layer to \"" name "\"")) ) (repeat (setq i(sslength ent)) (setq ss(ssname ent(setq i(1- i)))) (setq ename(vlax-ename->vla-object ss)) (if (vlax-write-enabled-p ename) (vla-put-layer ename name) ) ) ) (setq adoc (vla-get-activedocument (vlax-get-acad-object))) (vla-startundomark adoc) (if (setq sset (ssget "_:L")) (progn (while (progn (setvar 'errno 0) (initget "TypeIt") (setq sel (entsel "\nSelect an Object for Layer or [Type It]:")) (cond ( (= 7 (getvar 'errno) ) (princ "\nNothing Selected.") ) ( (= sel "TypeIt") (setq Lay (getstring "\nEnter Layer Name:")) (if (not (tblsearch "LAYER" Lay)) (progn (princ (strcat "\nEntered Layer Name \"" lay "\" Does Not exist in Layers List!")) (princ "\nTry again.") ) (changelayer sset lay) ) ) ( (= 'ename (Type (car sel))) (setq e (vlax-ename->vla-object (car sel))) (if (vlax-property-available-p e 'Layer) (setq layname(vla-get-layer e)) ) (changelayer sset layname) ) ) ) ) ) (*error* "Non Objects Selected!") ) (vla-endundomark adoc) (princ) )
Monday, 18 February 2013
Posted by Unknown on 00:12 with No comments
Subscribe to:
Post Comments (Atom)
0 comments:
Post a Comment