如何使用插入到同一图形中的文本重命名大部分AutoCAD（.dwg）文件？

Question

在我从一个名为扳手的文件处理工具导入的目录中有大约50k个图形文件。在

问题是每一个图纸都有一个唯一的图纸编号，这个编号也应该是文件的名称。但是在下载的时候，名字被改成了一系列不同的数字。因此，我必须用图纸右下角给出的实际图纸编号替换文件名。图形编号将作为AutoCAD文本对象插入到文件中。在

我知道可以批量重命名文件的脚本，但我需要帮助，尤其是访问.dwg文件以从文本对象中提取图形编号。在

Answer 1

由于Autodesk停止将VBA包含到Autocad中，我只能在excel VBA中执行此操作。在

在excel的VBA编辑器中复制并粘贴下面的代码。请记住在工具“参照”中“检查”AutoCAD类型库。在

此外，您还必须更改以下内容。在

文件夹路径

在Autocad.应用程序在

列表

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