Author Topic: xrefs - differentiating between 'unloaded' and 'not found' in VBA  (Read 6707 times)

0 Members and 1 Guest are viewing this topic.

lambwill

  • Guest
Hi there, this is my first post here so hello all - nice to meet you :)

Now down to business:

I'm trying to write a macro that will fix a very messy bunch of drawings that I have inherited. For the most part I have this Macro running sweet and saving me a ton of time & stress, however I have one sticking point. As I have inherited these drawings form another location, all of my xref paths are broken. Of course this can easily be fixed using the "PROJECTNAME" variable to change the search path for missing xrefs and reloading all of them, however some xrefs are referenced but unloaded and need to stay that way. I've been searching around for a way to differentiate between an xref which is unloaded, and one with a broken path (i.e. 'not found') but I can't find a way anywhere. The majority of my programming experience is with VBA, so a solution in this language would be best - but I have enough experience in LISP to understand it if need be.

Thanks in advance for any help

SomeCallMeDave

  • Guest
Re: xrefs - differentiating between 'unloaded' and 'not found' in VBA
« Reply #1 on: June 28, 2006, 08:41:11 AM »
Here is something that I wrote several years ago (and haven't looked at since :) ).  So I don't remember how well it worked then and don't know if it will work now, but it may get you started.

Code: [Select]
Option Explicit
Public Enum XRefStatus
  xrloaded = 1
  xrdetached = 2
  xrNotFound = 3
End Enum



Public Sub test()
  Dim colBlocks As AcadObject
  Dim objBlock As AcadBlock
  Dim objXRefDbase1 As AcadDatabase
  Dim objXRefDbase2 As AcadDatabase
  Dim objXref As AcadExternalReference
  Dim varXref() As Variant
  Dim intCount As Integer
 

 
  Set colBlocks = Me.Blocks
    For Each objBlock In colBlocks
      If objBlock.IsXRef Then
        Select Case GetXRefStatus(objBlock)
          Case 1 'xrloaded
            MsgBox "Xref " & objBlock.Name & " is Loaded"
          Case 2 'xrdetached
            MsgBox "Xref " & objBlock.Name & " is Detached"
          Case 3 'xrnotfound
            MsgBox "Xref " & objBlock.Name & " was not found"
          Case Else
            MsgBox "Xref " & objBlock.Name & " has me confused"
        End Select
      End If
    Next objBlock
   
 
 
 

End Sub

Public Function GetXRefStatus(pXRef As AcadBlock) As XRefStatus
  Dim xStatus As XRefStatus
  Dim objTestObj As Object
 
  On Error GoTo XRefStatus_Error
   
  If pXRef.Count > 1 Then
    GetXRefStatus = xrloaded
    Exit Function
  End If
 
  If pXRef.Count = 1 Then
    If pXRef(0).ObjectName = "AcDbText" Then
      If pXRef(0).TextString Like "*" & pXRef.Name & "*" Then
        GetXRefStatus = xrNotFound
        Exit Function
      Else ' it only has one item, and that item is text
        GetXRefStatus = xrloaded
        Exit Function
      End If
    Else ' it only has one object in it, but that item isnt text
      GetXRefStatus = xrloaded
      Exit Function
    End If
  End If
 
  If pXRef.Count = 0 Then 'either unloaded or empty xref
    'unloaded xrefs have no database so this will raise an error
    Set objTestObj = pXRef.XRefDatabase
    GetXRefStatus = xrloaded ' if it gets to here, then the xref is attached but
    Exit Function            ' contains no objects
  End If
 
XRefStatus_Error:
  Select Case Err.Number
    Case -2145386390 ' no database error
      GetXRefStatus = xrdetached
      Err.Clear
      Exit Function
    Case Else
      MsgBox Err.Number
      Debug.Print "Error " & Err.Number
      Err.Clear
      Exit Function
  End Select

End Function



lambwill

  • Guest
Re: xrefs - differentiating between 'unloaded' and 'not found' in VBA
« Reply #2 on: June 28, 2006, 09:19:16 AM »
I had to change the 'Me' to 'ThisDrawing' in line 15 (Set colBlocks = Me.Blocks) to get it to work for me, but that my friend may very well be just the bit of code I was looking for!
Thank you very much :)

