VBA
Discuss AutoCAD ActiveX and VBA (Visual Basic for Applications) questions here.
cancel
Showing results for 
Show  only  | Search instead for 
Did you mean: 

image files

2 REPLIES 2
Reply
Message 1 of 3
Anonymous
143 Views, 2 Replies

image files

I am working with large drawings, some of which have extremely large image
files(500 meg) attached which take a really long time to load. Is there a
way with VB to detect whether or not a file has an image attached and
possibly detaching it prior to fully opening the drawing?
Thanks
2 REPLIES 2
Message 2 of 3
Anonymous
in reply to: Anonymous

Hi Tom,
Not using just the AutoCAD VBA object model! Before it can read any part of
the drawing it has to have the drawing opened.
There might be a work around for you, but I need to know:
What version of AutoCAD are you using
When you said VB did you mean Visual Basic the application, or Visual Basic
for Applications (as a hosted language)

Randall Rath
Message 3 of 3
Anonymous
in reply to: Anonymous

Hi Tom,
Your working with AutoCAD 2000 VBA, and you don't need to reload them when
you close! Could it get any better?
Add this reference to your project:

ObjectDBX 1.0 Type Library

look at this page if you are not sure of how to add a reference:

< http://vbdesign.hypermart.net/cadpages/xxii.htm >

Now add a new class module and name it FileDialog. Add this code to it:

Option Explicit

'//The Win32 API Functions///
Private Declare Function GetSaveFileName Lib _
"comdlg32.dll" Alias "GetSaveFileNameA" _
(pOpenfilename As OPENFILENAME) As Long

Private Declare Function GetOpenFileName Lib _
"comdlg32.dll" Alias "GetOpenFileNameA" _
(pOpenfilename As OPENFILENAME) As Long

'//A few of the available Flags///
Private Const OFN_HIDEREADONLY = &H4
'//The Structure
Private Type OPENFILENAME
lStructSize As Long
hwndOwner As Long
hInstance As Long
lpstrFilter As String
lpstrCustomFilter As String
nMaxCustFilter As Long
nFilterIndex As Long
lpstrFile As String
nMaxFile As Long
lpstrFileTitle As String
nMaxFileTitle As Long
lpstrInitialDir As String
lpstrTitle As String
flags As Long
nFileOffset As Integer
nFileExtension As Integer
lpstrDefExt As String
lCustData As Long
lpfnHook As Long
lpTemplateName As String
End Type

Private lngHwnd As Long
Private strFilter As String
Private strTitle As String
Private strDir As String
Private blnHideReadOnly As Boolean

Private Sub Class_Initialize()
'Set default values when
'class is first created
strDir = CurDir
strTitle = "Llamas Rule"
strFilter = "All Files" _
& Chr$(0) & "*.*" & Chr$(0)
lngHwnd = &O0 'Desktop
End Sub

Public Property Let OwnerHwnd(WindowHandle As Long)
'//FOR YOU TODO//
'Use the API to validate this handle
lngHwnd = WindowHandle
'R14 users who just want to use this code:
'Simple, don't set this property! the default
'of &0 will work fine for most of yor needs
End Property

Public Property Get OwnerHwnd() As Long
OwnerHwnd = lngHwnd
End Property

Public Property Let Title(Caption As String)
'don't allow null strings
If Not Caption = vbNullString Then
strTitle = Caption
End If
End Property

Public Property Get Title() As String
Title = strTitle
End Property

Public Property Let Filter(ByVal FilterString As String)
'Filters change the type of files that are
'displayed in the dialog. I have designed this
'validation to use the same filter format the
'Common dialog OCX uses:
'"All Files (*.*)|*.*"
Dim intPos As Integer
Do While InStr(FilterString, "|") > 0
intPos = InStr(FilterString, "|")
If intPos > 0 Then
FilterString = Left$(FilterString, intPos - 1) _
& Chr$(0) & Right$(FilterString, _
Len(FilterString) - intPos)
End If
Loop
If Right$(FilterString, 2) <> Chr$(0) & Chr$(0) Then
FilterString = FilterString & Chr$(0)
End If
strFilter = FilterString
End Property

