Monday 18 February 2013

Match Layer

(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)
)

0 comments:

Post a Comment