Personal Computer World 2002 March/PCWMAR02.iso/software/turbocad/V4/tcw.z/mdc.bas

BASIC Source File | 1997-10-28 | 13.7 KB | 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