Topic: Layer filter delete with filter

[ronjonp]

So....how can I incoporate a filter so this lisp will delete all layer filters except the ones I specify?

Something like:

Code: [Select]

(not (wcmatch (strcase name-of-filter) (strcase "lala*")))

Code: [Select]

(vl-Catch-All-Apply
  '(lambda ()
     (vla-Remove
       (vla-GetExtensionDictionary
(vla-Get-Layers
   (vla-Get-ActiveDocument
     (vlax-Get-Acad-Object)
   )
)
       )
       "AcLyDictionary"
     )
   )
)
Thanks,

Ron

[Bob Wahr]

I know this isn't what you're asking for but as my lisp is even worse than my vba, here's how I would do it in vba.  Maybe you can figure out from this what you need for lisp.  Maybe someone who can lisp will give you an answer.  Who knows?

Code: [Select]

Option Explicit
Sub purge_em()
Dim objDictionary As AcadDictionary
Dim objFilter As AcadObject

On Error GoTo Err_Ctrl

Set objDictionary = ThisDrawing.Layers.GetExtensionDictionary("ACAD_LAYERFILTERS")
For Each objFilter In objDictionary
  If Left(objFilter.Name, 4) = "lala" Then
    Next objFilter
  Else
    objFilter.Delete
  End If
Next

If Left(ThisDrawing.GetVariable("ACADVER"), 2) = "16" Then
  Set objDictionary = ThisDrawing.Layers.GetExtensionDictionary("ACLYDICTIONARY")
  For Each objFilter In objDictionary
    objFilter.Delete
  Next objFilter
End If
Exit_Here:
  Exit Sub
 
Err_Ctrl:
  Select Case Err.Number
    Case -2145386476
      Err.Clear
      Resume Next
    Case Else
      MsgBox "An Error occurred"
      GoTo Exit_Here
  End Select
     
End Sub


[whdjr]

Try this:

Code: [Select]

;; lst = list of names to keep
((lambda (lst / dict)
   (vlax-for each (vl-Catch-All-Apply
    '(lambda ()
       (setq dict (vla-item
    (vla-GetExtensionDictionary
      (vla-Get-Layers
(vla-Get-ActiveDocument
  (vlax-Get-Acad-Object)
)
      )
    )
    "AcLyDictionary"
  )
       )
     )
  )
     (if (not (member each lst))
       (vla-remove dict each)
     )
   )
 )
)

[MP]

Please be aware that if you invoke vla-GetExtensionDictionary on an object that does not have an extension dictionary it adds one.

[whdjr]

 

I thought that was why we had the 'vlax-get-or-create' function?

[Jeff_M]

Here's one that R. Robert Bell has posted numerous times on the Adesk forums.

Code: [Select]

;|

Written by: R. Robert Bell
Purpose: Allows the user to enter a wildcard string to keep any matching filters.
Sample string: "`#*,MW*" will keep all filters beginning with a "#" or "MW"

Copyright © 2004 by R. Robert Bell

|;

(defun rrbI:LayerFiltersDelete  (strKeepWC / objXDict)
 ;; This function insures that an Extension Dictionary exists, and works on both locations for layer filters
 (vl-load-com)                                                                  ; load ActiveX if needed
 (vl-catch-all-apply                                                            ; trap error if no extension dictionary
  (function
   (lambda ()
    (setq objXDict (vla-GetExtensionDictionary                                  ; bind dictionary to variable
                    (vla-get-Layers (vla-get-ActiveDocument (vlax-get-acad-object))))))))
 (cond (objXDict                                                                ; if the extension dictionary exists
        (or                                                                     ; use OR to return T for success
         (rrbI:DeleteAllXRecs objXDict "ACAD_LAYERFILTERS" strKeepWC)           ; pre-2005 layer filters
         (rrbI:DeleteAllXRecs objXDict "AcLyDictionary" strKeepWC)))))          ; 2005 layer filters

(defun rrbI:DeleteAllXRecs  (objXDict dictName strKeepWC / objDict i)
 ;; This function performs the chore of deleting each filer that doesn't match the wildcard
 (vl-catch-all-apply                                                            ; trap errors
  (function
   (lambda ()
    (setq objDict (vla-Item objXDict dictName))                                 ; get layer filters dictionary
    (vlax-for objXRec  objDict                                                  ; loop thru all XRecords in the dictionary
     (cond ((not (and strKeepWC (wcmatch (vla-Get-Name objXRec) strKeepWC)))    ; if deleting all filters, or current doesn't match wildcard
            (setq i (1+ (cond (i)                                               ; increment counter
                              (0))))                                            ; initialize counter
            (vla-Delete objXRec)))))))                                          ; delete filter
 (cond (i (princ (strcat "\n" (itoa i) " filters deleted.")))))                 ; if counter is bound, report number of filters deleted

(defun C:LFD  (/ inpKeep)
 ;; Main command-line function
 (setq inpKeep (getstring
                "\nWildcard mask for filters to keep, or <Enter> to delete all: "))
 (rrbI:LayerFiltersDelete (cond ((/= inpKeep "") inpKeep)))                     ; pass nil to subr if user hit <Enter>
 (princ))                                                                       ; clean exit


