请问怎么批量新建组过滤器

flydyt

图层比较多，可以分很多种类，想用程序批量新建一些组过滤器来管理图层。请问谁有代码提供一下，谢谢

qqqincccken

谢谢提出来,大家来学习学习

marting

平时用的还真不多，下面是移除层过滤器的代码

(defun c:RemoveLayerFilters
       (/ acDoc modelSpace extDict acLayer layerTable xRec)
  (setq save-cmdecho (getvar "CMDECHO"))
  (setvar "CMDECHO" 0)
  (command "._undo" "begin")
  (setq
    acDoc (vlax-get-property (vlax-get-acad-object) 'ActiveDocument)
  )
  (setq layerTable (vlax-get-property acDoc 'Layers))
  (setq extDict (vlax-invoke-method layerTable 'GetExtensionDictionary))
  (if (/= (type        (setq layerFilters
                       (vl-catch-all-apply
                         'vlax-invoke-method
                         (list extDict 'Item "ACAD_LAYERFILTERS")
                       )
                )
          )
          'VL-CATCH-ALL-APPLY-ERROR
      )
    (vl-catch-all-apply
      'vla-Remove
      (list extDict "ACAD_LAYERFILTERS")
    )
  )
  (if (> (atof (getvar "ACADVER")) 16.0)

    (if        (/= (type (setq        layerFilters
                         (vl-catch-all-apply
                           'vlax-invoke-method
                           (list extDict 'Item "ACLYDICTIONARY")
                         )
                  )
            )
            'VL-CATCH-ALL-APPLY-ERROR
        )
      (vl-catch-all-apply
        'vla-Remove
        (list extDict "ACLYDICTIONARY")
      )


    )
  )
  (command "._undo" "end")
  (setvar "CMDECHO" 1)
  (princ)
)
(defun c:RLF () (c:RemoveLayerFilters))
(princ)

marting

(defun c:DeleteLayerPropertyFilters
       (/ ActiveDocument cnt lyrdct lyrfltdct x1 x2)
  (vl-load-com)
  (setq Acad-Object (vlax-get-Acad-Object))
  (setq ActiveDocument (vlax-get Acad-Object 'ActiveDocument))
  (vla-StartUndoMark ActiveDocument)
  (setq        lyrfltdct
         (vl-catch-all-apply
           '(lambda ()
              (vla-GetObject
                (vla-GetExtensionDictionary
                  (vla-Get-Layers ActiveDocument)
                )
                "ACAD_LAYERFILTERS"
              )
            )
         )
  )
  (setq        lyrdct (vl-catch-all-apply
                 'vla-item
                 (list
                   (vla-GetExtensionDictionary
                     (vla-Get-Layers ActiveDocument)
                   )
                   "AcLyDictionary"
                 )
               )
  )
  (if (not (vl-catch-all-error-p lyrdct))
    (progn
      (setq cnt 0)
      (vlax-for        flt lyrdct
        (vla-GetXRecordData flt 'x1 'x2)
        (setq x1 (vlax-safearray->list x1)
              x2 (vlax-safearray->list x2)
              x2 (if (= (car x1) 290)
                   (cdr x2)
                   x2
                 )
              x2 (mapcar 'vlax-variant-value x2)
        )
        (cond ((eq (car x2) "AcLyLayerFilter")
               (setq cnt (1+ cnt))
               (vla-Delete flt)
               (vl-catch-all-apply
                 '(lambda () (vla-Remove lyrfltdct (caddr x2)))
               )
              )
              ((eq (car x2) "AcLyLayerGroup"))
        )
      )
    )
  )
  (if (or (not cnt) (= cnt 0))
    (prompt "\nNo layer filters were found. ")
    (prompt
      (strcat "\n"
              (itoa cnt)
              " layer property filters have been deleted."
      )
    )
  )
  (vla-Update Acad-Object)
  (vla-EndUndoMark ActiveDocument)
  (princ)
)

marting

获取

(defun jb:GetAcadLayerFilterDictionary (/ lext-dict ldict)
  (setq        lext-dict
         (entget
           (vlax-vla-object->ename
             (vla-GetExtensionDictionary
               (vla-get-layers
                 (vla-get-ActiveDocument
                   (vlax-get-acad-object)
                 )
               )
             )
           )
         )
  )
  (if (setq ldict (member (cons 3 "ACAD_LAYERFILTERS") lext-dict))
    (cdr (assoc 360 ldict))
    nil
  )
)

marting

创建

(vl-load-com)
(defun C:test (/ n lst lfname)
(setq lfname (getstring t "\nEnter filter name:  " ))
(vlax-map-collection (vla-get-layers (vla-get-activedocument (vlax-get-acad-object)))
  (function (lambda (x) 
      (if 
        (and
           (wcmatch (setq n (strcase (vla-get-name x))) "M-*")
           (not (wcmatch n "*|*"))
        )
        (setq lst (cons n lst))
      )))
)
(command "-layer" "_filter" "n" "g" "" "" lfname "")
(mapcar (function (lambda (x) (command "-layer" "_filter" "e" lfname "a" x "x" ""))) lst) 
(princ)
)