change layer wipeout in block

[pmxcad]

Hello,

Is it possible to change the layer from a wipeout in a block with a lisp?

I know ho it can be done bij script using ssx. But it's not working on wipeouts in a block.

I like to change the wipeout from layer "0" to layer "Wipeout".

Thanks

 

PmxCAD

[marko_ribar]

Try this...

 

(defun c:wipechlayer ( / *error* *adoc* cnt blocks ss i flag )

 (vl-load-com)

 (defun *error* ( msg )
   (vla-endundomark *adoc*)
   (vla-regen *adoc* :vlax-false)
   (if msg
     (prompt msg)
   )
   (princ)
 )

 (setq *adoc* (vla-get-activedocument (vlax-get-acad-object)))
 (vla-startundomark *adoc*)
 (setq cnt 0)
 (setq blocks (vla-get-blocks *adoc*))
 (vlax-for x blocks
   (if (eq (vla-get-isxref x) :vlax-false)
      (vlax-for item x
        (if (eq (vla-get-objectname item) "AcDbWipeout")
          (if (eq (vla-get-lock (vla-item (vla-get-layers (vla-get-activedocument (vlax-get-acad-object))) (vla-get-layer item))) :vlax-false)
            (progn
              (if (wcmatch (strcase (vla-get-name x)) "*MODEL*,*PAPER*")
                (progn
                  (entupd (cdr (assoc -1 (entmod (subst (cons 8 "Wipeout") (assoc 8 (entget (vlax-vla-object->ename item))) (entget (vlax-vla-object->ename item)))))))
                  (setq cnt (1+ cnt))
                )
                (progn
                  (command "_.BEDIT" (vla-get-name x))
                  (setq ss (ssget "_A" '((0 . "WIPEOUT"))))
                  (repeat (setq i (sslength ss))
                    (entupd (cdr (assoc -1 (entmod (subst (cons 8 "Wipeout") (assoc 8 (entget (ssname ss (setq i (1- i))))) (entget (ssname ss i)))))))
                    (setq cnt (1+ cnt))
                  )
                  (command "_.BCLOSE" "")
                )
              )
            )
            (setq flag T)
          )
        )
      )
   )
 )
 (prompt (strcat "\nNumber of wipeouts changed layer: " (itoa cnt)))
 (if flag
   (prompt
     "\nSome wipeouts could not be changed with new layer. Check for locked layers..."
   )
 )
 (*error* nil)
)

(defun c:wchl nil (c:wipechlayer))
(prompt "\nInvoke with : \"wchl\"")
(princ)

Regards...

[Tharwat]

Try this program in pure Vanilla:

 

(defun c:wo2laywo  (/ sel obj nxt ent blk lst)
 ;;====================================;;
 ;; Tharwat - 13.Apr.2016        ;;
 ;; Move WIPEOUT objects in blocks to     ;;
 ;; layer name WIPEOUT is existed.    ;;
 ;;====================================;;
 (if (and (tblsearch "LAYER" "WIPEOUT")
          (setq sel (ssget "_:L" '((0 . "INSERT"))))
          )
   (progn
     (while (setq obj (ssname sel 0))
       (if
         (and (setq nxt (tblobjname "BLOCK" (setq blk (cdr (assoc 2 (entget obj))))))
              (not (member blk lst))
              )
          (progn
            (setq lst (cons blk lst))
            (while (setq nxt (entnext nxt))
              (if (eq "WIPEOUT" (cdr (assoc 0 (setq ent (entget nxt)))))
                (entmod (subst '(8 . "WIPEOUT") (assoc 8 ent) ent))
                )
              )
            )
          )
       (ssdel obj sel)
       )
     (command "_.regen")
     )
   (princ "\nEither Layer name <WIPEOUT> is not found or nothing selected !")
   )
 (princ)
 )

[pmxcad]

Thanks Marco & Tharwat,

 

both are super. I prefer the one made by Marco. It runs without selecting objects.

 

PmxCAD

[Tharwat]

You're welcome.