Test to see if drawing is open using VBA

Can anyone tell me how to test to see if a drawing is already open in
AutoCAD using VBA and if it to make it the active document?

I have a VBA macro to open xrefs by by just picking them in the drawing but
I need to test to see if the drawing may already be open to avoid opening
the drawing a second time in "Read Only" mode.

 

would this work?
Public Function OpenDwg(sDwgName As String) As AcadDocument
Set OpenDwg = GetObject(sDwgName)
End Function

 

Well there are two ways to read your request - looking for drawings that
the current user has opened, or looking to see if anyone has them opened.

If its the current user, cycle through the AcadApplication's document
collection something like:

Dim oDoc As AcadDocument
For Each oDoc In AcadApplication.Documents
If oDoc.Name = "Name you're looking for" Then
Set AcadApplication.ActiveDocument = oDoc
Exit For
End If
Next

If its to see if anyone has it open, then you need to access the File and
check its properties through the file system and see if its open or not.
Search this ng because that has been answered numerous times and I don't
have the code at hand right now.

-- Mike
___________________________
Mike Tuersley
CADalyst's CAD Clinic
Rand IMAGINiT Technologies
___________________________
the trick is to realize that there is no spoon...

 

Thank you, that is what I was after however, I've been unable to figure out where to put in my function (I'm pretty new to VBA) to make it work. I thought it would go within the "SelectObject" function but I keep getting "End If without block If" error. Here is the text, maybe you know how to incorporate the open doc test so the function will work without error...

Public Sub OpenXref()

'Set the current drawing as the active document.
Dim activeDoc As AcadDocument
Set activeDoc = ThisDrawing.Application.ActiveDocument
Dim ver As String

'Declare two variables for a block reference and external reference.
Dim pt As ACAD_POINT 'Declare a variable for a pick point.
Dim ob As AcadObject 'Declare a variable for an Autocad object.
Dim xR As AcadExternalReference 'Declare a variable for an Autocad external reference.

SelectObj:

On Error GoTo NotObject 'If no object is selected then proceed to the NotObject function.

activeDoc.Utility.GetEntity ob, pt, "Select an XREF: " 'Select an Object in AutoCAD.
If (ob.ObjectName = "AcDbBlockReference") Then 'Check that the selected object is a block reference.


'Now that the selected object has been established as an external reference, set the xref to the selected object.
Set xR = ob 'Reference an AcDbBlockReference.
Dim Msg, Style, Title, Response
Msg = "Open File: " & Chr(13) + StrConv(xR.Path + "?", vbUpperCase) 'Define message.
Style = vbYesNo + vbQuestion + vbDefaultButton1 'Define buttons.
Title = "Open Xref File?" 'Define title.
Response = MsgBox(Msg, Style, Title)
If Response = vbNo Then 'User chose No.
Exit Sub
Else 'User chose Yes.
Dim oDoc As AcadDocument
For Each oDoc In AcadApplication.Documents
If oDoc.name = xR Then
Set AcadApplication.ActiveDocument = oDoc
Exit For
Else
activeDoc.Application.Documents.Open xR.Path 'Open the xref file.
End If
Exit Sub
End If

NotObject:
'Alert the user that nothing was selected and give the opertunity to reselect or cancel.
Dim MsgNotObject, StyleNotObject, TitleNotObject, ResponseNotObject
MsgNotObject = "No object selected! " ' Define message.
StyleNotObject = vbRetryCancel + vbExclamation + vbDefaultButton1 ' Define buttons.
TitleNotObject = "Selection Error!" ' Define title.
ResponseNotObject = MsgBox(MsgNotObject, StyleNotObject, TitleNotObject)
If ResponseNotObject = vbRetry Then 'User chose retry.
Resume SelectObj 'Resume selection mode.
Else
Exit Sub
End If

End If
End Sub

Thanks for your help!!
-shawn

 

multiple embedded If/End If s are hard to keep track of and generally to be
avoided
you were missing a Next to go with a For and it's hard to see buried in all
those ifs

heres a few tweaks fwiw
Option Explicit

Public Sub OpenXref()

Dim oDoc As AcadDocument
Dim oDocOpen As AcadDocument
Set oDoc = ThisDrawing
Dim bDocOpen As Boolean
Dim oApp As AcadApplication
Set oApp = oDoc.Application
Dim oDocs As AcadDocuments
Set oDocs = oApp.Documents
Dim Msg, Style, Title, Response
Dim pt As Variant 'Declare a variable for a pick point.
Dim ob As AcadEntity 'Declare a variable for an Autocad entity.
Dim xR As AcadExternalReference 'Declare a variable for an Autocad
external reference.

SelectObj:
On Error GoTo NotObject 'If no object is selected then proceed to the
NotObject function.
oDoc.Utility.GetEntity ob, pt, "Select an XREF: " 'Select an Object in
AutoCAD.

If Not TypeOf ob Is AcadExternalReference Then
MsgBox "Not an xref"
Resume SelectObj
End If

'Now that the selected object has been established as an external reference,
set the xref to the selected object.
Set xR = ob
Msg = "Open File: " & Chr(13) + StrConv(xR.Path + "?", vbUpperCase)
'Define message.
Style = vbYesNo + vbQuestion + vbDefaultButton1 'Define buttons.
Title = "Open Xref File?" 'Define title.
Response = MsgBox(Msg, Style, Title)
If Response = vbNo Then 'User chose No.
Resume ExitHere
End If

