IT Knowledge Base

很少使用AutoCAD內的VBA，因為工作的需要，Lisp好像不是太容易做到出來，那就看看另一工具VBA又如何。

今次的目的，是把一大堆(數以萬張)的圖檔(Drawing)中的Xref找出來。一張半張時，您我用人手倒不是問題，但到了真的是萬張圖檔時，花兩三天時間在程式上，還是比用純人手好。

Dim index As Integer
''Create an array to store the Xref information.
Dim storeData(20) As String

Public Sub getXref()
Dim tempDoc As AcadDocument
Dim filePath As String
''fileList.txt stores the full path and filename of the opened file.
Open "fileList.txt" For Input As #1
Input #1, filePath
''Open the destination file.
Set tempDoc = ThisDrawing.Application.Documents.Open(filePath)
ThisDrawing.Application.ZoomAll
''Call runMe sub program.
Call runMe
tempDoc.Close
Close #1
End Sub

Private Sub runMe()
index = 1
''Check the Xref of drawing.
Call dwgRef
''Check the Xref in model space of drawing.
Call msRef
''Check the Xref in paper space of drawing.
Call psRef
''Display the result.
For i = 1 To index - 1
MsgBox (storeData(i))
Next i
End Sub

Private Sub dwgRef()
Dim tempblock As AcadBlock
For Each tempblock In ThisDrawing.Blocks
If tempblock.IsXRef Then
wData (tempblock.Path)
End If
Next
End Sub

Private Sub psRef()
Dim i As Integer, count As Integer
Dim tempObj As AcadObject
Dim tempLayout As AcadLayout
Dim tempblock As AcadBlock
For Each tempLayout In ThisDrawing.Layouts
If tempLayout.Name <> "Model" Then
For Each tempObj In tempLayout.Block
Call selData(tempObj)
Next
End If
Next
End Sub

Private Sub msRef()
Dim i As Integer, count As Integer
Dim tempObj As AcadObject
count = ThisDrawing.ModelSpace.count
For i = 1 To count
Set tempObj = ThisDrawing.ModelSpace.Item(i - 1)
Call selData(tempObj)
Next i
End Sub

Private Sub selData(tempObj As AcadObject)
Dim tempImage As AcadRasterImage
Dim tempBlockRef As AcadBlockReference
Dim tempblock As AcadBlock
Dim tempDGN As AcadDgnUnderlay
Dim tempDWF As AcadDwfUnderlay
Dim tempDocument As AcadDocument
''Check the object properties is image, DGN reference, DWF reference.
Select Case tempObj.ObjectName
Case "AcDbRasterImage"
Set tempImage = tempObj
Call wData(tempImage.ImageFile)
Case "AcDbDgnReference"
Set tempDGN = tempObj
Call wData(tempDGN.File)
Case "AcDbDwfReference"
Set tempDWF = tempObj
Call wData(tempDWF.File)
End Select
End Sub

Private Sub wData(tempString As String)
Dim i As Integer, flag As Boolean
flag = True
For i = 1 To index - 1
If tempString = storeData(i) Then
flag = False
Exit For
End If
Next i
''Write the data into array.
If flag = True Then
storeData(index) = tempString
index = index + 1
End If
End Sub