LISP to purge Property set definitions out of ACA

[bogdan.dico]

Hello,

I hope there is not another topic of this, I really tried to find one.

The problem is the following. We have a project, with all files in it having the "Automatically attach property set definitions" box checked.

That together with Manufacturer Property set, that applies to all elements and working with a lot of xrefs generated hundreds of manufaturer property set definitions in each file (with $$ signs).

Long story short, all dwg's have a lot of property set definitions we don't need and that make the files close to impossible to use.

Is there a lisp command or a batch purge that can forcefully and automatically delete all property set definitions containing the name "Manufacturer" or "$$"? The method described by autodesk works but it takes about 2 min per property set and we need to delete thousands if not more.

I'm attaching an example of the mess we're in.

Thank you in advance!!!

[dbroad]

That's quite a mess.  No promises but try this.  Might pause for a while but should do the job.  I don't know how much if any you will lose however as you merge the property sets.  Test it on the drawing you attached first.

;;Remove excess manufacturerstyles
;;D. C. Broad, Jr.
;;9/1/2015
(defun c:psdmrg	(/ psd pair psdkeep)
  (setq
    psdkeep (getstring
	      "Propertyset definition to keep: <ManufacturerStyles>"
	      t
	    )
  )
  (setq	psdkeep	(cond ((= "" psdkeep) "ManufacturerStyles")
		      (t psdkeep)
		)
  )
  (setq psd (dictsearch (namedobjdict) "AEC_PROPERTY_SET_DEFS"))
  (while (setq pair (assoc 3 psd))
    (if	(and (/= (cdr pair) psdkeep)
	     (wcmatch (cdr pair) (strcat "*" psdkeep "*"))
	)
      (command "_PROPERTYSETDEFMERGE"
	       psdkeep	;keep name
	       (cdr pair)		;merge name
	       "Yes"			;purge?
	       "Yes"	       ;;purge dependent?
      )
    )
    (setq psd (cdr (member pair psd)))
  )
  (command "_propertysetclean" "")
  (princ)
)