help modifying a lisp

[Edwin.Saez]

Hi all,

I have this lisp which serves to bring all the objects to layer 0, but I would like to add that it excludes the objects that are in the "defpoints" layer. Also objects that are layered where they are "turned off" and / or "freeze" are removed.
All this has to work for all the objects that are also inside the blocks.
Someone who can help me with this.

(vl-load-com)
(defun c:COMBINELAYERS(/ doc blocks blk eo layers lay)
;CHANGE BY LAYER COLOR TO OVERRIDE COLOR 
 ;; Get the ActiveX object of the current dwg
 (setq doc    (vla-get-ActiveDocument (vlax-get-acad-object))
       blocks (vla-get-Blocks doc) ;Get the blocks collection
       layers (vla-get-Layers doc) ;Get the layers collection
 ) ;_ end of setq

 ;; Step through all blocks (including Model Space & Layouts)
 (vlax-for blk blocks
   ;; Step through all contained entities in block
   (vlax-for eo blk
     ;; Get the layer the entity is placed on
     (setq lay (vla-Item layers (vla-get-Layer eo)))
     (vla-put-Layer eo (getvar "CLAYER")) ;Change the entity to the current layer
     (if (= (vla-get-Color eo) 256)
       ;;If its colour bylayer, change it to overridden color to match
       (vla-put-Color eo (vla-get-color lay))
     ) ;_ end of if
     (if (= (strcase (vla-get-Linetype eo)) "BYLAYER")
       ;;If its linetype bylayer, change it to overridden linetype to match
       (vla-put-Linetype eo (vla-get-Linetype lay))
     ) ;_ end of if
     (if (= (vla-get-Lineweight eo) -1)
       ;;If its lineweight bylayer, change it to overridden lineweigth to match
       (vla-put-Lineweight eo (vla-get-Lineweight lay))
     ) ;_ end of if
   ) ;_ end of vlax-for
 ) ;_ end of vlax-for
 (princ)
) ;_ end of defun

[pbejse]

---

@Edwin.Saez wrote:

Hi all,

I have this lisp which serves to bring all the objects to layer 0, but I would like to add that it excludes the objects that are in the "defpoints" layer. Also objects that are layered where they are "turned off" and / or "freeze" are removed.

---

Not thoroughly tested

(vl-load-com)
(defun c:ToLayerZeroIf (/ doc blocks eo layers exclude)
  (setq	doc	(vla-get-ActiveDocument (vlax-get-acad-object))
	blocks	(vla-get-Blocks doc)
	layers	(vla-get-Layers doc)
	exclude	'("Defpoints")
  ) ;_ end of setq
  (vlax-for lay	(vla-get-Layers doc)
    (if
      (vl-some '=
	       '(0 -1)
	       (mapcar '(lambda (p) (Vlax-get lay p))
		       '("LayerOn" "Freeze")
	       ) ;_ end of mapcar
      ) ;_ end of vl-some
       (setq exclude (cons (Vla-get-name lay) exclude))
    ) ;_ end of if
  ) ;_ end of vlax-for
  (vlax-for blk	blocks
    (vlax-for eo blk
      (if (not (member (vla-get-Layer eo) exclude))
	(Vla-put-layer eo "0")
      ) ;_ end of if
    ) ;_ end of vlax-for
  ) ;_ end of vlax-for

) ;_ end of defun

HTH

Hang on, does it mean "ALSO" to include this option, and not entirely re-write the code?

(vl-load-com)
(defun c:COMBINELAYERS (/ doc blocks blk eo layers lay exclude)
					;CHANGE BY LAYER COLOR TO OVERRIDE COLOR 
  ;; Get the ActiveX object of the current dwg
  (setq	doc    (vla-get-ActiveDocument (vlax-get-acad-object))
	blocks (vla-get-Blocks doc)	;Get the blocks collection
	layers (vla-get-Layers doc)	;Get the layers collection
        exclude '("Defpoints")
  ) ;_ end of setq
  (vlax-for lay	(vla-get-Layers doc)
    (if
      (vl-some '=
	       '(0 -1)
	       (mapcar '(lambda (p) (Vlax-get lay p))
		       '("LayerOn" "Freeze")
	       ) ;_ end of mapcar
      ) ;_ end of vl-some
       (setq exclude (cons (Vla-get-name lay) exclude))
    ) ;_ end of if
  ) ;_ end of vlax-for

  ;; Step through all blocks (including Model Space & Layouts)
  (vlax-for blk	blocks
    ;; Step through all contained entities in block
    (vlax-for eo blk
      (if (not (member (vla-get-Layer eo) exclude))
	(progn
	  ;; Get the layer the entity is placed on
	  (setq lay (vla-Item layers (vla-get-Layer eo)))
	  (vla-put-Layer eo (getvar "CLAYER"))
					;Change the entity to the current layer
	  (if (= (vla-get-Color eo) 256)
	    ;;If its colour bylayer, change it to overridden color to match
	    (vla-put-Color eo (vla-get-color lay))
	  ) ;_ end of if
	  (if (= (strcase (vla-get-Linetype eo)) "BYLAYER")
	    ;;If its linetype bylayer, change it to overridden linetype to match
	    (vla-put-Linetype eo (vla-get-Linetype lay))
	  ) ;_ end of if
	  (if (= (vla-get-Lineweight eo) -1)
	    ;;If its lineweight bylayer, change it to overridden lineweigth to match
	    (vla-put-Lineweight eo (vla-get-Lineweight lay))
	  ) ;_ end of if
	) ;_ end of progn
      ) ;_ end of if
    ) ;_ end of vlax-for
  ) ;_ end of vlax-for
  (princ)
) ;_ end of defun

Tell me how it goes

[Edwin.Saez]

@pbejse ,

