Toplu NCZ Dosya Düzenleme ve Şablon Uygulama Makrosu (Batch NCZ File Editing and Template Application Macro)

public sablon
'sablon = "d:\FY\Referans.NCZ" 'sablon mutlaka oluşturulmalı ve path bilgisi düzenlenmelidir

sub main()
 dim inPath,outPath,BD,proj,datum,zone,cleanProj
with netcad
    inpath = openDirDialog("Esas Alınacak Klasör")
    outpath = openDirDialog("Kaydedilecek Klasör ")
    set BD = .newbdialog("Hoşgeldiniz.")
  '  BD.PutPrompt "      Kaynak klasördeki dosyalar  "  & sablon
  '  BD.PutPrompt "      Referans projesinde olduğu gibi düzenlenecek"
    BD.PutPrompt "¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯µ"
    BD.getString "INPATH","Kaynak Klasör : ",inpath,255
    BD.getString "OUTPATH","Hedef Klasör : ",outPath,255
    BD.getcheck  "CLEAN","Proje Düzenle",1
    BD.PutPrompt "________________________________________________________________µ"
    BD.PutPrompt "TOPLU PROJE DÜZENLEME MODÜLÜ - ŞABAN GÜL, HARİTA MÜHENDİSİ "
   if BD.showmodal then
        if BD.valuebyname("INPATH") <> "" then
            inPath = BD.valuebyname("INPATH")
            if BD.valuebyname("OUTPATH") <> "" then
                outPath = BD.valuebyname("OUTPATH")
                if BD.valuebyname("CLEAN") <> 0 then
                    cleanProj = BD.valuebyname("CLEAN")
                    process inPath,Outpath,cleanProj
                end if
            else
                msgbox "Esas Alınacak Klasörü Seçmediniz !!!"
                exit sub
            end if
        else
            msgbox "Kaydedilecek Klasörü Seçmediniz !!!"
            exit sub
        end if
    end if
end with
end sub

Sub process(inPath,Outpath,cleanProj)
dim FSO_folder,FSO,Count,NCZ_File,inFile,ly,b,i
  ' MSGBOX Outpath
'IF INSTR(outPath,"OLCU")>0  OR INSTR(outPath,"sınır")>0 then sablon = "d:\FY\Ref_OLCU.NCZ"
'IF INSTR(outPath,"SINIR")>0  OR INSTR(outPath,"sınır")>0 then sablon = "d:\FY\Ref_SIN.NCZ"
'IF INSTR(outPath,"pafta")>0  OR INSTR(outPath,"PAFTA")>0 then sablon = "d:\FY\Ref_Pafta.NCZ"
with netcad
    set FSO = CreateObject("Scripting.FileSystemObject")
    set FSO_folder = FSO.GetFolder(InPath)
    set Count = FSO_folder.Files
   for each NCZ_File in Count
                     IF RIGHT(InPath & NCZ_File.name,4)=".NCZ" THEN
                .InsertFile InPath & NCZ_File.name,fs_bnetcad,true
dim toptbk,tbksay
toptbk = .numlayers - 1
With nclayermanager
For tbksay = 0 To toptbk
 .layer(tbksay).LockActive=false
Next
 END with
if cleanProj = 1 then .NetcadCommand "PROJECT CLEAN 1,1,1,1,1,1"
        inFile = split(NCZ_File.name,".",-1,1)
        .SaveToFile OutPath & inFile(0) & ".NCZ"
        .findworld
        .NetcadCommand "CLOSE ACTIVEPROJECT"
        i = i + 1
        END IF
    Next
    msgbox i & " Dosya Düzenlendi..."
end with
end Sub

function openDirDialog(title)
dim shell,folder,filePath,fileRoot
  Set shell = CreateObject("Shell.Application")
  Set folder = shell.BrowseForFolder(&H0,title,&H0008,&H0011)
  on error resume next
  openDirDialog = folder.ParentFolder.ParseName(folder.title).Path&"\"
  if err.number <> 0 then
    fileRoot = mid(folder.items.item(0).path,1,3)
    openDirDialog = fileRoot
  end if
  set shell  = nothing
  set folder = nothing
end function