Comment renommer la majeure partie des fichiers AutoCAD (.dwg) avec un texte inséré dans le même dessin?

Question

J'ai environ 50k fichiers de dessin dans un répertoire que j'ai importé d'un outil de gestion de fichiers appelé Wrench.

Le problème est que chacun de ces dessins ont un numéro de dessin unique qui est censé être le nom du fichier. Mais pendant le téléchargement, les noms ont été changés en une série de nombres différente. Je dois donc remplacer les noms de fichier par le numéro de dessin réel qui est indiqué dans le coin inférieur droit du dessin. Le numéro de dessin est inséré en tant qu'objet texte AutoCAD dans le fichier.

Je suis conscient des scripts disponibles pour le renommage en masse des fichiers, mais j'ai besoin d'aide en particulier pour accéder aux fichiers .dwg afin d'extraire le numéro de dessin des objets texte.

Answer 1

Depuis qu'Autodesk a cessé d'inclure VBA dans Autocad, je ne peux le faire que dans un VBA Excel.

Copiez et collez le code ci-dessous dans l'éditeur VBA d'Excel. N'oubliez pas de «vérifier» la bibliothèque de types AutoCAD dans l'outil, Références.

De plus, vous devez modifier les éléments suivants.

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