AutoCAD C# 二次開發項目----批量替換塊（5）

3. vbs捏合所有，實作一鍵替換

一般來說，accoreconsole.exe位于AutoCAD的安裝目錄，因為本工具有可能會給不同的人員使用，有可能有的人使用AutoCAD2016，有的人使用AutoCAD2018，這樣一來，即使預設AutoCAD都安裝在C槽，路徑也會不一樣，是以，首先用vbs彈出一個輸入框，由使用這輸入AutoCAD版本，以友善找到accoreconsole.exe.

另外，為了確定BatchCAD.scr不被其他人修改，我用vbs自動生成一個BatchCAD.scr.

然後，此vbs調用accoreconsole.exe完成與其在同一目錄下的所有dwg檔案中的塊替換。

我把這個vbs檔案命名為SmartTool.vbs, 此檔案和之前生成的CADSmart.dll / StandardBlock.dwg / 以及待替換的所有其他dwg檔案放到一個檔案夾内，這樣的話，輕按兩下SmartTool.vbs，将會首先彈出輸入AutoCAD版本的輸入框（預設AutoCAD安裝在C槽）。如下圖：

輸入正确的版本後，點選确定，等待直到出現All Done提示框，完成所有圖紙中塊的替換。

整個vbs代碼如下：

Option Explicit

Dim acoreFn,fso

acoreFn=inputbox("Please Enter the Version of AutoCAD What You Have Installed In Your PC","SmartTool","2016")

if int(acoreFn)>=2013 then

    Set fso = CreateObject("Scripting.FileSystemObject")

    if fso.FileExists("C:\Program Files\Autodesk\AutoCAD " & acoreFn & "\accoreconsole.exe") then

        acoreFn=chr(34) & "C:\Program Files\Autodesk\AutoCAD " & acoreFn & "\accoreconsole.exe" &chr(34)
        call ChangeSCR()
        call AccoreCmdExecute("BatchCAD.scr",acoreFn)
    else

        msgbox "Please confirm the AutoCAD" & int(acoreFn) & " must be installed on: " & vbNewLine & "C:\Program Files\Autodesk\AutoCAD" & acoreFn & "",vbError+vbOKOnly,"SmartTool"

    end if

else
    msgbox "Accoreconsole.exe only support AutoCAD2013 and later version!",vbError+vbOKOnly,"SmartTool"

end if

set fso=nothing

public sub ChangeSCR()
    dim fso,curFdName,myfile
    Set fso = CreateObject("scripting.filesystemobject")
    curFdName =fso.GetFile(WScript.ScriptFullName).ParentFolder
    Set myfile=fso.CreateTextFile( curFdName &"\BatchCAD.scr",true)
    myfile.writeline("ISAVEBAK 0")
    myfile.writeline("cmdecho 0")
    myfile.writeline("SECURELOAD")
    myfile.writeline("0")
    myfile.writeline("netload")
    myfile.writeline("""" & curFdName & "\CADSmart.dll" & """")
    myfile.writeline("SmartReplaceBlock")
    myfile.writeline("qsave")
    myfile.Close
    set myfile=nothing
    set fso=nothing
end sub

public sub AccoreCmdExecute(scrFileName,accoreconsoleFileName)

    Dim objFSO,curFdName,fl,fd,WshShell,scrFile,args,res,flName,log

    Set objFSO = CreateObject("Scripting.FileSystemObject")

    curFdName = objFSO.GetFile(WScript.ScriptFullName).ParentFolder

    scrFile=" /s " & chr(34) & curFdName & "\" & scrFileName & chr(34)

    set fd=objFSO.GetFolder(curFdName)
    '寫入日志檔案
    set log=fso.CreateTextFile( curFdName &"\log.txt",true)
    set WshShell=Wscript.CreateObject("Wscript.Shell")  
    for each fl in fd.files
        if LCase(objFSO.GetExtensionName(fl))="dwg" and fl.Name<>"StandardBlock.dwg"  then
            if (objFSO.getfile(fl).Attributes and 1) or CheckFileInuse(fl)=true then
                msgbox fl.name & "is readonly or can't be open",vbError+vbOKOnly,"COMAU SmartTool"
            else
                args=" /i " & chr(34) & curFdName& "\" & fl.name & chr(34)
                res=WshShell.run(accoreconsoleFileName & args & scrFile,0,true)
	if res=0 then	
                     log.writeline(fl.name & " Execute OK!")
	else
	     msgbox fl.name & chr(10) & "Fail to Execute!",vbError+vbOKOnly,"SmartTool"
	end if
            end if
        end if
    next 
    msgbox "All Done!!!",vbOKOnly,"SmartTool"
    log.close
    set log=nothing
    set fd=nothing
    set objFSO=nothing
    set WshShell=nothing
end sub

public function CheckFileInuse(fn)
    dim fso,fl
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set fl = fso.GetFile(fn)
    ON ERROR RESUME NEXT
    fl.move fl.path
    if Err=70 then
        CheckFileInuse=true
    else
        CheckFileInuse=false
    end if
    Set fso =nothing
    Set fl = nothing
end function
           

至此，即完成了整個項目需求。

總結一下，代碼不少是在網上東拼西湊的，因為對AutoCAD的二次開發不甚了解，項目需求又比較着急，是以明顯有很多漏洞在裡面，特别是異常的處理，對象的釋放等，都沒有考慮到位，好在最後的使用效果還是可以的，後續有機會再進一步研究，對這一類的小工具，我一直堅持“夠用就好”，把精力用在該用的地方！

過程中，使用某度搜尋一直找不到太多我想要的，最後還是使用了google，找到了幾位大神級别搞AutoCAD二次開發的部落格，有很多非常有參考價值的例子。

希望本文對有需求的朋友有一點點幫助，感謝您的打賞支援！！！