AutoCAD 2010/2011/2012

Reply
Active Member
10 Posts
1 Kudo
Registered: ‎06-11-2011
Post 11 of 12

Re: file size

04-10-2012 10:37 AM in reply to: jerome.chamfray

I finally have a solution :smileyhappy:

 

The steps are as follow:

  • Remove the hidden blocks
  • Remove registered applications
  • export the dwg as a dxf format
  • close the dwf file
  • reopen the dxf file
  • purge the file
  • save back as dwg

 

See below my final codes for the entire directory:

Sub PurgeEverything()
'Make sure that you also have a blank drawing open in the backgroung
'A Sub Folder "export" in the MyPath Directory must be present

 

Dim MyFile, MyPath, MyName

MyPath = "C:\Directory\"    ' Set the path.

' Returns filename with specified extension. If more than one *.ini
' file exists, the first file found is returned.
MyFile = Dir(MyPath + "*.dwg")
' Call Dir again without arguments to return the next *.INI file in the
' same directory.

Do While MyFile <> ""    ' Start the loop.
    ' Ignore the current directory and the encompassing directory.
    If MyFile <> "." And MyFile <> ".." Then
        ' Use bitwise comparison to make sure MyName is a directory.
        If (GetAttr(MyPath & MyFile) And vbDirectory) = vbDirectory Then
            Debug.Print MyFile    ' Display entry only if it
        End If    ' it represents a directory.
    End If
  


''open the drawing
ThisDrawing.Application.Documents.Open (MyPath + MyFile)


'Wait for a second
SendKeys "{ESC}", True
Dim PauseTime, Start, Finish, TotalTime
    PauseTime = 1    ' Set duration.
    Start = Timer    ' Set start time.
    Do While Timer < Start + PauseTime
        DoEvents    ' Yield to other processes.
    Loop
   

 


''Purge all the blocks

'Sub PurgeBlocks()
Dim ssBlocks As AcadBlocks
Dim oObj As Object
Dim oBlock As AcadBlock

Set ssBlocks = ThisDrawing.Blocks
        Debug.Print "There are ", ssBlocks.Count, " blocks in the drawing database"
        For Each oObj In ssBlocks
            If TypeOf oObj Is AcadBlock Then
                Set oBlock = oObj
                Debug.Print oBlock.Name,
                If oBlock.IsLayout = False Then
                    On Error Resume Next
                    oBlock.Delete
                    If Err <> 0 Then
                        Debug.Print Err.Description
                        Err.Clear
                    Else
                        Debug.Print "has been purged"
                    End If
                Else
                    Debug.Print
                End If
                On Error GoTo 0
            End If
        Next
        
        
       
''Regapps
'Verify registered apps when drawing loads
'Private Sub VerifyRegistered_Apps()
Dim oRegApp As AcadRegisteredApplication
Dim oRegApps As AcadRegisteredApplications
Dim colBadApps As Collection
Dim strMSG As String
Dim i As Integer

'get the current collection of registered apps
Set oRegApps = ThisDrawing.RegisteredApplications

' start a new collection for bad apps
Set colBadApps = New Collection

' review each registered application
For Each oRegApp In oRegApps
'Debug.Print oRegApp.Name
' if there's a "*" in the name, **** good chance it's BAD!
If InStr(1, oRegApp.Name, "*") > 0 Then
colBadApps.Add oRegApp.Name
End If
Next

' if we found some bad apps, report them!
If colBadApps.Count > 0 Then
'build list of bad ones
For i = 1 To colBadApps.Count
strMSG = strMSG & colBadApps.Item(i) & vbNewLine
Next

'display the bad news
MsgBox "There's a good chance this drawing has corruputed data!" & vbNewLine & _
"INVALID REGISTERED APPS FOUND!" & vbNewLine & _
strMSG
End If

Set colBadApps = Nothing
Set oRegApp = Nothing
Set oRegApps = Nothing


''Purge the drawing
ThisDrawing.PurgeAll

Dim FileName As String
Dim FileLoc As String
Dim FullPath As String
Dim NewFullPath As String


''Export the drawing as a dxf
FileLoc = ThisDrawing.Path
FileName = ThisDrawing.Name

FullPath = FileLoc + "\export\" + FileName

ThisDrawing.SaveAs FullPath, ac2010_dxf

NewFullPath = ThisDrawing.Path + "\" + ThisDrawing.Name

''Close the drawing
ThisDrawing.Close

''Reopen the dxf drawing
ThisDrawing.Application.Documents.Open (NewFullPath)

'Wait for a second
SendKeys "{ESC}", True
    PauseTime = 1    ' Set duration.
    Start = Timer    ' Set start time.
    Do While Timer < Start + PauseTime
        DoEvents    ' Yield to other processes.
    Loop
'' Purge the drawing
ThisDrawing.PurgeAll

''Save the dxf as dwg
ThisDrawing.SaveAs FullPath, acNative

ThisDrawing.Close

 MyFile = Dir    ' Get next drawing entry.

Loop

End Sub

New Member
1 Posts
0 Kudos
Registered: ‎04-12-2012
Post 12 of 12

Re: file size

04-12-2012 02:40 AM in reply to: Alfred.NESWADBA

Thanks for the useful info....

Post to the Community

Have questions about Autodesk products? Ask the community.

New Post
Announcements
Are you interested in helping shape the future of the Autodesk Community? To participate in this brief usability study, please click here. Your time and input is greatly appreciated!