'instead of iterating all docs just go for the one you're looking for and
see if its here
On Error Resume Next
Set oDocOpen = oDocs.Item(xR.Path)
If Err Then 'doc not open
MsgBox "Doc not open"
Err.Clear
Else
MsgBox "Doc open"
bDocOpen = True 'I prefer to set a boolean instead of burying more
ifs inside this if
End If

On Error GoTo OpenErr
If bDocOpen Then
oDocOpen.Activate
Else
oApp.Documents.Open xR.Path 'Open the xref file.
End If

ExitHere:
'these are not strictly necessary according to some
'just makes me feel like I cleaned up after myself...
'
Set oDoc = Nothing
Set oApp = Nothing
Set oDocs = Nothing
Set xR = Nothing
Set oDocOpen = Nothing
Set ob = Nothing
Exit Sub

NotObject:
'Alert the user that nothing was selected and give the
opertunity to reselect or cancel.
Dim MsgNotObject, StyleNotObject, TitleNotObject,
ResponseNotObject
MsgNotObject = "No object selected! " ' Define message.
StyleNotObject = vbRetryCancel + vbExclamation +
vbDefaultButton1 ' Define buttons.
TitleNotObject = "Selection Error!" ' Define title.
ResponseNotObject = MsgBox(MsgNotObject, StyleNotObject,
TitleNotObject)
If ResponseNotObject = vbRetry Then 'User chose retry.
Resume SelectObj 'Resume selection mode.
Else
Resume ExitHere

End If

OpenErr:
MsgBox Err.Description
Resume ExitHere

End Sub

hth
Mark

out where to put in my function (I'm pretty new to VBA) to make it work. I
thought it would go within the "SelectObject" function but I keep getting
"End If without block If" error. Here is the text, maybe you know how to
incorporate the open doc test so the function will work without error...

 

Wow! Now that's some VBA acrobatics!

Many, many thanks for taking the time to help!

I gave it a whirl and received no errors but it's not finding the open document. If the document is open, it tells me its not and opens a read-only copy instead of making the already open document active. Would it be advantageous to cycle through all the open documents to ensure that its found?

I think I'm over my with this one at this point, I understand what is happening in the code but not quite sure how to get it to search all open documents

 

AutoCAD 2005 makes a DWL file with the same name as the open file. That
sounds like a real easy way to check.

 

I am using AutoCAD 2002 currently.

 

document. If the document is open, it tells me its not and opens a read-only
copy instead of making the already open document active. Would it be
advantageous to cycle through all the open documents to ensure that its
found?

happening in the code but not quite sure how to get it to search all open
documents

don't know why it doesn't find the open dwg. it did here but we're on 2005
so i don't remember if 2002 is different in some way.
The item method of a collection should return the object if it exists or
error if not.
That's why I changed the for each loop to just trapping the error.
You can certainly go back to the for each you were using before if that was
working for you.
I'm sure there's no detectable speed penalty or anything else.
It's just a theoretical concept i had stuck in my mind, like if you're
looking for a layer - and there may be hundreds of them - it's theoretically
faster/more efficient to use the item method rather than iterate the entire
collection.
In this case if iteration works I'd definitely use it.
I believe that's what your original code was doing wasn't it?
hth
Mark

 

I never got the "for each" statement to work because it was a suggestion from someone else and I couldn't quite figure out where to put it in my code and how to make it work. I'm very new to VBA, this was my first VBA attempt and it took me many hours to get it to work, so your help has been very much appreciated! So you know what my next question is...how to I get the "for each" statement to work?

Dim oDoc As AcadDocument
For Each oDoc In AcadApplication.Documents
If oDoc.Name = "Name you're looking for" Then
Set AcadApplication.ActiveDocument = oDoc
Exit For
End If
Next

-shawn

 

from someone else and I couldn't quite figure out where to put it in my code
and how to make it work. I'm very new to VBA, this was my first VBA attempt
and it took me many hours to get it to work, so your help has been very much
appreciated! So you know what my next question is...how to I get the "for
each" statement to work?

Ok that's two questions -
1 Where to put it in my code.
2 How to make it work.

as far as 1, i'd have to see your current code to know where to put it
as far as 2, the way you had it looked like it should have worked to me, but
it didn't!
I had to change it to
For Each oDoc In AcadApplication.Documents
If oDoc.Name = "Name you're looking for" Then
oDoc .Activate
Exit For
End If
Next

I don't understand why you can't set the ActiveDocument property to the doc
object.
The property is not listed as readonly as far as I could tell but for some
reason it didn't like it
However in my test the .Activate method on the odoc object did work so that
should do it.

I'd like to hear, if someone knows, why the ActiveDocument property didn't
work.

ps, once you get the activating an open document part to work, there may
still be issues with opening the document if it's not open - depending on
search paths / and if you're using relative or absolute paths for your
xrefs.

Was that part working for you? .Open (xr.path) ?
maybe you're saving hardcoded paths on the xref?

here, xr.path would be like "dwgname.dwg"
thus the path would have to be determined and pre-pended to allow acad to
find the dwg.

hth
Mark