VBA sample

HomeHome BlogBlog TwitterTwitter YouTubeYouTube ContactContact
 
 
 

Blog Headlines


Subscribe to the blog


 
 

SavedTo2004.dvb sample code for AutoCAD

This code is handy if you want to notify the user when a drawing is saved in 2004 format even though the format in Options>Open and Save>Save as is set to anything other than 2004. Command that are found are all commands making a save of the drawing (like SAVE, QSAVE, SAVEAS, COPYCLIP, WBLOCK). Example when using WBLOCK the following might be showed on the command line:

Command: w
WBLOCK
C:\temp\Aec ISO A0.dwg Saved in 2004 format

You can put this in any existing code you have autoloaded or make sure you you have SavedTo2004.dvb autoloaded.

If you don't have any acad.dvb file you can rename WblockTo2000.dvb to acad.dvb and place it at a path that is in the Support File Search Path.

You cannot load VBA until an AutoCAD VBA command is issued. If you want to load VBA automatically every time you start AutoCAD include the line acvba.arx in the acad.rx file.
 

' By Jimmy Bergmark
' Copyright (C) 1997-2003 JTB World, All Rights Reserved
' Website: www.jtbworld.com
' E-mail: info@jtbworld.com
Public Function DrawingVersion(strFullPath As String) As String
On Error Resume Next
  Dim i As Long
  Dim bytVersion(0 To 5) As Byte
  Dim strVersion As String
  Dim lngFile As Long
  If Len(Dir(strFullPath)) > 0 Then
    lngFile = FreeFile
    Open strFullPath For Binary Access Read As lngFile
    Get #lngFile, , bytVersion
    Close lngFile
    strVersion = StrConv(bytVersion(), vbUnicode)
  End If
  If Len(strVersion) > 0 Then
    DrawingVersion = strVersion
  Else
    DrawingVersion = "NEWNEW"
  End If
End Function

Private Sub AcadDocument_EndSave(ByVal FileName As String)
On Error Resume Next
Dim dv As String
    If ThisDrawing.Application.Preferences.OpenSave.SaveAsType <> ac2004_dwg Then
        dv = DrawingVersion(FileName)
        If (dv = "AC402b" Or dv = "AC1018") Then
            ThisDrawing.Utility.Prompt vbNewLine & FileName & " Saved in 2004 format" & vbNewLine
        End If
    End If
End Sub
 
© 2001-2013 JTB World. All rights reserved.