TheSwamp
Code Red => AutoLISP (Vanilla / Visual) => Topic started by: ronjonp on November 08, 2005, 02:31:18 PM
-
So....how can I incoporate a filter so this lisp will delete all layer filters except the ones I specify?
Something like: (not (wcmatch (strcase name-of-filter) (strcase "lala*")))
(vl-Catch-All-Apply
'(lambda ()
(vla-Remove
(vla-GetExtensionDictionary
(vla-Get-Layers
(vla-Get-ActiveDocument
(vlax-Get-Acad-Object)
)
)
)
"AcLyDictionary"
)
)
)
Thanks,
Ron
-
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?
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
-
Try this:
;; 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)
)
)
)
)
-
Please be aware that if you invoke vla-GetExtensionDictionary on an object that does not have an extension dictionary it adds one.
-
:|
I thought that was why we had the 'vlax-get-or-create' function?
-
Here's one that R. Robert Bell has posted numerous times on the Adesk forums.
;|
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
-
Thanks guys.
-
Will,
Excuse my ignorance, but how do I use the lst part of your lisp to create my filter?
Thanks,
Ron
-
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"))
(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?
-
So this does not accept wildcards....just exact matches?
-
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.
-
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?
(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
-
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
-
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.
(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
-
possibly 'cause your Dictionary doesn't have an "AcLyDictionary" item.
Do you have a layer filter group set/active ?
-
Off topic, but ... if you invoke the vla-GetExtensionDictionary method on an entity / object that does not have an extension dictionary said method will add one -- undesirable behavior in most situations. In these situtations it is better to test and conditionally retrieve the extension dictionary --
i.e.
(if (eq :vlax-true (vla-get-HasExtensionDictionary object))
(progn
(setq xdict (vla-GetExtensionDictionary object))
...
)
)
We now return you to your regularly scheduled discussion ...
:)
-
and not trying to tag team you ..
Using something like this is a little safer than just using (vla-item obj index)
;;;------------------------------------------------------------------
;;;------------------------------------------------------------------
;;;
(defun k:AssertItem (collection item / returnvalue)
(if
(not (vl-catch-all-error-p
(setq returnvalue (vl-catch-all-apply 'vla-item (list collection item)))
)
)
returnvalue
)
)
-
Thank guys...my brain hurts now. :-)
-
Relatively simple < the routine, not "Hurting your head" ;) >
Just replace the call to vla-item with k:AssertItem using the same parameters.
The routine will return either the Object related to 'item' or NIL.
.. bypassing the possible dummy-spit in the instance where the 'item' translation errors out.
added:
This could , of course, be written in line each time ... but I type slowly, so ...