如何使用在同一圖形中插入的文本重命名AutoCAD（.dwg）文件的批量？

Question

我從一個名爲Wrench的文件處理工具導入的目錄中有大約50k的繪圖文件。

問題是這些圖紙中的每一個都有一個唯一的圖形編號，也應該是文件的名稱。但是，下載的名稱已被更改爲不同系列的數字。因此，我必須用圖紙右下角給出的實際圖紙編號替換文件名稱。圖形編號作爲AutoCAD文本對象插入到文件中。

我知道可用於批量重命名文件的腳本，但我需要幫助，特別是訪問.dwg文件以從文本對象中提取圖形編號。

Answer 1

由於Autodesk停止將VBA包括到Autocad中，我只能在Excel VBA中執行此操作。

將以下代碼複製並粘貼到excel的VBA編輯器中。請記住在工具，參考文獻中檢查AutoCAD類型庫。

此外，您必須更改以下內容。

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