Wie Umbenennung von AutoCAD (.dwg) -Dateien mit einem Text in der gleichen Zeichnung umbenannt?

Question

Ich habe etwa 50k Zeichnungsdateien in einem Verzeichnis, das ich aus einem Dateihandhabungswerkzeug namens Wrench importiert habe.

Das Problem ist, dass jede dieser Zeichnungen eine eindeutige Zeichnungsnummer hat, die auch der Name der Datei sein soll. Während des Herunterladens wurden die Namen in eine andere Reihe von Zahlen geändert. Daher muss ich die Dateinamen durch die tatsächliche Zeichnungsnummer ersetzen, die in der rechten unteren Ecke der Zeichnung angegeben ist. Die Zeichnungsnummer wird als AutoCAD-Textobjekt in die Datei eingefügt.

Ich kenne Skripte für das Umbenennen von Dateien in großen Mengen, aber ich brauche Hilfe, vor allem beim Zugriff auf .dwg-Dateien, um die Zeichnungsnummer aus den Textobjekten zu extrahieren.

Answer 1

Seit Autodesk aufgehört hat, VBA zu Autocad zu integrieren, kann ich dies nur in einer Excel-VBA tun.

Kopieren Sie den folgenden Code und fügen Sie ihn in den VBA-Editor von Excel ein. Denken Sie daran, die AutoCAD-Typbibliothek im Werkzeug "Referenzen" zu überprüfen.

Außerdem müssen Sie Folgendes ändern.

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