社区 › VB › 检查是否打开了图形（文件）

iliekater 发表于 2007-12-8 06:52:17

检查是否打开了图形（文件）

有可能用VBA代码找到AutoCAD是否有打开的文件，或者根本没有打开的文件吗？
**** Hidden Message *****

Humbertogo 发表于 2007-12-9 08:35:33

'Sample Code: Microsoft Visual Basic version of IsFileAlreadyOpen
'----------------------------------------------------------------
      ' Declaration for APIs used by our function...
      Private Declare Function lopen Lib "kernel32" Alias "_lopen" (ByVal
      lpPathName As String, ByVal iReadWrite As Long) As Long
      Private Declare Function GetLastError Lib "kernel32" () As Long
      Private Declare Function lclose Lib "kernel32" Alias "_lclose" (ByVal
      hFile As Long) As Long
      Function IsFileAlreadyOpen(Filename As String) As Boolean
         Dim hFile As Long
         Dim lastErr As Long
         ' Initialize file handle and error variable.
         hFile = -1
         lastErr = 0
         ' Open for for read and exclusive sharing.
         hFile = lopen(Filename, &H10)
         ' If we couldn't open the file, get the last error.
         If hFile = -1 Then
            lastErr = Err.LastDllError
         ' Make sure we close the file on success.
         Else
            lclose (hFile)
         End If
         ' Check for sharing violation error.
         If (hFile = -1) And (lastErr = 32) Then
            IsFileAlreadyOpen = True
         Else
            IsFileAlreadyOpen = False
         End If
      End Function

iliekater 发表于 2007-12-12 01:56:11

好，我试试看！

Ricky_76 发表于 2007-12-13 13:00:50

您好，
现在无法尝试使用它来提供完美的代码
但我认为它是这样的：
msgbox application.documents。计数
希望它能工作
/r
ps
我希望我已经理解了你的问题。。。

Humbertogo 发表于 2007-12-14 03:20:34

检查这个

      ' Declaration for APIs used by our function...
      Private Declare Function lopen Lib "kernel32" Alias "_lopen" (ByVal lpPathName As String, ByVal iReadWrite As Long) As Long
      Private Declare Function GetLastError Lib "kernel32" () As Long
      Private Declare Function lclose Lib "kernel32" Alias "_lclose" (ByVal hFile As Long) As Long
Sub test()
IsFileAlreadyOpen ("P:\Autocad\Library\Test.dwg")
End Sub
      Function IsFileAlreadyOpen(Filename As String) As Boolean
         Dim hFile As Long
         Dim lastErr As Long
         ' Initialize file handle and error variable.
         hFile = -1
         lastErr = 0
         ' Open for for read and exclusive sharing.
         hFile = lopen(Filename, &H10)
         ' If we couldn't open the file, get the last error.
         If hFile = -1 Then
            lastErr = Err.LastDllError
         ' Make sure we close the file on success.
         Else
            lclose (hFile)
         End If
         ' Check for sharing violation error.
         If (hFile = -1) And (lastErr = 32) Then
            IsFileAlreadyOpen = True
            MsgBox Filename & " Is Already Open"
         Else
            IsFileAlreadyOpen = False
            ThisDrawing.Application.Documents.Open Filename
         End If
      End Function

iliekater 发表于 2008-3-2 05:11:27

非常感谢Ricky_76，
代码对我来说已经足够了！

查看完整版本: 检查是否打开了图形（文件）