Drawing Export (9 Kb)

AcadExport.Exe is a stand alone application written in Visual Basic for AutoCAD Release 14.
This routine will Export a selected directory of drawings.
Formats available for export are WMF, DXF, EPS and BMP.
If AutoCAD is not open when you run the application, it will automatically open AutoCAD. You can also run it from within Autocad.

Usage :

Open the application by double clicking on AcadExport.Exe.
A dialogue box will appear. Select the directory where the drawings you wish to Export reside. Select the format you wish to export the file as from the radio buttons and then Select "OK".
If you wish to run it from within AutoCAD type the following at the command prompt : 

(startapp "....directory path..../acadexport.exe")

Please note that you cannot Export Drawings to Drive A:. 

The following must be placed under the event procedure of the Drive List Box: 

Private Sub Drive1_Change()
Dir1.Path = Drive1.Drive
'retrieves the drive name
End Sub

Private Sub Dir1_Change()
File1.Path = Dir1.Path
'retrieves the drive and directory name
End Sub

Private Sub btnExport_Click()

Dim acadApp As Object
Dim acadDoc As Object
Dim filename As String
Dim dirname As String
Dim sset As Object
Dim pViewport As Object
 'declare variables
 
If Right(File1.Path, 1) <> "\" Then
'test for root directory

dirname = File1.Path & "\"
'if not root add \

Else

dirname = File1.Path
'if root directory do nothing

End If

If UCase(dirname) = "A:\" Then
'check if A:Drive has been choosen

    Me.Hide
    'Hide the dialogue box
    
    MsgBox ("Insufficient Space to Export Drawings on Drive A:"),_
     16, "Drawing Export"
    'inform the user
    
    End
    'end the application
    
End If
 
 
On Error Resume Next
'if error carry on with next line

Set acadApp = GetObject(, "AutoCAD.Application")
'setq reference to AutoCAD Application

If Err Then
'if there is an error (AutoCAD not open)

Err.Clear
'clear the error

Set acadApp = CreateObject("Autocad.Application")
'open AutoCAD


Set acadApp = GetObject(, "AutoCAD.Application")
'setq reference to AutoCAD Application

    If Err Then
    'if there is another error

        MsgBox Err.Description
    'inform user

        Exit Sub
    'exit application

    End If

End If


acadApp.Visible = True
'Make Autocad Visible

Set acadDoc = acadApp.ActiveDocument
'set reference to active document

Me.Hide
'Hide the dialogue box
 
filename = Dir(dirname, vbNormal)
'retrieve the first entry



Do While filename <> ""
'start the loop

If UCase(Right$(filename, 4)) = ".DWG" Then
'ignore files that do not end with .DWG

If (GetAttr(dirname & filename) And vbNormal) = vbNormal Then
'use bitwise comparison to make sure filename is not a directory

If Not acadDoc.Saved Then
'if drawing not saved

    If MsgBox("OK to Save Drawing?", 52, "Drawing Export") = vbNo Then
    'give user choice to save drawing and continue, or exit application

        End
    'end if user selects No

    Else
    'or else

        acadDoc.Save
    'if Yes, save drawing

    End If

End If

acadDoc.Open dirname & filename
'open drawing to purge

mylen = Len(filename)
'get the length of the filename

mylen = mylen - 4
'subtract the .DWG Extension

filename1 = Left(filename, mylen)
'retrieve the drawing name


Set pViewport = acadDoc.ActiveViewport
'set reference to the viewports

pViewport.ZoomExtents
'zoom to extents


Set sset = acadDoc.SelectionSets.Add("NEWSS")
'set reference to election set

sset.Select acSelectionSetAll
'select the whole drawing

If Option1.Value = True Then
'if radio button selected

acadDoc.Export dirname & filename1, "WMF", sset
'export the drawing

End If

If Option2.Value = True Then
'if radio button selected

acadDoc.Export dirname & filename1, "DXF", sset
'export the drawing

End If

If Option3.Value = True Then
'if radio button selected

acadDoc.Export dirname & filename1, "DWF", sset
'export the drawing

End If

If Option4.Value = True Then
'if radio button selected

acadDoc.Export dirname & filename1, "SAT", sset
'export the drawing

End If

If Option5.Value = True Then
'if radio button selected

acadDoc.Export dirname & filename1, "EPS", sset
'export the drawing

End If
If Option6.Value = True Then
'if radio button selected

acadDoc.Export dirname & filename1, "BMP", sset
'export the drawing

End If


acadDoc.Save
'save the drawing

    End If
End If

filename = Dir
'get the next entry

Loop
'carry on looping

acadApp.Quit
'Close Autocad

MsgBox ("Drawing Export Complete"), , "Drawing Export"
'inform user that we have finished

End
'Close VBA Application

End Sub

Private Sub btnCancel_Click()
End
'end the routine
End Sub