[编程交流] lisp将所有实体移动到l

(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

(defun c:test (/ a b i)
 (if (setq a (ssget))
   (repeat (setq i (sslength a))
     (setq b (vlax-ename->vla-object (ssname a (setq i (1- i)))))
     (vla-put-layer b "sat")                ;Replace "0" with (getvar "CLAYER") for current layer
     (vla-put-color b 256)
   )
 )
 (princ)
)