How to rename bulk of AutoCAD (.dwg) files with a text inserted in the same drawing?

Question

I have about 50k drawing files in a directory I imported from a File handling tool called Wrench.

The problem is each of these drawings have a unique drawing number that's supposed to be the name of the file too. But while downloading the names have been changed to a different series of numbers. Thus I have to replace the file names with the actual drawing number that is given at the right bottom corner of the drawing. The drawing number is inserted as AutoCAD text object in the file.

I am aware of scripts available for bulk renaming of files but I need help especially with accessing .dwg files to extract the drawing number from the text objects.

Answer 1

Since Autodesk stopped including VBA to Autocad I can only do this in an excel VBA.

Copy and Paste the code below in the VBA editor of excel. Remember to 'check' the AutoCAD Type Library in the Tool, References.

Also, you have to change the following.

FolderPath

Autocad.Application

PtList

Sub Main()

Dim FileName As String
Dim FolderPath As String
Dim AcadDoc As AcadDocument
Dim PtList(11) As Double
Dim SelSet As AcadSelectionSet
Dim TextObj As Variant
Dim NewFileName As String


FolderPath = "C:\Users\UserName\Documents"      '<<--- Replace this with where your documents are

'-----------------Connect to the AutoCAD application-------------
Set acadApp = GetObject _
              (, "AutoCAD.Application.17")      'AutoCAD.Application.17  -  for 2008
                                                'AutoCAD.Application.18  -  for 2010
                                                'AutoCAD.Application.19  -  for 2013 - 2015
                                                'AutoCAD.Application.20  -  for 2016
                                                'AutoCAD.Application.21  -  for 2017
                                                'AutoCAD.Application.22  -  for 2018
If Err Then
    Err.Clear
    Set acadApp = CreateObject _
              ("AutoCAD.Application.17")        '<<---Change this too depending on you autocad version
    If Err Then
        MsgBox Err.Description
        Exit Sub
    End If
End If

'----------------------------------------------------------------

'-----Set the pts to be used for selecting the text object in the dwg file. The box must surround the text object-----

'1ST POINT (X,Y,Z)
PtList(0) = 603.9254
PtList(1) = -3.336
PtList(2) = 0

'2ND POINT (X,Y,Z)
PtList(3) = 1144.0586
PtList(4) = -3.336
PtList(5) = 0

'3RD POINT (X,Y,Z)
PtList(6) = 1144.0586
PtList(7) = -298.3247
PtList(8) = 0

'4TH POINT (X,Y,Z)
PtList(9) = 603.9254
PtList(10) = -298.3247
PtList(11) = 0

'---^^


'-----Loop through the files in the folder
FileName = Dir(FolderPath & "\*.dwg")
Do While Len(FileName) > 0

    'Set Acad document
    Set AcadDoc = acadApp.Documents.Open(FolderPath & "\" & FileName)

    'add a selection set
    Set SelSet = AcadDoc.SelectionSets.Add("test")

    'add items to the selection set using the points in the PtList
    SelSet.SelectByPolygon acSelectionSetCrossingPolygon, PtList

    'assuming that the selection will only select the text, assign the only item in the selection set to TextObj
    Set TextObj = SelSet.Item(0)

    'Store the new filename in a variable for later use
    NewFileName = TextObj.TextString

    'close the dwg file
    AcadDoc.SelectionSets("test").Delete
    AcadDoc.Close

    'rename
    Name FolderPath & "\" & FileName As FolderPath & "\" & NewFileName & ".dwg"

    'get the file name of the next dwg file next drawing, then continue loop
    FileName = Dir

Loop


End Sub