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 VBA Code
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
Next, place this coding under the event procedure of the Directory List
Box:
Private Sub Dir1_Change()
File1.Path = Dir1.Path
'retrieves the drive and directory name
End Sub
The main routine of the function is within the event procedure of the
"Export" button:
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
Finally, this coding goes under the event procedure of the
"Cancel" button:
Private Sub btnCancel_Click()
End
'end the routine
End Sub
|