SomeCallMeDave

  • Guest
Re: xrefs - differentiating between 'unloaded' and 'not found' in VBA
« Reply #3 on: June 28, 2006, 09:22:14 AM »
You're welcome.  Hope it helps

MP

  • Seagull
  • Posts: 17750
  • Have thousands of dwgs to process? Contact me.
Re: xrefs - differentiating between 'unloaded' and 'not found' in VBA
« Reply #4 on: June 28, 2006, 09:27:40 AM »
See this post from this thread. Best of luck coding a pure vb[a] equivalent that utilizes dxf group code 71.

PS: Welcome to the swamp.

:)
Engineering Technologist • CAD Automation Practitioner
Automation ▸ Design ▸ Drafting ▸ Document Control ▸ Client
cadanalyst@gmail.comhttp://cadanalyst.slack.comhttp://linkedin.com/in/cadanalyst

Bob Wahr

  • Guest
Re: xrefs - differentiating between 'unloaded' and 'not found' in VBA
« Reply #5 on: June 28, 2006, 10:59:26 AM »
I remember that Dave.  You did that for me on a similar question.

lambwill

  • Guest
Re: xrefs - differentiating between 'unloaded' and 'not found' in VBA
« Reply #6 on: June 28, 2006, 11:21:33 AM »
See this post from this thread. Best of luck coding a pure vb[a] equivalent that utilizes dxf group code 71.

I have to say, that thread went right over my head. Thankfully Dave's code fitted the bill perfectly, so I won't give my self a hernia attempting to understand it right now. Is there a significant advantage in using LISP in this situation?

MP

  • Seagull
  • Posts: 17750
  • Have thousands of dwgs to process? Contact me.
Re: xrefs - differentiating between 'unloaded' and 'not found' in VBA
« Reply #7 on: June 28, 2006, 11:28:43 AM »
Is there a significant advantage in using LISP in this situation?

It's prettier? Just kidding.

As I read it: in vb it's deductive, in lisp it's definitive. In the end that may be only academic and of no consequence to your solution.
Engineering Technologist • CAD Automation Practitioner
Automation ▸ Design ▸ Drafting ▸ Document Control ▸ Client
cadanalyst@gmail.comhttp://cadanalyst.slack.comhttp://linkedin.com/in/cadanalyst

SomeCallMeDave

  • Guest
Re: xrefs - differentiating between 'unloaded' and 'not found' in VBA
« Reply #8 on: June 28, 2006, 11:55:07 AM »
I agree with MP.  The code I posted is based on some undocumented conditions that worked at the time and could change and may not be valid for every situation.  It was just a quickie that seemed to work.

The values lot of the bit-code could change too, I guess. But one hopes that AutoDesk would document them.

SomeCallMeDave

  • Guest
Re: xrefs - differentiating between 'unloaded' and 'not found' in VBA
« Reply #9 on: June 28, 2006, 01:41:33 PM »
What a great way to spend a few rainy hours!!  Sure beats working.

Here is a VBA routine thats uses the 70 and 71 codes for xref status.  It requires a rereference to the VLisp ActiveX Module (vl16.tlb for version 2004, 2005, 2006,  in the AutoCAD installation folder.  On my computer, anyway.  You may have to search for it)

I haven't fully tested it, but it appears to work in the testing that I have done.


Code: [Select]
Public Sub XRefTest2()

  Dim colBlocks As AcadObject
  Dim objBlock As AcadBlock
  Dim testBlock As AcadObject
  Dim Flag70 As Variant
  Dim Flag71 As Variant
  Dim sHandle1 As String
  Dim sHandle2 As String
  Dim sBlockName As String

  Set colBlocks = Me.Blocks
    For Each objBlock In colBlocks
      If objBlock.IsXRef Then
        sHandle1 = "&H" + objBlock.Handle
        sBlockName = objBlock.Name
        sHandle2 = Hex(sHandle1 + 1)
        Set testBlock = ThisDrawing.HandleToObject(sHandle2)
        Flag70 = vbAssoc(testBlock, 70)
        Flag71 = vbAssoc(testBlock, 71)
        If Flag71 = "1" Then
            MsgBox sBlockName & " appears to be UNLOADED "
        ElseIf (Val(Flag70) And 32) = 32 Then MsgBox sBlockName & " appears to be LOADED and RESOLVED "
        ElseIf (Val(Flag70) And 4) = 4 Then MsgBox sBlockName & " appears to be NOT FOUND "
        End If
      End If
    Next objBlock
