[编程交流] VB外部参照搜索

Option Explicit
Sub CHANGEXREFS ()
Dim AcadDbx As AxdbDocument
Dim Direc As String
Dim Elem as object
Dim Filenom as string
Dim Wholefile as string
Set AcadDbx = GetInterfaceObject("OjectDBX.AxDbDocument.17")
On Error Resume Next
Direc = "c:\program files\AutoCAD Civil 3D 2008\Sample" 'Change to your directory or link directory to a form
Filenom = Dir$(Direc & "\*.dwg")
Do While filenom <> ""
Wholefile = Direc & "" & filenom
msgbox wholefile ' i just put this here to show you that it is opening the files
AcadDbx.open Wholefile
For Each Elem In AcadDbx.Blocks
   If elem.IsXRef = True and elem.name = "Base-Drawing" then
Msgbox "PUT YOUR CODE HERE WHAT YOU WNAT TO DO WITH THE XREF" 
'it should be something like 'elem.Detach = true (cant remember)
End if
Next 'Next Elem
Set Elem = Nothing
Filenom = Dir$
Loop
set AcadDbx = Nothing
end sub

 
For Each Elem In [color=black]AcadDbx.Blocks[/color]
   If Elem.IsXRef = True And Elem.Name = "[color=black]Base-Drawing"[/color] Or Elem.IsXRef = True And Elem.Name = "Temp-Base" Then
   Elem.Detach
   End If
Next

For Each Elem In AcadDbx.Blocks
   If Elem.IsXRef = True And (Elem.Name = "Base-Drawing" Or Elem.Name = "Temp-Base") Then
   Elem.Detach
   End If
Next