Topic: count Xrefs in a dwg

[David Hall]

So what Im trying to do is count how many xrefs are in my drawing.  That part is simple
Here is that code

Code: [Select]

Public Sub PMS_Xref_Extract()
      Dim ss As AcadSelectionSet, intType(0 To 1) As Integer, varData(0 To 1) As Variant
      Dim objBlkXref As AcadExternalReference, strAssemblyName As String
           
      Erase SN
      Erase CNT
      ACADSelSet ss, "AssemblyCount"

      intType(0) = 0: varData(0) = "INSERT"
      intType(1) = 2: varData(1) = "SC-*"
      ss.Select Mode:=acSelectionSetAll, filtertype:=intType, filterdata:=varData
     
      For Each objBlkXref In ss
            If objBlkXref.Layer = "3D-CONSTRUCTION" Then
                  strAssemblyName = objBlkXref.EffectiveName
                  IncrimentCount strAssemblyName
            End If
      Next

      Dim fso, fl, fln, s
      Dim j As Integer
      fln = "M:\PARTS-LIST\PMS.txt"
      Set fso = CreateObject("Scripting.FileSystemObject")
      If fso.FileExists(fln) Then
            fso.DeleteFile fln
      End If
      Set fl = fso.CreateTextFile(fln)
      For j = 1 To UBound(SN)
            s = CNT(j) & vbTab & SN(j)
            fl.WriteLine s
      Next
      fl.Close
End Sub
The problem is I need to count an xref inside of the first one found.  I think this should be able to be done, but I have no clue.  I know it has to do with nested blocks, but I dont know anything beyond that. 

So I have a drawing named SC-04589-1211-162.dwg, which is a long name for a switch.  Inside that dwg is another xref, SC-09020.dwg, which I have used twice.  What I would like to have happen is when the above code is run, it returns (1) SC-04589-1211-162.dwg, and (2) instances of SC-09020.dwg

[Matt__W]

When you find out, you let me know, m'kay?

I tried to do something similar a while back but gave up because I couldn't figure out the nested block looping thing.  In other words, how far do you dig into the top-level xref?

[David Hall]

I know I only want to go one level deep, just to pick up the foundations for the switch.  I dont know where to start.  Matt, did you go through the block collection or did you grab the blocks and dig through them individually?

Here is a dwg file that should show what Im working with.  BTW, any electrical utility people out there that want to beta test my 3d Substation tool PM me.  This is a dwg using an USCO 138kV Vee switch

[Matt__W]

I know I only want to go one level deep, just to pick up the foundations for the switch.  I dont know where to start.  Matt, did you go through the block collection or did you grab the blocks and dig through them individually?

Here is a dwg file that should show what Im working with.  BTW, any electrical utility people out there that want to beta test my 3d Substation tool PM me.  This is a dwg using an USCO 138kV Vee switch

If I remember correctly I went through the block collection and when I found an xref, I then went through the xref's entities and when I came to an xref, I spit it out to the immediate window.  Never got much farther than that. 

[Bob Wahr]

Throw away what you don't need.

Code: [Select]

Option Explicit

Private colXrefs As New Collection

Private Sub Class_Initialize()
  'When the class is created
  Call LoadXrefs
End Sub

Private Sub LoadXrefs()
  Dim objSelSets As AcadSelectionSets
  Dim objSelSet As AcadSelectionSet
  Dim intType(0) As Integer
  Dim varData(0) As Variant
  Dim strPaths() As String
  Dim intCnt As Integer
  Dim objXref As AcadExternalReference
  Dim objEnt As AcadEntity
  Dim objBlk As AcadBlock
  Dim objBlks As AcadBlocks
  Dim intDuplicate As Integer
  Dim objDuplicate As AcadEntity
  Dim boolDuplicate As Boolean
 
  Set objBlks = ThisDrawing.Blocks
  Set objSelSets = ThisDrawing.SelectionSets
  For Each objSelSet In objSelSets
    If objSelSet.Name = "GetXrefPaths" Then
      objSelSets.Item("GetXrefPaths").Delete
      Exit For
    End If
  Next
  Set objSelSet = objSelSets.Add("GetXrefPaths")
  intType(0) = 0: varData(0) = "INSERT"
  objSelSet.Select acSelectionSetAll, , , intType, varData
  For Each objEnt In objSelSet
    Set objBlk = objBlks(objEnt.Name)
    If objBlk.IsXRef Then
      boolDuplicate = False
      For intDuplicate = 1 To colXrefs.Count
        Set objDuplicate = colXrefs.Item(intDuplicate)
        If objDuplicate.Name = objEnt.Name Then
          boolDuplicate = True
          Exit For
        End If
      Next intDuplicate
      If boolDuplicate = False Then
        colXrefs.Add objEnt '.Path
        GetNested objBlk
      End If
    End If
  Next objEnt

End Sub

Private Function GetNested(objBlk As AcadBlock) As Integer
  Dim objXref As AcadExternalReference
  Dim objBlkRef As AcadBlockReference
  Dim objEnt As AcadEntity
  Dim objNext As AcadBlock
    For Each objEnt In objBlk
      If TypeOf objEnt Is AcadBlockReference Then
        Set objBlkRef = objEnt
        Set objNext = ThisDrawing.Blocks(objBlkRef.Name)
        If objNext.IsXRef Then
          Set objXref = objEnt
          colXrefs.Add objXref
          GetNested objNext
        End If
      End If
    Next
  GetNested = colXrefs.Count
End Function

'Returns the stored Xref at Index
Public Property Get Item(Index As Integer) As AcadExternalReference
  Set Item = colXrefs(Index)
End Property

'How many in the drawing (includes nested)
Public Property Get Count() As Integer
  Count = colXrefs.Count
End Property

[Maverick®]

...... using an USCO 138kV Vee switch

Phhhhhht!  Like we didn't know that.



Dahell is he yammering on about?

[David Hall]

Once again, Bob You Da Man!  That works perfectly.