Public Property Get Filter() As String
'Here we reverse the process and return
'the Filter in the same format the it was
'entered
Dim intPos As Integer
Dim strTemp As String
strTemp = strFilter
Do While InStr(strTemp, Chr$(0)) > 0
intPos = InStr(strTemp, Chr$(0))
If intPos > 0 Then
strTemp = Left$(strTemp, intPos - 1) _
& "|" & Right$(strTemp, _
Len(strTemp) - intPos)
End If
Loop
If Right$(strTemp, 1) = "|" Then
strTemp = Left$(strTemp, Len(strTemp) - 1)
End If
Filter = strTemp
End Property

Public Property Let HideReadOnly(blnVal As Boolean)
'Simple one
blnHideReadOnly = blnVal
End Property

Public Property Get HideReadOnly() As Boolean
HideReadOnly = blnHideReadOnly
End Property

'@~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~@
' Display and use the File open dialog
'@~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~@
Public Function ShowOpen() As String
Dim strTemp As String
Dim udtStruct As OPENFILENAME
udtStruct.lStructSize = Len(udtStruct)
'Use our private variable
udtStruct.hwndOwner = lngHwnd
'Use our private variable
udtStruct.lpstrFilter = strFilter
udtStruct.lpstrFile = Space$(254)
udtStruct.nMaxFile = 255
udtStruct.lpstrFileTitle = Space$(254)
udtStruct.nMaxFileTitle = 255
'Use our private variable
udtStruct.lpstrInitialDir = strDir
'Use our private variable
udtStruct.lpstrTitle = strTitle
'Ok, here we test our boolean to
'set the flag
If blnHideReadOnly Then
udtStruct.flags = OFN_HIDEREADONLY
Else
udtStruct.flags = 0
End If
If GetOpenFileName(udtStruct) Then
strTemp = (Trim(udtStruct.lpstrFile))
ShowOpen = Mid(strTemp, 1, Len(strTemp) - 1)
End If
End Function

'@~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~@
' Display and use the File Save dialog
'@~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~@
Public Function ShowSave() As String
Dim strTemp As String
Dim udtStruct As OPENFILENAME
udtStruct.lStructSize = Len(udtStruct)
'Use our private variable
udtStruct.hwndOwner = lngHwnd
'Use our private variable
udtStruct.lpstrFilter = strFilter
udtStruct.lpstrFile = Space$(254)
udtStruct.nMaxFile = 255
udtStruct.lpstrFileTitle = Space$(254)
udtStruct.nMaxFileTitle = 255
'Use our private variable
udtStruct.lpstrInitialDir = strDir
'Use our private variable
udtStruct.lpstrTitle = strTitle
'Ok, here we test our flag
If blnHideReadOnly Then
udtStruct.flags = OFN_HIDEREADONLY
Else
udtStruct.flags = 0
End If
If GetSaveFileName(udtStruct) Then
strTemp = (Trim(udtStruct.lpstrFile))
ShowSave = Mid(strTemp, 1, Len(strTemp) - 1)
End If
End Function

Now add a standard module and paste in this code:

Option Explicit

Dim objDbx As AxDbDocument

Public Sub OpenNoImages()
Dim objFile As New FileDialog
Dim strFile As String
objFile.HideReadOnly = True
objFile.Filter = "AutoCAD Drawings (*.dwg)|*.dwg"
objFile.Title = "Drawing to Open"
strFile = objFile.ShowOpen
If Len(strFile) > 0 Then
UnloadImages strFile
End If
End Sub

Public Sub UnloadImages(strFile As String)
Dim objEnt As AcadEntity
Dim varPnt As Variant
Dim objDoc As AcadDocument
Dim objImage As AcadRasterImage
Set colPath = New Collection
Set colPnts = New Collection
Set colRot = New Collection
Set colScale = New Collection
Set objDbx = GetInterfaceObject("ObjectDBX.AxDbDocument")
objDbx.Open strFile
For Each objEnt In objDbx.ModelSpace
If TypeOf objEnt Is AcadRasterImage Then
Set objImage = objEnt
objImage.Delete
blnReload = True
End If
Next objEnt
objDbx.SaveAs strFile
Set objDbx = Nothing
Application.Documents.Open strFile
End Sub

Use the OpenNoImages procedure to open your drawings that have thos big
image files attached!

(
)
c[]
Randall Rath

Can't find what you're looking for? Ask the community or share your knowledge.

Post to forums  

Autodesk Design & Make Report

”Boost