[转贴]：删除冻结层及其冻结层上的图元

lsjjm

删除冻结层及其冻结层上的图元

[php]
;;;   04/06/2004 CAB modified to include unlock test & fixed bug.
(defun c:frozenlayerkiller ()
  (vlax-for each (vla-get-layers (vla-get-ActiveDocument (vlax-get-Acad-Object)))
    (cond
      ((and
         (= (vla-get-freeze each) :vlax-true)
         (= (vla-get-lock each) :vlax-false);CBA
        )
       (foreach item
                     (ssget->vla-list
                       (ssget "x"
                              (list (cons 8 (vla-get-name each)))
                       )
                     )
         (vl-deleteobject item)
       )
       (vl-deleteobject each)
      )
    )
  )
)
;;; This function converts a valid ACAD selction                         ;
;;; set to a list of vla-objects.                                        ;
;;;                                                                      ;
;;; Arguments: selection-list = a valid ACAD selection set               ;
;;;                             returned by ssget.                       ;
;;;                                                                      ;
;;; Returned Value:  A list of all circles as vla-objects                ;
;;;        such as:  (#<VLA-OBJECT IAcadCircle 01b4211c>                 ;
;;;                   #<VLA-OBJECT IAcadCircle 01b42790>                 ;
;;;                   #<VLA-OBJECT IAcadCircle 01b429a0>)                ;
;;;                                                                      ;
;;;Usage: (ssget->vla-list (ssget))                                      ;
(defun ssget->vla-list (selection-set / index vla-list)
  (setq index (if selection-set
                (1- (sslength selection-set))
                -1
              )
  )
  (while (>= index 0)
    (setq vla-list
                   (cons
                     (vlax-ename->vla-object
                       (ssname selection-set index)
                     )
                     vla-list
                   )
          index    (1- index)
    )
  )
  vla-list
)
(defun vl-deleteobject (name)
  (cond
    ((and
       (not (vlax-erased-p name))
       (vlax-read-enabled-p name)
       (vlax-write-enabled-p name)
     )
     (vlax-invoke-method name 'delete)
     (if (not (vlax-object-released-p name))
       (vlax-release-object name)
     )
    )
    (t (princ "\n** Cannot delete object! **"))
  )
)
[/php]

wdz0409

怎么用不了呢？

陌生人

呵呵，是个危险的操作

自由的鱼

危险的操作？