[综合讨论] 清理archi的Lisp例程

(defun allbylayer ( / x obj ssall)
(setq ssall (ssget "x"))
(repeat (setq x  (sslength ssall))
(setq obj (vlax-ename->vla-object (ssname ssall (setq x (- x 1)))))
(vlax-put-property obj "Linetype" "Bylayer") 
(vlax-put-property obj "Lineweight" " -1")
(vlax-put-property obj "Color" acbylayer)
)
)
(allbylayer)
(Alert "All objects now by layer")

; open database
(setq  doc (vla-get-activedocument  (vlax-get-acad-object))) 
(setq lays (vla-get-Layers doc))
(vlax-for lay lays
(vla-put-color lay 
(vla-put-lineweight lay 18) ; note 18 for metric =0.18 not tested on feet dwg must match a known size.
)

(while (setq ss (ssget "X" ))
(sssetfirst nil ss)
(C:Burst)
)

(command "-purge" "all" "*" "n")

(defun c:drawingtobylayer
      ;;-----------------------------------------------------------------
      ;;
      ;;  Copyright © 2004 Michael Puckett. All Rights Reserved
      ;;
      ;;-----------------------------------------------------------------
      ;;
      ;;  Forces the entire drawing to "ByLayer" (even xrefs for
      ;;  the lifetime of the session or until an xref reload
      ;;  occurs).
      ;;
      ;;  Forces block definition child entities to layer "0".
      ;;
      ;;  Existing attributes are forced to the same layer the
      ;;  parent block reside on.
      ;;
      ;;  Nominally tested, let me know if you find anything wonky.
      ;;
      ;;  * Use at your own risk. Please test on a dummy dwg *
      ;;
      ;;-----------------------------------------------------------------
      (/ _unlockalllayers _locklayers _objecttolayerzero _objecttobylayer _documenttobylayer _main)
 ;; (idt_draworder (idt_ss->vla-list (ssget)) 'movetobottom)
 (defun _unlockalllayers (document / result)
   (vlax-for layer (vlax-get-property document 'layers)
     (cond ((eq :vlax-true (vlax-get-property layer 'lock))
     (vlax-put-property layer 'lock :vlax-false)
     (setq result (cons layer result))
    )
     )
     ;; RJP added: Change all layers to color 8, linewight to 18mm, thaw and turn on
     (foreach property        '((color .  (lineweight . 18) (freeze . 0) (layeron . -1))
(vl-catch-all-apply 'vlax-put (list layer (car property) (cdr property)))
     )
   )
   result
 )
 (vlax-ename->vla-object (tblobjname "layer" "0"))
 (defun _locklayers (layers) (foreach layer layers (vlax-put-property layer 'lock :vlax-true)))
 ;; (defun _objecttolayerzero (object) (vlax-put-property object 'layer "0"))
 (defun _objecttobylayer (obj / layer)
   ;; RJP added lineweight and transparency
   (foreach property '((color . 256)
                (linetype . "ByLayer")
                (lineweight . "ByLayer")
                (transparency . "ByLayer")
               )
     (vl-catch-all-apply 'vlax-put (list obj (car property) (cdr property)))
   )
   (cond ((and        (eq "AcDbBlockReference" (vlax-get obj 'objectname))
        (eq :vlax-true (vlax-get-property obj 'hasattributes))
   )
   (setq layer (vlax-get-property obj 'layer))
   (foreach child (vlax-invoke obj 'getattributes)
     (_objecttobylayer child)
     (vlax-put-property child 'layer layer)
   )
  )
  ;; RJP added hatch to color 254
  ((eq "AcDbHatch" (vlax-get obj 'objectname))
   (vl-catch-all-apply 'vla-put-color (list obj 254))
  )
   )
 )
 (defun _documenttobylayer (document)
   (vlax-for block (vlax-get-property document 'blocks)
     (if (eq :vlax-true (vlax-get-property block 'islayout))
(vlax-for object block (_objecttobylayer object))
(vlax-for object block (_objecttobylayer object))
     )
   )
 )
 (defun _main (/ document lockedlayers)
   (setq lockedlayers
   (_unlockalllayers
     (setq document (vlax-get-property (vlax-get-acad-object) 'activedocument))
   )
   )
   (_documenttobylayer document)
   ;; RJP leave layers unlocked
   ;; (_locklayers lockedlayers)
   (princ)
 )
 (_main)
)