VBScript+SCR+NetApi+Accoreconsole 批处理dwg文件

Posted 2022-01-12 nanshengblogs

继上次powershell运行accoreconsole(https://www.cnblogs.com/NanShengBlogs/p/10981687.html)的研究之后又觉得不是很合适，毕竟powershell还存在权限问题，不像vbs这么windows原生的的脚本好用。

脚本主要部分

 

 1 Option Explicit
 2 
 3 Dim acoreFn,fso
 4 
 5 acoreFn=inputbox("输入AutoCAD的版本号","用户输入","2019")
 6 
 7 if int(acoreFn)>=2013 then 
 8 
 9     Set fso = CreateObject("Scripting.FileSystemObject")
10 
11     if fso.FileExists("C:\\Program Files\\Autodesk\\AutoCAD " & acoreFn & "\\accoreconsole.exe") then
12     
13         acoreFn=chr(34) & "C:\\Program Files\\Autodesk\\AutoCAD " & acoreFn & "\\accoreconsole.exe" &chr(34)
14         
15         call AccoreCmdExecute("myScrFile.scr",acoreFn)
16     else
17     
18         msgbox "请确认本机的autocad"& int(acoreFn) & "安装路径为：" & vbNewLine & "C:\\Program Files\\Autodesk\\AutoCAD " & acoreFn & "",vbError+vbOKOnly
19         
20     end if
21     
22 else
23     msgbox "Accoreconsole.exe 程序从AutoCAD2013 开始支持！",vbError+vbOKOnly
24     
25 end if
26 
27 set fso=nothing
28 
29 public sub AccoreCmdExecute(scrFileName,accoreconsoleFileName)
30 
31     Dim objFSO,curFdName,fl,fd,WshShell,scrFile,args
32 
33     Set objFSO = CreateObject("Scripting.FileSystemObject")
34 
35     curFdName = objFSO.GetFile(WScript.ScriptFullName).ParentFolder
36 
37     scrFile=" /s " & chr(34) & curFdName & "\\" & scrFileName & chr(34)
38     
39     set fd=objFSO.GetFolder(curFdName)
40     
41         
42     Set WshShell=Wscript.CreateObject("Wscript.Shell")
43     
44     for each fl in fd.Files
45 
46         if LCase(objFSO.GetExtensionName(fl))="dwg" then
47             
48             if (objFSO.getfile(fl).Attributes and 1) or CheckFileInuse(fl)=true then 
49             
50                 msgbox fl.name & "是只读文件或者被打开,无法执行脚本命！"
51             else
52                 args=" /i " & chr(34) & curFdName& "\\" & fl.name & chr(34)
53             
54                 WshShell.run accoreconsoleFileName & args & scrFile,0,false
55             
56                 msgbox fl.name & "执行完成!"
57                 
58             end if
59 
60         end if
61     next
62 
63     set fd=nothing
64     set objFSO=nothing
65     set WshShell=nothing
66 
67 end sub
68 
69 public function CheckFileInuse(fn)
70 
71     dim fso,fl
72     
73     Set fso = CreateObject("Scripting.FileSystemObject")
74     
75     Set fl = fso.GetFile(fn)
76     
77     ON ERROR RESUME NEXT
78     
79     fl.move fl.path
80     
81     if Err=70 then 
82     
83         CheckFileInuse=true
84     else 
85         CheckFileInuse=false
86     end if
87 
88     Set fso =nothing
89     
90     Set fl = nothing
91     
92 end function

View Code

 执行命令的部分

 检查文件名是否被打开。