BatchPurge trouble

[youngsoo]

Hi AUGI members!

I have a lisp routine.

http://dwg.ru/forum/viewtopic.php?t=15816&sid=e456dfa4268533939337b257f6ca5148

I have loaded it into 2007 and the error "Automation Error. Problem in loading application"
Sorry! I can't explain enough. I must be study English.
Please modify.

(defun C:BatchPurge ( / cmd n_doc ShellApp Dir dir_lst file_lst folItm UnPrg UnPrgLst Prg lst msg)
(vl-load-com)
(setq cmd (getvar "CMDECHO")
n_doc (vla-getinterfaceobject (vlax-get-acad-object) "ObjectDBX.AxDbDocument.16")
Prg 0 UnPrg 0);setq
(if (and (setq ShellApp (vla-getInterfaceObject (vlax-get-acad-object) "Shell.Application"))
(setq Dir (vlax-invoke-method ShellApp 'BrowseForFolder 0
"Select Direcory to Purge Files in" 0)));and
(progn (setq dir_lst (list Dir))
(vlax-release-object ShellApp) (setq ShellApp nil)
(while dir_lst (setq itms (vlax-invoke-method (car dir_lst) 'Items)
cnt (1- (vla-get-count itms)));setq
(while (< 0 cnt) (setq itm (vla-item itms cnt))
(if (= :vlax-true (vlax-get-property itm 'IsFileSystem))
(cond ((= "AutoCAD Drawing" (vla-get-Type itm))
(setq file_lst (cons (vla-get-Path itm) file_lst)))
((= :vlax-true (vlax-get-property itm 'IsFolder))
(if (setq folItm (vl-catch-all-apply 'vlax-get-property (list itm 'GetFolder)))
(setq dir_lst (cons folItm dir_lst))))));if
(setq cnt (1- cnt)));while
(setq dir_lst (cdr (reverse dir_lst))));while
);progn
file_lst
);if
(foreach dwg file_lst
(vla-open n_doc (findfile dwg))
(if (not (vlax-method-applicable-p n_doc 'PurgeAll))
(progn (setq UnPrg (1+ UnPrg)
UnPrgLst (cons (vla-get-name n_doc) UnPrgLst))
(vla-close n_doc :vlax-false));progn
(progn (repeat 2 (vla-purgeall n_doc))
(vla-close n_doc :vlax-true)
(setq Prg (1+ Prg))));if
);foreach
(while UnPrgLst (setq lst (if lst (strcat lst "\n" (car UnPrgLst)) (car UnPrgLst))
UnPrgLst (cdr UnPrgLst)));while
(setq msg1 (if (= Prg 0) "No Purged Files"
(strcat "Congratulations! Purge Completed.\n" (itoa Prg) "Files Purged"))
msg2 (strcat (itoa UnPrg) " Files Not Purged: \n" lst));setq
(alert (strcat msg1 msg2))
);end

[fixo]

Try this instead
This will purge just in parent folder
Do not run it in the same folder where you works


(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))
)
)
)
)
)
)
)


