I'm working up a routine to simplify clearing some space. I've been cruising here and other places piecing together something, but what I have ended up with is a routine that deletes all of the intended information (possibly needing repetition for those hard-to-reach blocks), but also deletes dimensions from the model space.
There are several things our company does which are "non-standard" but we have been at it for a while and I am trying to work with what I was given. Following is the code. If anyone has an idea why it would be grabbing dimensions and how I could make it stop, I would appreciate it.
;;; not sure who Jeff M is, but assuming this bit is from him (defun odbx-test (/ dbx_doc) ;; edited 5/28/06 by Jeff M (if (< (setq dbxver (atof (getvar "ACADVER"))) 15.06) (progn (alert "ObjectDBX method not applicable\nin this AutoCAD version" ) (exit) (princ) (gc) ) (progn (if (= (atoi (getvar "ACADVER")) 15) (progn (if (not (vl-registry-read "HKEY_CLASSES_ROOT\\ObjectDBX.AxDbDocument\\CLSID" ) ) (startapp "regsvr32.exe" (strcat "/s \"" (findfile "axdb15.dll") "\"") ) ) (setq dbx_doc (vla-getinterfaceobject (vlax-get-acad-object) "ObjectDBX.AxDbDocument" ) ) ) (setq dbx_doc (vla-getinterfaceobject (vlax-get-acad-object) (strcat "ObjectDBX.AxDbDocument." (itoa (fix dbxver)) ) ) ) ) ) ) ) ;;; Following bit is compiled from a few places. I know it's messy.
;;; I'll clean it after it works and give better credits (defun C:PURGEDIR (/ fileNames fileName_doc fname folderObject i myDoc obj result sh ) (vl-load-com) (setq sh (vla-getInterfaceObject (vlax-get-acad-object) "Shell.Application" ) ) (setq Dir (vlax-invoke-method sh 'BrowseForFolder 0 "Browse to the directory you want purged." 512 ; no new folder button "C:\\" ; path start ) ) (vlax-release-object sh) (if Dir (progn (setq folderObject (vlax-get-property Dir 'Self) result (vlax-get-property folderObject 'Path) ) (vlax-release-object Dir) (vlax-release-object folderObject) result ) ) (setq fileNames (vl-directory-files result "*.dwg" 1) filenames (mapcar (function (lambda (x) (strcat result "\\" x) ) ) filenames ) ) (foreach fileName fileNames (if (setq fname (findfile fileName)) (progn (setq fileName_doc (odbx-test)) (vla-Open fileName_doc fname) (repeat 2 (foreach i '("Blocks" ;for some reason the dimensions are being deleted with the Blocks "DimStyles" "Linetypes" "Layers" "TextStyles") (vlax-for Obj (vlax-get fileName_doc i) (if (or (not (vlax-property-available-p Obj 'IsLayout)) (= (vla-get-IsLayout Obj) :vlax-false) ) (vl-catch-all-apply 'vla-Delete (list Obj)) ) ) ) ) (vlax-invoke fileName_doc 'SaveAs fname) (vl-catch-all-apply (function (lambda () (vlax-release-object fileName_doc) ) ) ) (princ (strcat "\n" fname " Purged.")) (setq fileName_doc nil) ) (princ "\nFile not found. It may have been moved or modified." ) ) ) (gc) (princ) )
Solved! Go to Solution.
If anyone has an idea why it would be grabbing dimensions and how I could make it stop, I would appreciate it.
I cant vouch for the rest of the code
(vlax-for Obj (vlax-get fileName_doc i) (if (and (not (Wcmatch (vla-get-name Obj) "`*D*")) (or (not (vlax-property-available-p Obj 'IsLayout)) (= (vla-get-IsLayout Obj) :vlax-false)) ) (vl-catch-all-apply 'vla-Delete (list Obj)) ) )
That was the one. Thanks very much. Yes, the rest of the code needs cleaning, but now at least it does not destroy anything unintended. I bet if I make it cycle differently I can get more of the nested blocks cleared, but it will probably take longer.
Either way, this works wonderfully now. I appreciate it.
Log into access your profile, ask and answer questions, share ideas and more. Haven't signed up yet? Register
Start with some of our most frequented solutions to get help installing your software.