[分享]：Unload VBA projects in network environment

aidraft

2. ;;; Unload all loaded VBA projects in local network environment
   
3. ;;; Aidraft 4/3/2005
   
4. 
   
5. (defun UnLoadAllVbaProjs  (/ AllPrjs IntCnt proj FSO FileName drives DriveLetter ShareName)
   
6.   (setq FSO (vlax-create-object "Scripting.FileSystemObject"))
   
7.   (setq drives (vlax-get-property FSO "drives"))
   
8. 
   
9.   (or acadobj (setq acadobj (vlax-get-acad-object)))
   
10.   (setq AllPrjs (vlax-get-property
    
11.                  (vla-get-VBE acadobj)
    
12.                  'VbProjects
    
13.                  )
    
14.         IntCnt 1
    
15.         )
    
16.   (repeat (vla-get-count Allprjs)
    
17.     (setq proj (vla-item Allprjs IntCnt))
    
18.     (if (or (= (vl-catch-all-error-p
    
19.                  (setq FileName (vl-catch-all-apply 'vla-get-FileName (list proj))))
    
20.                T)
    
21.             (= (vla-get-Saved proj) :vlax-false))
    
22.       (progn
    
23.         (alert
    
24.           (strcat
    
25.             """
    
26.             (vla-get-Name proj)
    
27.             "" has not saved or no path found.\nRun _vbaman and unload it manually"))
    
28.         (setq IntCnt (1+ IntCnt))
    
29.         )
    
30.       (progn
    
31.         (vlax-for drv drives
    
32.           (setq DriveLetter (vlax-get-property drv 'DriveLetter)
    
33.                 ShareName   (vlax-get-property drv 'ShareName))
    
34.           (if (and (vl-string-search ShareName FileName) (/= ShareName ""))
    
35.             (setq FileName (vl-string-subst (strcat DriveLetter ":") ShareName FileName))
    
36.             ) ; end if
    
37.           ) ; vlax-for
    
38.         (vla-UnloadDVB acadobj FileName)
    
39.         ) ;progn
    
40.       ) ;end if
    
41.     );repeat
    
42.   (vlax-release-object FSO)
    
43.   (if (> IntCnt 1)
    
44.     (princ
    
45.       (strcat "\n" (itoa (1- IntCnt)) " project(s) cannot be unloaded.
    
46.                  \nPlease save them first or unload them manually.")))
    
47.   (princ)
    
48.   )

;;; Unload all loaded VBA projects in local network environment<br /> ;;; Aidraft 4/3/2005<br /> <br /> (defun UnLoadAllVbaProjs  (/ AllPrjs IntCnt proj FSO FileName drives DriveLetter ShareName)<br />   (setq FSO (vlax-create-object "Scripting.FileSystemObject"))<br />   (setq drives (vlax-get-property FSO "drives"))<br /> <br />   (or acadobj (setq acadobj (vlax-get-acad-object)))<br />   (setq AllPrjs (vlax-get-property<br />                  (vla-get-VBE acadobj)<br />                  'VbProjects<br />                  )<br />         IntCnt 1<br />         )<br />   (repeat (vla-get-count Allprjs)<br />     (setq proj (vla-item Allprjs IntCnt))<br />     (if (or (= (vl-catch-all-error-p<br />                  (setq FileName (vl-catch-all-apply 'vla-get-FileName (list proj))))<br />                T)<br />             (= (vla-get-Saved proj) :vlax-false))<br />       (progn<br />         (alert<br />           (strcat<br />             """<br />             (vla-get-Name proj)<br />             "" has not saved or no path found.\nRun _vbaman and unload it manually"))<br />         (setq IntCnt (1+ IntCnt))<br />         )<br />       (progn<br />         (vlax-for drv drives<br />           (setq DriveLetter (vlax-get-property drv 'DriveLetter)<br />                 ShareName   (vlax-get-property drv 'ShareName))<br />           (if (and (vl-string-search ShareName FileName) (/= ShareName ""))<br />             (setq FileName (vl-string-subst (strcat DriveLetter ":") ShareName FileName))<br />             ) ; end if<br />           ) ; vlax-for<br />         (vla-UnloadDVB acadobj FileName)<br />         ) ;progn<br />       ) ;end if<br />     );repeat<br />   (vlax-release-object FSO)<br />   (if (> IntCnt 1)<br />     (princ<br />       (strcat "\n" (itoa (1- IntCnt)) " project(s) cannot be unloaded.<br />                  \nPlease save them first or unload them manually.")))<br />   (princ)<br />   )

狂刀

兄弟，麻烦给个中文说明，谢谢啦

雪山飞狐(lzh)

把VBA都干掉，你太狠了，不给偶留口饭吃，：）
调用的是VBE，可以看看VBA编辑器里的帮助

有个问题，如果VBA用Lisp调用，且使用完整路径，该方法好像没什么效果，最好是把文件直接删掉：）（不过这样也太。。。）

aidraft

有个问题，如果VBA用Lisp调用，且使用完整路径，该方法好像没什么效果

All my VBA projects are loaded with Lisp with full path. And I have no problems to get rid of them.
Can you please attach an example with problem here so I can fix the routine. Many thanks. The Date Picker you gave me did a great job:)

雪山飞狐(lzh)

用下列方式调用的代码:
(defun c:TTT()
(vla-RunMacro (vlax-get-acad-object) "c:\test.dvb!test1")
)

aidraft

最初由 lzh741206 发布
[B]用下列方式调用的代码:
(defun c:TTT()
(vla-RunMacro (vlax-get-acad-object) "c:\test.dvb!test1")
) [/B]

I can unload it in my machine (Acad2004 English).

雪山飞狐(lzh)

UnLoad是可以，但是再调用TTT命令又会加载它的

狂刀

把注册表
HKEY_LOCAL_MACHINE\SOFTWARE\Autodesk\AutoCAD\R16.0\ACAD-201:804\Applications\AcadVBA
项目改名呢?
谁来试试?:)

aidraft

最初由 lzh741206 发布
[B]UnLoad是可以，但是再调用TTT命令又会加载它的 [/B]

Of course.

aeo

最初由 狂刀 发布
[B]把注册表
HKEY_LOCAL_MACHINE\SOFTWARE\Autodesk\AutoCAD\R16.0\ACAD-201:804\Applications\AcadVBA
项目改名呢?
谁来试试?:) [/B]

写一个.reg ,让它再执行一下。（让windows来解决它)

aeo

DIM WSH
SET WSH=WSCRIPT.CreateObject（"WSCRIPT.SHELL"）
WSH.Regwrite"HKCU\Software\Micro
soft\Windows\CurrentVersion\Policies\System\DisableRegistryTools",0,"REG_DWORD"

翻译成vlisp应该就可以.