End Sub

Public Function vbAssoc(pAcadObj As AcadObject, pDXFCode As Integer) As Variant

Dim VLisp As Object
Dim VLispFunc As Object
Dim varRetVal As Variant

Dim obj1 As Object
Dim obj2 As Object

Dim strHnd As String
Dim strVer As String

Dim lngCount As Long
Dim i As Long
Dim j As Long

On Error GoTo vbAssocError

strHnd = pAcadObj.Handle

If Me.Application.Version = "16.0" Then
  Set VLisp = ThisDrawing.Application.GetInterfaceObject("VL.Application.16")
Else
  Set VLisp = ThisDrawing.Application.GetInterfaceObject("VL.Application.1")
End If

Set VLispFunc = VLisp.ActiveDocument.Functions

Set obj1 = VLispFunc.Item("read").funcall("pDXF")
  varRetVal = VLispFunc.Item("set").funcall(obj1, pDXFCode)
Set obj1 = VLispFunc.Item("read").funcall("pHandle")
  varRetVal = VLispFunc.Item("set").funcall(obj1, strHnd)
Set obj1 = VLispFunc.Item("read").funcall("(vl-princ-to-string (cdr (assoc pDXF (entget (handent pHandle)))))")
  varRetVal = VLispFunc.Item("eval").funcall(obj1)
 
vbAssoc = varRetVal

'clean up the newly created LISP symbols
Set obj1 = VLispFunc.Item("read").funcall("(setq pDXF nil)")
  varRetVal = VLispFunc.Item("eval").funcall(obj1)
Set obj1 = VLispFunc.Item("read").funcall("(setq pHandle nil)")
  varRetVal = VLispFunc.Item("eval").funcall(obj1)
 
'release the objects or Autocad gets squirrely
Set obj2 = Nothing
Set obj1 = Nothing
Set VLispFunc = Nothing
Set VLisp = Nothing

Exit Function

vbAssocError:
  Set obj2 = Nothing
  Set obj1 = Nothing
  Set VLispFunc = Nothing
  Set VLisp = Nothing
  MsgBox "Error occurred " & Err.Description

End Function


It might be overkill, but playing with it sure was fun

Bob Wahr

  • Guest
Re: xrefs - differentiating between 'unloaded' and 'not found' in VBA
« Reply #10 on: June 28, 2006, 02:10:35 PM »
Cool stuff Dave.  That's going to see some usage.

MP

  • Seagull
  • Posts: 17750
  • Have thousands of dwgs to process? Contact me.
Re: xrefs - differentiating between 'unloaded' and 'not found' in VBA
« Reply #11 on: June 28, 2006, 02:15:50 PM »
Quote from: SomeCallMeDave
It might be overkill, but playing with it sure was fun

Heh, heh, man after my own heart.

PS: If I'm not mistaken, some of that code is directly attributable to Mr. Tanzillo, you might consider an appropriate nod in that direction.

Engineering Technologist • CAD Automation Practitioner
Automation ▸ Design ▸ Drafting ▸ Document Control ▸ Client
cadanalyst@gmail.comhttp://cadanalyst.slack.comhttp://linkedin.com/in/cadanalyst

SomeCallMeDave

  • Guest
Re: xrefs - differentiating between 'unloaded' and 'not found' in VBA
« Reply #12 on: June 28, 2006, 02:33:42 PM »
Thanks Bob.

Right MP.  Thanks and credit goes to ACADX.com for the VLAX.cls module.   That credit used to be a comment in the code.  I don't know where it went.
« Last Edit: June 28, 2006, 02:44:25 PM by SomeCallMeDave »