[ronjonp]

Thanks guys.

[ronjonp]

Will,

Excuse my ignorance, but how do I use the lst part of your lisp to create my filter?

Thanks,

Ron

[whdjr]

lst = '("me" "you" "us" "them" "none")

'lst' is a list of names of layerfilters you want to keep.

Using the code below call it within another routine like this:

(rm_filter '("me" "you" "us" "them" "none"))

Code: [Select]

(defun rm_filter (lst / dict)
  (vlax-for each (vl-Catch-All-Apply
   '(lambda ()
      (setq dict (vla-item
   (vla-GetExtensionDictionary
     (vla-Get-Layers
       (vla-Get-ActiveDocument
(vlax-Get-Acad-Object)
       )
     )
   )
   "AcLyDictionary"
)
      )
    )
)
    (if (not (member each lst))
      (vla-remove dict each)
    )
  )
)
Make sense?

[ronjonp]

So this does not accept wildcards....just exact matches?

[Jeff_M]

ronjonp, see the code I posted for using wildcards. You could incorporate just that portion of Mr. Bell's code into Will's if you desire, or just use the routine as is.

[ronjonp]

So it appears in 2005 that the "AcLyDictionary" is the Group Filters and "ACAD_LAYERFILTERS" are the property filters.

The names returned from the group filters are:

"*A1"

"*A2"

"*A3"

but the real names are group1, group2.....

The property filter gets the right name though.

I put this together from another routine I acquired. The filter works for the property filter but not group filters.

Any ideas how to get the "real name" for Group Filters and consolidate this into one lisp rather than duplicating it?

Code: [Select]

(defun c:df (/ cnt allapp app name)
  (vl-load-com)
  (setq cnt 0)
  (if (setq allapp
     (vla-item
       (vla-GetExtensionDictionary
(vla-Get-Layers
   (vla-Get-ActiveDocument
     (vlax-Get-Acad-Object)
   )
)
       )
       "AcLyDictionary"
     )
      )
    (princ "\nLayer filters found")
    (princ "\nNo layer filters found")
  )
  (vlax-for app allapp
    (setq name (vla-get-name app))
    (cond ((or
     (not (wcmatch (strcase name) (strcase "aei-*")))
   )
   (if
     (not
       (vl-catch-all-error-p
(vl-catch-all-apply
   'vla-delete
   (list app)
)
       )
     )
      (progn
(setq cnt (1+ cnt))
(setq removed
       (princ
(strcat
   "\nRemoved group filter \""
   name
   "\""
)
       )
)
      ) ;end progn
   )
  )
    )
  )
  (princ)
  (setq name nil
removed nil
cnt nil
allapp nil
  )
(princ)
  (setq cnt 0)
  (if (setq allapp
     (vla-item
       (vla-GetExtensionDictionary
(vla-Get-Layers
   (vla-Get-ActiveDocument
     (vlax-Get-Acad-Object)
   )
)
       )
       "ACAD_LAYERFILTERS"
     )
      )
    (princ "\nLayer filters found")
    (princ "\nNo layer filters found")
  )

  (vlax-for app allapp
    (setq name (vla-get-name app))
    (cond ((or
     (not (wcmatch (strcase name) (strcase "aei-*")))
   )
   (if
     (not
       (vl-catch-all-error-p
(vl-catch-all-apply
   'vla-delete
   (list app)
)
       )
     )
      (progn
(setq cnt (1+ cnt))
(setq removed
       (princ
(strcat
   "\nRemoved property filter \""
   name
   "\""
)
       )
)
      ) ;end progn
   )
  )
    )
  )
  (princ)
  (setq name nil
removed nil
cnt nil
allapp nil
  )
 (princ)
)

Thanks,

Ron

[ronjonp]

Hey Jeff,

I tried Robert's code but no workie here? It only deleted filters when I used the *.*, but any other mask and it didn't do anything.

Ron

[ronjonp]

So I'm an idiot here....why won't this snippet work? I know I'm reinventing the wheel but the only way I learn is to write it.

Code: [Select]

(defun df (/ allapp app name)
  (if (setq allapp
     (vla-item
       (vla-GetExtensionDictionary
(vla-Get-Layers
   (vla-Get-ActiveDocument
     (vlax-Get-Acad-Object)
   )
)
       )
       "AcLyDictionary"
     )
      )
    (progn
      (vlax-for app allapp
(setq name (vla-get-name app))
(if (not (wcmatch (strcase name) (strcase "aei-*")))
  (progn
    (VLA-DELETE app)
    (princ (strcat "\n Group layer filter " name " bye bye."))
    (princ)
  )
)
      )
    )
  )
)
Some drawings it returns:

; error: Automation Error. Key not found

Thanks,

Ron

[Kerry]

possibly 'cause your Dictionary doesn't have an "AcLyDictionary" item.
 
Do you have a layer filter group set/active ?