home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Personal Computer World 2002 March
/
PCWMAR02.iso
/
software
/
turbocad
/
V4
/
tcw.z
/
mdc.bas
< prev
next >
Wrap
BASIC Source File
|
1997-10-28
|
14KB
|
650 lines
'Multiple Drawing Converter
'
'******************************************************************
'
' TurboCAD for Windows
' Copyright (c) 1993 - 1996
' International Microcomputer Software, Inc.
' (IMSI)
' All rights reserved.
'
'******************************************************************
'
' Filename: MDC.BAS
'
' Author: Pat Garner, Natalia Karaseva (updated to version 4.0 interface)
'
' Date: 1/8/97, 09/30/97
'
' Scriptname: Multiple Drawing Converter
'
' Description: Script asks for a directory and filetype
' sufix, and then creates a list of files
' of the specified filetype from the specified
' directory and then attempts to sequentially
' load, save, and close all files in the list.
' You also have the option to print files both
' before and after conversion as well as exit
' the application upon script completion.
'
'
' TurboCAD (TCADAPI) Functions used in this script:
'
' - TCWAppExit
' - TCWLastErrorGet
' - TCWDrawingNew
' - TCWDrawingOpen
' - TCWDrawingClose
' - TCWDrawingSaveAs
' - TCWDrawingPrint
'
'
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''Script Global Access Variables'''''''''''''''''''''''''''''''
'
'
Dim dir As String
Dim ext As String
'
Dim newdir As String
Dim newext As String
Dim FilStr As String
Dim OldPath As String
Dim NewPath As String
Dim CurPath As String
'
Dim Printd As Integer
Dim BAB As Integer
Dim q As Integer
'
Dim ExitApp As Integer
'
Dim fh As Long
Dim subdir As String
Dim fileBatname As String
Dim fileListname As String
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''Script Global Constants''''''''''''''''''''''''''''''''''''''
'
'
Global Const BEFORE = 0
Global Const AFTER = 1
Global Const BOTH = 2
'
Global Const NO = 0
Global Const YES = 1
'
'
' Set to 1 to exit after UI dialog, or 2 to exit after
' one iteration of file loop
'
Global Const DEBUG_MODE = 0
'
'
' * Set this value to 0 to show print dialog in file loop
'
Global Const SHOW_PRINT_DIALOG = 1
'
'
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''SUBROUTINE: MAIN'''''''''''''''''''''''''''''''''''''''''''''
'
' * Parameters: None
' *
' *
' * Return Value: None
' *
' *
' * Description:
' *
' * Main is the conductor of the program
' * and like a music conductor, tells
' * the other parts of the program when
' * it's time to do their thing.
' *
' *
Sub main()
' * File manipulation variable declarations
Dim pos As Integer
Dim fh1 As Integer
Dim filename As String
Dim newfilename As String
Dim ertxt As String
Dim newfilenameplusdir As String
Dim filenameplusdir As String
Dim Dgdef,Title,Resp
UIDialog
pos=len(dir)
if (pos>3) Then
ertxt=Right$(dir,1)
if ertxt="\" Then dir=Left$(dir,pos-1)
else
MsgBox "Must be more then 3 symbols in Directory Name!"
Stop
end if
pos=len(newdir)
if (pos>3) Then
ertxt=Right$(newdir,1)
if ertxt="\" Then newdir=Left$(newdir,pos-1)
else
MsgBox "Must be more then 3 symbols in Directory Name!"
Stop
end if
CurPath=CurDir$()
OldPath=dir
ChDir OldPath
if (OldPath<>CurDir$()) Then
MsgBox "Source directory not found"
ChDir CurPath
Stop
End If
NewPath=newdir
ChDir NewPath
if (NewPath<>CurDir$()) Then
CrDialog(NewPath)
End If
ChDir NewPath
if (NewPath<>CurDir$()) Then
result=MsgBox( "Rename target directory,please."+Chr(10)+" Cannot create it",0, "Multiple Drawing Converter")
Stop
End If
ChDir OldPath
FileBatName="filelist.bat"
FileListName= "Filelist.txt"
' * Create a batch file that will compile our file list for us
open FileBatName for output as #1
print # 1, "@echo off"
print # 1, "dir /b " & "*." & ext & " >" & FileListName
close #1
' * Run batch file to create the file list
Shell FileBatName, 2
if (dir=newdir) and (ext=newext) Then
ExitScript
Stop
end If
'Pause for a second or three
for i#=0 To 1000000
next i
' * Open our filelist file for reading
open FileListName for input as #1
' * Start the file loop and keep iterating until
' * you've reached the end of the file.
q=0
if (EOF(1)) then
MsgBox "Files no found"
close #1
RemoveExternalFiles
Stop
end if
do while ( not EOF(1)) and (q=0)
while (OldPath<>CurDir$())
ChDir OldPath
wend
' * Read in a file name
line input #1, filename
' * Find out where the extension starts in the filename
pos = Len(filename)-1
' * Append the filename onto the end of the
' * directory we wish to load files from.
filenameplusdir = Left$(filename,pos)
' * Open the current drawing
while (OldPath<>CurDir$())
ChDir OldPath
wend
fh=TCWDrawingOpen(filenameplusdir)
if (fh=0) Then
close #1
result=TCWLastErrorGet(ertxt)
RemoveExternalFiles
MsgBox ertxt
ChDir CurPath
q=1
Stop
End If
' * If the user answered yes to print,
' * check to see if the user wishes to
' * print before conversion...
if Printd = YES then
if BAB = BEFORE OR BAB = BOTH then
' * Print the drawing
TCWDrawingPrint SHOW_PRINT_DIALOG ' * NOTE: PrintDialog contains a value,
' * which instructs TCWDrawingPrint
' * to show the print dialog or not.
end if
end if
' * Create new filename containing the
' * original filename plus the new
' * extension.
newfilename = Left$(filename, pos-3) & newext
' * Append the newfilename onto the
' * directory the user wishes to save
' * the converted files to
newfilenameplusdir = newdir & "\" & newfilename
' * Save the current drawing with our
' * new filename to the directory
' * originally specified by the user.
FilStr=newfilenameplusdir
while (NewPath<>CurDir$())
ChDir NewPath
wend
fh1=TCWDrawingSaveAs(FilStr,FALSE)
' * If the user answered yes to print check to see
' * if the user wishes to print after conversion...
if Printd = YES then
if BAB = AFTER OR BAB = BOTH then
' * Print the drawing
TCWDrawingPrint SHOW_PRINT_DIALOG ' * NOTE: PrinDialog contains a value,
' * which instructs TCWDrawingPrint
' * to show the print dialog or not.
end if
end if
' * Close the currently open drawing
while (OldPath<>CurDir$())
ChDir OldPath
wend
TCWDrawingClose(0)
if DEBUG_MODE = 2 then ' * If Debug has been set to 1,
MsgBox "DEBUG STOP: File Loop" ' * Display a message box telling
' * us this, and the, ...
END ' * stop script execution before
' * loop iterates again.
end if
loop ' * Iterate loop
close #1 ' * Close filelist filestream
ChDir OldPath
RemoveExternalFiles
ExitScript
End Sub
'
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''SUBROUTINE: RemoveExternalFiles''''''''''''''''''''''''''''''
'
' * Parameters: None
' *
' *
' * Return Value: None
' *
' *
' * Description:
' *
' * Removes special files created by this script
' * for it's own use.
' *
' *
Sub RemoveExternalFiles()
while (OldPath<>CurDir$())
ChDir OldPath
wend
Kill Filelistname
Kill Filebatname
while (CurPath<>CurDir$())
ChDir CurPath
wend
End Sub
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''SUBROUTINE: ExitScript'''''''''''''''''''''''''''''''''''''''
'
' * Parameters: None
' *
' *
' * Return Value: None
' *
' *
' * Description:
' *
' * Exit TurboCAD upon completion
' * of script if user turned option
' * from UI dialog.
' *
' *
Sub ExitScript ()
' * If the user elected to exit the app after script completion, ...
if ExitApp = YES then
' * Display a message box telling us this ... *
MsgBox "Finished converting files!" & Chr(10) & "Now Exiting Application!"
' * And exit the application.
TCWAppExit
else
' * Otherwise, let the user know
' * the script is done with the
' * file conversion
MsgBox "Finished converting files!"
end if
End Sub
'
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''SUBROUTINE: CrDir'''''''''''''''''''''''''''''''''''''''
'
' * Parameters: ByVal dirstr As String - Name of directory to create
' *
' *
' * Return Value: None
' *
' *
' * Description:
' *
' * Target directory creating
' *
' *
Sub CrDir (ByVal dirstr As String )
Dim w As Integer
Dim id As Integer
Dim p As Integer
Dim Rpos As Integer
Dim Ls As Integer
Dim AStr As String
Dim PStr As String
Dim NStr As String
Dim dir1 As String
Dim a As String
AStr=dirstr
p=InSTr(1,AStr,"\")
if (p<>0) then
NStr=Left$(AStr,p-1)
dir1=NStr 'Current directory
ChDir("\")
ChDrive(dir1)
a=CurDir$()
if (dir1<>CurDir$()) Then
NStr=Left$(AStr,p)
ChDir(Nstr)
end if
a=CurDir$()
if (Nstr<>CurDir$()) Then
MsgBox "Cannot create"+Chr(10)+ dir1+Chr(10)+a
ChDir(CurPath)
Stop
end if
end if
Ls=len(Astr)
w=0
id=0
while (w=0)
Rpos=Ls-p
PStr=Right$(Astr,RPos)
p=InSTr(1,PStr,"\")
NStr=Left$(PStr,p-1)
if id=0 then
dir1=CurDir$()+NStr
else
dir1=CurDir$()+"\"+NStr
end if
id=id+1
ChDir(dir1)
if (dir1<>CurDir$()) Then
MkDir Nstr
ChDir(dir1)
a=CurDir$()
end if
Ls=len(Pstr)
if p=0 then
w=1
end if
wend
End Sub
'
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub CrDialog (ByVal DirS As String)
Begin Dialog Crd 40, 80, 100, 100, "Multiple Drawing Converter"
Text 10, 10, 100, 10, "Target Directory not found."
Text 10, 20, 100, 10, " Create it?"
OKbutton 5, 50, 40, 12
CancelButton 55, 50, 40, 12
End Dialog
Dim Dlg2 As Crd
button = Dialog(Dlg2)
if button = 0 then
Stop
end if
CrDir(DirS)
End Sub
''SUBROUTINE: UIDialog''''''''''''''''''''''''''''''''''''''''''
'
' * Parameters: None
' *
' *
' * Return Value: None
' *
' *
' * Description:
' *
' * This is the script's user interface subroutine.
' * It's actually a dialog box definition that serves
' * as a "template" for later creating a variable of
' * of this type and them using the enable function
' * 'Dialog' to display it and return values. The
' * dialog definition is done in a manner very similar
' * to creating user defined variables with the type
' * function in basic or the struct function in C.
' * By utilizing several of the UI objects available
' * you can actually create quite a useful interface
' * for setting script values and options as well as
' * guiding the user through script setup with a
' * "wizard" like interface.
' *
' *
Sub UIDialog ()
Dim MyList$(11)
MyList(0)="dwg"
MyList(1)="dwf"
MyList(2)="dxf"
MyList(3)="eps"
MyList(4)="fp3"
MyList(5)="mdl"
MyList(6)="plt"
MyList(7)="sat"
MyList(8)="tct"
MyList(9)="tcw"
MyList(10)="tcx"
MyList(11)="wmf"
Begin Dialog FernUI 20, 60, 150, 190, "Multiple Drawing Converter"
Text 10, 10, 130, 10, "Directory you wish to open from:"
TextBox 10, 20, 130, 10, .OpenDir
Text 10, 33, 100, 10, "Extension of files load:"
DropListBox 110, 31, 30, 120, MyList$(), .OpenType
Text 10, 50, 130, 10, "Directory you wish to save to:"
TextBox 10, 60, 130, 10, .SaveDir
Text 10, 73, 100, 10, "Extention to save to:"
DropListBox 110, 71, 30, 120, MyList$(), .SaveType
CheckBox 10, 150, 140, 10, "Exit TurboCAD upon script completion", .ExitTCW
CheckBox 10, 85, 130, 20, "Print drawings", .Print
GroupBox 10, 102, 130, 40, "Print Before conversion, after, or both?", .PrintBeforeAfterOrBoth
OptionGroup .WhenToPrint
OptionButton 20, 112, 30, 8, "Before", .Before
OptionButton 20, 122, 30, 8, "After", .After
OptionButton 20, 132, 30, 8, "Both", .Both
OKbutton 35, 175, 40, 12
CancelButton 75, 175, 40, 12
End Dialog
Dim Dlg1 As FernUI
Dlg1.OpenDir = "c:\imsi\tcw40\drawings"
Dlg1.OpenType = 9
Dlg1.SaveDir = "c:\imsi\tcw40\drawings"
Dlg1.SaveType = 9
Dlg1.Print = 0
Dlg1.ExitTCW = 0
button = Dialog(Dlg1)
if button = 0 then
Stop
END
elseif button = -1 then
dir = Dlg1.OpenDir
ext = MyList(Dlg1.OpenType)
newdir = Dlg1.SaveDir
newext = MyList(Dlg1.SaveType)
Printd = Dlg1.Print
BAB = Dlg1.WhenToPrint
ExitApp = Dlg1.ExitTCW
if DEBUG_MODE = 1 then
MsgBox "dir: " & dir & Chr$(10) & _
"ext: " & ext & Chr$(10) & _
Chr$(10) & _
"newdir: " & newdir & Chr$(10) & _
"newext: " & newext & Chr$(10) & _
Chr$(10) & _
"Printd: " & Printd & Chr$(10) & _
"BAB: " & BAB & Chr$(10) & _
Chr$(10) & _
"ExitApp: " & ExitApp
END
end if
end if
End Sub
