XREF re-association question (VBA)

[TroutKing]

(I am working with AutoCAD 2000/2002)

 

Hello

I have a question that I am hoping to get help with. I do not know if this can be done, so I can’t supply any beginning code with questions for the board.

 

Let me explain first what I am trying to accomplish.

I have literally thousands of drawings that I need to rename. That in itself is a pain but I will plod through it. However, in the process of accomplishing that task, another issue arises. The XRefs that were previously attached to the main drawings will not load now because they were also renamed. If you look at my attached JPG you will see what I am referring to.

 

So……. the first question is:

Can a VBA macro be written that will update the XRefs for each main drawing within the folder structure? (open each main drawing and replace the initial XRef name with the new XRef name)

 

And the second question is:

If this can be done - Can someone please supply me with as much information/code as possible to accomplish this task?

 

Because my time involved in programming is so sporadic and limited, my VBA programming knowledge is somewhat narrow, so I usually need to be led around.

 

I would appreciate as much help as I can get.

 

Thank you

Mike

[borgunit]

A nice free renaming program...

http://rename.lupasfreeware.org

 

It can be done, you basically delete the old XREF and "re-insert" the new one. We have done a few similar things.

[smorales02]

Not sure but does 2002 have Reference Manager??

 

Start-All Programs-Autodesk-Autocad 2002-Reference Manager

[TroutKing]

Thanks borgunit. I may be able to use that program to help me expedite the renaming process. That could save me a lot of time.

 

smorales02 - I don't see such an animal, but thank you.

[borgunit]

Here is a starter piece...

 

Private Function GetXrefPath() As String
'------------------------------------------------------------------------------
'
'Returns:   XREF drawing path i.e. "SomeDrawing.dwg"
'Caveats:   Assuming no nested xrefs and only one per drawing
'------------------------------------------------------------------------------
Dim acXref As AcadExternalReference
Dim acSS As AcadSelectionSet
Dim acBlks As AcadBlocks
Dim acBlk As AcadBlock
Dim acEnt As AcadEntity
Dim sPath As String
Dim sEntType As String
'''''''''''''''''''''''''''''''''''''''
On Error GoTo ErrHandler

sEntType = "INSERT"
Set acSS = GetEntitySS(sEntType)
Set acBlks = ThisDrawing.Blocks

For Each acEnt In acSS
   Set acBlk = acBlks(acEnt.Name)
   If acBlk.IsXRef Then
       Set acXref = acEnt
       sPath = acXref.Path
       Exit For
   End If
Next acEnt

GetXrefPath = sPath

ExitHere:
   Exit Function
ErrHandler:
   Debug.Print Err.Number, Err.description, "Function 'GetXrefPath' Failed"
End Function

[CapoferriSerramenti]

Here is a starter piece...

 

Private Function GetXrefPath() As String
'------------------------------------------------------------------------------
'
'Returns:   XREF drawing path i.e. "SomeDrawing.dwg"
'Caveats:   Assuming no nested xrefs and only one per drawing
'------------------------------------------------------------------------------
Dim acXref As AcadExternalReference
Dim acSS As AcadSelectionSet
Dim acBlks As AcadBlocks
Dim acBlk As AcadBlock
Dim acEnt As AcadEntity
Dim sPath As String
Dim sEntType As String
'''''''''''''''''''''''''''''''''''''''
On Error GoTo ErrHandler

sEntType = "INSERT"
Set acSS = GetEntitySS(sEntType)
Set acBlks = ThisDrawing.Blocks

For Each acEnt In acSS
   Set acBlk = acBlks(acEnt.Name)
   If acBlk.IsXRef Then
       Set acXref = acEnt
       sPath = acXref.Path
       Exit For
   End If
Next acEnt

GetXrefPath = sPath

ExitHere:
   Exit Function
ErrHandler:
   Debug.Print Err.Number, Err.description, "Function 'GetXrefPath' Failed"
End Function

 

 

that's what i need!!

 

only one question, could you please give me the "GetEntitySS" function you use here?

 

thanks a lot!

Luca Capoferri