(defun c:bpu (/ fn fname fold full_name_list other_doc)
(vl-load-com)
(setq fn (getfiled "** Select ANY file in this folder to purge all **"
""
"dwg"
4
)
fold (vl-filename-directory fn)
full_name_list (vl-directory-files fold "*.dwg" 1)
full_name_list (mapcar (function (lambda (x)
(strcat fold "\\" x)
)
)
full_name_list
)
)
(foreach other full_name_list
(if
(setq fname (findfile other))
(progn
(setq other_doc (odbx-test))
(vla-open other_doc fname)
(vl-catch-all-apply
(function (lambda ()
(repeat 3
(vla-purgeall other_doc)
)
)
)
)
(vlax-invoke other_doc 'SaveAs fname)
(vl-catch-all-apply
(function (lambda ()
(vlax-release-object other_doc)
)
)
)
(setq other_doc nil)
)
(princ "\File Not Found")
)
)

(gc)
(princ)
)
(princ "\n===========================\n")
(princ "\n Type BPU to execute ")
(princ "\n===========================\n")
(princ)

[youngsoo]

http://youngsoo.keochang.net/8xmas/8xmas5.htm

Thank you very much.
Have a nice day all AUGI members!

This program is fantastic and very powerful.
But I can't fully understand the program.

Because it's level is higher than me.
Could you add the (command "zoom" "extents") function?

I want to see the result of the program.

Thank and best regards.

[mkolomiyets]

I've just looked over the code posted by 'fixo' and I think it won't work since the oDBX does not have such method as 'vla-purgeall'.

[fixo]

Agreed, ObjectDBX haven't methods linked
with screen coordinates, say Selectionset,
Zoomming etc

~'J'~

[mkolomiyets]

I've tried to delete layers, blocks, etc.(which is actually the same as purge), using catch errors when it's referenced. It works but it executes pretty much slow. I think the best way is to use the trick. When running 'publish' command in autocad we can notice that it opens second instance of autocad(open task manager in the system while the 'publish' is running and watch "Processes' tab - you will see two(2) 'acad.exe').
So, based on that idea, we can open files in the second instance of autocad (running of course in the background - invisible) and perforrm "purge all" procedure. It will give everybody a feeling like it's done remotely.
Any ideas?

[fixo]

I agree with you
Here is what will get you started, just
do not run it from the same folder
Add in process the code you need:


(defun C:ZALL (/ acapp dwg curr_name docs dwgs i fold this)
(vl-load-com)
(setvar "sdi" 0)
(setq dwg (getfiled (strcat "Select the first DWG file in folder "
"to be processed")
""
"DWG"
0))
(setq fold (strcat (vl-filename-directory dwg) "\\")
dwgs (vl-directory-files fold "*.dwg")
dwgs (mapcar (function (lambda (x)
(strcat fold x)))
dwgs)
)
(setq this (vla-get-activedocument (vlax-get-acad-object))
curr_name (vla-get-fullname this)
)
(setq acapp (vlax-create-object "autocad.application")
docs (vla-get-documents acapp)
)
(vlax-put-property acapp "Visible" :vlax-true)
(vla-put-windowstate acapp acmax)
(setvar "filedia" 0)
(setvar "xloadctl" 0)
(setvar "demandload" 0)
(setvar "qaflags" 31)
(setq i 0)

(foreach each dwgs
(if (not (eq each curr_name))
(progn
(setvar "cmdecho" 0)
(vlax-invoke-method docs "Open" each)
(setq cur_doc (vla-get-activedocument acapp))
(princ "\nOpen")
;; << do your another things here >>
(vla-Zoomextents (vla-get-application cur_doc))
(princ "\nZoom")
(vla-regen cur_doc acallviewports)
(princ "\nRegen")

(vlax-invoke-method cur_doc "Save")
(vlax-invoke-method cur_doc "Close")
(setq i (1+ i))
(setvar "cmdecho" 1)))
)

(vla-quit acapp)

(vlax-release-object docs)
(vlax-release-object acapp)
(setq docs nil
acapp nil)
(gc)
(gc)
(setvar "filedia" 1)
(setvar "qaflags" 0)
(setvar "xloadctl" 1)
(setvar "demandload" 3)
(princ (strcat "\nProcessed " (itoa i) " drawings."))
)
(princ "\n *** Programm loaded. Start with ZALL to run. ***")
(princ)


~'J'~

Slightly tested on A2008eng, ADT 2007 (by my friend)
Reset variables to your suit

~'J'~

[mkolom]

That works nice. I am wondering what does the QAFLAGS 31 mean? Do you have all bits for that variable. As far as I know it's known 0(1), 1(2), 2(4), 4(16), and 7(128). Would you share them with us?
Thank you!

[fixo]

Sorry, I don't know the bit flags of this variable
Just grabbed this value from other routine I've found
somewhere on this forum, don't remember exactly

~'J'~

[RobertB]

The undocumented QAFlags is "documented" here (http://www.manusoft.com/Resources/AcadExposed/Main.stm). So I'm not sure 31 is really a valid value.

[fixo]

Thanks for info
Cheers

~'J'~