28 | 04 | 2017

Who has my drawing open?

If you use Autocad in a multi-user environment, you've run into the situation where someone has the drawing open, that you are supposed to be working on. Unless you have Vault running, you have no idea who has it open - short of making the rounds in the Office, or, making phone calls to someone who might have it open remotely.

There is a way to know this - and other information - from VBA. When you open an Autocad drawing, it creates a "lock" file, something like an access database might. Depending on the version of Autocad, it stores the information about User name, Pc Name, and time of last lock, in a hidden file.

We can find, and read this file from VBA - with some caveats. This file is supposed to be erasedĀ  when the drawing is closed, but, if you crashed previously, this file might remain. So theĀ  existence of the file, and/or the data in the file, might not be relevant.

So first we have to check if the drawing is actually used. We can do this with a windows API call, opening the file in "exclusive" mode. This method will fail if the file is opened by any other process, or any other method - it dosnt have to be opened for writing by Autocad.

If the call fails, then we know the Autocad drawing has been opened by someone else, and we can then find, and read the information, in the lock file.

Code follows:

' Who_Has.bas
' VBA Module to see who has the current Acad drawing open
 
Option Explicit
 
' Note we use an Alias here as using the Actual
' function name will not be accepted, because of the underscore in the name
Private Declare Function lOpen Lib "kernel32" Alias "_lopen" (ByVal lpPathName As String, ByVal iReadWrite As Long) As Long
Private Declare Function lClose Lib "kernel32" Alias "_lclose" (ByVal hFile As Long) As Long
 
 
' the Constant below:
' Private Const OF_SHARE_EXCLUSIVE = &H10
' OPENS the FILE in EXCLUSIVE mode, denying other processes AND the current
' process both read and write access to the file. If the file has been opened in
' any other mode for read or write access _lopen fails.
Private Const OF_SHARE_EXCLUSIVE = &H10
 
Sub WhoHasMain()
    ' Declare Variables up front
    Dim MyDocument As AcadDocument
    Dim docPath As String, msg As String
    Dim retCode As Variant, retVnt As Variant
 
    ' get Curent Drawing Object
    Set MyDocument = Application.ActiveDocument
 
    If MyDocument Is Nothing Then
        MsgBox "There are no documents open in AutoCad.", vbInformation, "Drawing Info"
     Else
        docPath = MyDocument.FullName   ' get the path of the drawing
        If docPath = "" Then
            MsgBox "This Drawing has not yet been saved to disk. ", vbInformation, "Drawing Info"
        Else
            If IsFileAlreadyOpen(docPath) = True Then
                   retVnt = DwgUserInfo(docPath)    ' get user Info
 
                   If IsEmpty(retVnt) Then    ' CANT FIND ACAD LOCK FILE
                        msg = "This Drawing is not locked by Autocad." & vbCrLf & "It may be locked by another application, like Vault."
                        MsgBox msg, vbInformation, "Unable to determine status"
                   Else
                        msg = "This Drawing is opened by user name: " & retVnt(0) & vbCrLf
                        msg = msg & "The drawing was opened from computer name : " & retVnt(1) & vbCrLf
                        msg = msg & "It was last locked on : " & retVnt(2) & vbCrLf
                        MsgBox msg, vbInformation, "Drawing Information"
                    End If
                 Else
 
                    ' see if it has a read-only attrib set
                    msg = Dir$(docPath, vbReadOnly)
                    If msg > "" Then   ' it DOES
                        msg = "This Dwg is not listed as being open by another user."
                        msg = msg & vbCrLf & "But it does have a Read-Only lock on it." & vbCrLf
                        msg = msg & "It may be locked by the Vault, or another application."
                        MsgBox msg, vbExclamation, "Drawing Info"
                    Else
                        MsgBox "This Drawing is not listed as being open by another user.", vbInformation, "Who has this open?"
                    End If
 
                End If
        End If
     End If
 
     Set MyDocument = Nothing
 
 
End Sub
 
 
Private Function IsFileAlreadyOpen(strFullPath_FileName As String) As Boolean
    ' If this Function succeeds, the return value is a File handle.
    ' If this Function fails, the return value is HFILE_ERROR = -1
    Dim hdlFile As Long, lastErr As Long
 
    hdlFile = -1    ' set to default return code
 
    ' Open file for Read/Write and Exclusive Sharing.
    hdlFile = lOpen(strFullPath_FileName, OF_SHARE_EXCLUSIVE)
 
    ' If we can't open the file, get the last error.
    If hdlFile = -1 Then
        lastErr = Err.LastDllError
    Else    ' Make sure we close the file on success!
        lClose (hdlFile)
    End If
 
    ' Check for sharing violation error.
    IsFileAlreadyOpen = (hdlFile = -1) And (lastErr = 32)
 
End Function
 
 
Private Function DwgUserInfo(strFullPath As String) As Variant
    ' returns user info for who opened file,or error message
 
    Dim TrimExt As String
    Dim strLen As Integer, I As Integer
    Dim DotPosition As Integer, NextFile As Integer
    Dim FoundChar As String
    Dim LockedByAcad As Boolean
    Dim foundFile As String, tmpStr As String
 
    ' Declare String Array fr User Info
    Dim UserInfo(2) As String
 
    strLen = Len(strFullPath)
    ' Build a string containing the path to the acad document, and substitute
    ' the ".dwg" for ".dwl", which is a hidden lock file created by Autocad when
    ' the drawing is opened by a user.
 
    For I = strLen To 1 Step -1
        FoundChar = Mid$(strFullPath, I, 1)
        If FoundChar = "." Then   ' found last dot
            DotPosition = I
            TrimExt = Left$(strFullPath, DotPosition)
            Exit For
        End If
    Next I
 
    ' Add the Lock file extension
    TrimExt = TrimExt & "dwl"
 
    ' make sure file is there
    foundFile = Dir$(TrimExt, vbHidden)
    If foundFile > "" Then
 
        NextFile = FreeFile
        Open TrimExt For Input As #NextFile
        Line Input #NextFile, tmpStr
        Close NextFile
        DwgUserInfo = Split(tmpStr, Chr$(10))
 
    Else  ' NOT LOCKED BY AUTOCAD
 
        Exit Function
   End If
 
 
End Function
Login

Sign up now and upload your code to the website.

Help us to continue.....
Statistics
Articles View Hits
2236246
Latest Articles