Thanks for responding and for your help.

The modification you made to the lisp I shared best suits my needs. Exclusion works fine but objects within the "turn off" and "freeze" layers are not removed. Would there be a possibility of that? the purpose is then to be able to remove those layers that contain the "off" and "freeze" objects, along with the objects within these layers.
the "defpoints" layer if you should keep the objects.

[pbejse · Accepted solution]

---

@Edwin.Saez wrote:

The modification you made to the lisp I shared best suits my needs. Exclusion works fine but objects within the "turn off" and "freeze" layers are not removed. Would there be a possibility of that? the purpose is then to be able to remove those layers that contain the "off" and "freeze" objects, along with the objects within these layers.the "defpoints" layer if you should keep the objects.

---

Always be clear on what you need from the very first post @Edwin.Saez .

Truly is one of my biggest pet peeves.

(defun c:DelOffFrozenLAyers (/ doc blocks blk eo layers lay exclude)
					;CHANGE BY LAYER COLOR TO OVERRIDE COLOR 
  ;; Get the ActiveX object of the current dwg
  (setq	doc	 (vla-get-ActiveDocument (vlax-get-acad-object))
	blocks	 (vla-get-Blocks doc)	;Get the blocks collection
	layers	 (vla-get-Layers doc)	;Get the layers collection
	curLAyer (getvar 'clayer)
	exclude	 (list curLAyer "Defpoints")
  )
  ;_ end of setq
  (vlax-for lay	layers
    (if
      (And
	(vl-some '=
		 '(0 -1)
		 (mapcar '(lambda (p) (Vlax-get lay p))
			 '("LayerOn" "Freeze")
		 ) ;_ end of mapcar
	) ;_ end of vl-some
	(not (member (setq ln (Vla-get-name lay)) (Cons "0" exclude)))
      ) ;_ end of And
       (command	"_.layer" "_unlock" ln ""
		"_.laydel" "_name" ln "" "_yes"
       ) ;_ end of command

    ) ;_ end of if
  ) ;_ end of vlax-for

  ;; Step through all blocks (including Model Space & Layouts)
  (vlax-for blk	blocks
    ;; Step through all contained entities in block
    (vlax-for eo blk
      (if (not (member (vla-get-Layer eo) exclude))
	(progn
	  ;; Get the layer the entity is placed on
	  (setq lay (vla-Item layers (vla-get-Layer eo)))
	  (vla-put-Layer eo curLAyer)
					;Change the entity to the current layer
	  (if (= (vla-get-Color eo) 256)
	    ;;If its colour bylayer, change it to overridden color to match
	    (vla-put-Color eo (vla-get-color lay))
	  ) ;_ end of if
	  (if (= (strcase (vla-get-Linetype eo)) "BYLAYER")
	    ;;If its linetype bylayer, change it to overridden linetype to match
	    (vla-put-Linetype eo (vla-get-Linetype lay))
	  ) ;_ end of if
	  (if (= (vla-get-Lineweight eo) -1)
	    ;;If its lineweight bylayer, change it to overridden lineweigth to match
	    (vla-put-Lineweight eo (vla-get-Lineweight lay))
	  ) ;_ end of if
	) ;_ end of progn
      ) ;_ end of if
    ) ;_ end of vlax-for
  ) ;_ end of vlax-for
  (princ)
)

HTH

[diagodose2009]

Why the programe "autozero.lsp"  , contain 133'many Failed?

Command: bds
Count EntitiesInside tozero=1471
FailedEntitiesInside tozero=133 ???
All ExcludeLayer=((Z COTE Defpoints))
All done.The End.

[Edwin.Saez]

@pbejse ,

thanks for your time in helping me.

[pbejse]

---

@Edwin.Saez wrote:

thanks for your time in helping me.

---

You are welcome, Glad I could help.

Kudos to @Kent1Cooper  for the Laydel Unlock approach  from a recent discussion  👍

[ronjonp]

Here's another for fun 🙂

(defun c:foo (/ d e er fl ln n n2 x)
  ;; RJP » 2020-07-07
  (mapcar 'set '(er n n2) '(0 0 0))
  ;; Get frozen and off layers
  (vlax-for lay	(vla-get-layers (setq d (vla-get-activedocument (vlax-get-acad-object))))
    (and (not (wcmatch (strcase (vla-get-name lay)) "*|*,0,DEFPOINTS"))
	 (or (= -1 (vlax-get lay 'freeze)) (= 0 (vlax-get lay 'layeron)))
	 (setq fl (cons (vla-get-name lay) fl))
	 (vlax-put lay 'lock 0)
    )
  )
  (vlax-for b1 (vla-get-blocks d)
    ;; If it's not an xref
    (if	(= 0 (vlax-get b1 'isxref))
      (vlax-for	b2 b1
	(if (vl-position (setq ln (vla-get-layer b2)) fl)
	  (if (vl-catch-all-error-p (vl-catch-all-apply 'vla-delete (list b2)))
	    (setq er (1+ er))
	    (setq n (1+ n))
	  )
	  ;; Assign object to layer 0 with linetype, lweight, and color of layer it's currently on
	  (progn (setq e (entget (tblobjname "layer" ln)))
		 (entmod (append (entget (vlax-vla-object->ename b2))
				 (mapcar '(lambda (x) (assoc x e)) '(6 62 370))
				 '((8 . "0"))
			 )
		 )
		 (setq n2 (1+ n2))
	  )
	)
      )
    )
  )
  (alert (strcat (if (= 0 er)
		   ""
		   (strcat (itoa er) " errors deleting objects...\n")
		 )
		 (strcat (itoa n) " objects were deleted, ")
		 (strcat (itoa n2) " objects were placed on layer 0.")
	 )
  )
  (princ)
)