vindimy
Joined: 19 Oct 2005
Posts: 4
|
 Posted:
Fri Oct 21, 2005 12:10 am Post subject:
how to: export all drawings in a folder to bitmap or other f |
|
|
here's the code i wrote when i needed a routine that could export all
of my drawings into .bmp files... hope someone finds it useful.
Sub exportAllBlocks()
On Error GoTo Err_Control
Dim strFolder As String, strSubFolder As String, intI As Integer
Dim fso As Scripting.FileSystemObject, folder As Scripting.folder,
file As Scripting.file
Dim objDrawing As AcadDocument, objBlock As AcadBlock, objEntity As
AcadEntity, selSet1 As AcadSelectionSet
strFolder = "P:\s100127_bar scanner-cad
integration\Working\symbols\dmitriy_18-oct-05\"
strSubFolder = "P:\\s100127_bar scanner-cad
integration\\Working\\symbols\\dmitriy_18-oct-05\\img\\"
Set fso = New Scripting.FileSystemObject
Set folder = fso.GetFolder(strFolder)
'ThisDrawing.Close
For Each file In folder.Files
Set objDrawing = Application.Documents.Open(strFolder &
file.Name)
objDrawing.Activate
Application.ZoomExtents
objDrawing.SendCommand "(command " & Chr(34) & "export" &
Chr(34) & " " & Chr(34) & strSubFolder & file.Name & ".bmp" & Chr(34) &
" " & Chr(34) & "all" & Chr(34) & " " & Chr(34) & "" & Chr(34) & ")" &
vbCr
Application.ZoomExtents
objDrawing.Save
objDrawing.Close
Next file
MsgBox "Done!", vbOKOnly, "Done"
Err_Control:
If Err.Number <> 0 Then
MsgBox "Error: " & Err.Description, vbCritical, Err.Number
End If
Exit Sub
End Sub
|
|
FAQ
Memberlist
Register
Profile
Log in to check your private messages
Log in
