I' trying to go through blocks in a drawing and make a list of all the
xrefs. I'm translating a function from VBA to .NET that I can't seem to get
to work. The entire module is below. There are three key spots that I think
I have wrong and have noted them. Any help in clearing those up would be
MOST appreciated! Thanks!
+++BEGIN CODE+++
=========================================================
Imports Autodesk.AutoCAD.Interop.Common
Imports Autodesk.AutoCAD.Interop
Imports Microsoft.Office.Core
Imports System
Imports System.IO
Imports System.Text
Module XrefLog
Private colXrefs As New Collection
Public Sub XrefLogger(ByVal SheetNum, ByVal FileName, ByVal dwg)
Dim addXrefs() As String
Dim objSelSets As AcadSelectionSets
Dim objSelSet As AcadSelectionSet
Dim intType(0) As Integer
Dim varData(0) As Object
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 strXrefPath As String
Dim myObj As AcadExternalReference
Dim myObj2 As AcadExternalReference
Dim strDwgXrefList As String
Dim addXref As Integer
Dim FileCheck As System.IO.File
Dim strLineIn As String
Dim y As Integer
Dim strLineInFull
addXref = 0
strDwgXrefList = "Xref_Log.txt"
If Not FileCheck.Exists(loadini.strDwgDirectory & strDwgXrefList) Then
FileCheck.Create(loadini.strDwgDirectory & strDwgXrefList)
End If
FileOpen(4, loadini.strDwgDirectory & strDwgXrefList, OpenMode.Append)
WriteLine(4, SheetNum, TAB, FileName, TAB, "[", dwg.FullName & "]")
objBlks = dwg.Blocks
objSelSets = dwg.SelectionSets
For Each objSelSet In objSelSets
If objSelSet.Name = "GetXrefPaths" Then
objSelSets.Item("GetXrefPaths").Delete()
Exit For
End If
Next
objSelSet = objSelSets.Add("GetXrefPaths")
intType(0) = 0 : varData(0) = "INSERT"
objSelSet.Select(AcSelect.acSelectionSetAll, , , intType,
varData)'********HERE IS ONE OF THE QUESTION SPOTS
For Each objEnt In objSelSet
objBlk = objBlks.Item(objEnt.Name)'********HERE IS ONE OF THE
QUESTION SPOTS
If objBlk.IsXRef Then
objXref = objEnt
colXrefs.Add(objXref)
GetNested(objBlk)
End If
Next objEnt
ReDim addXrefs(colXrefs.Count)
y = 0
x = 0
For Each myObj In colXrefs
addXrefs(y) = myObj.Path
y = y + 1
Next myObj
For Each myObj In colXrefs 'For each xref object in ColXrefs
strlinein = myObj.Path 'Set strlinein = to the xref path
addXref = 0
For y = x To UBound(addXrefs) - 1 'Check
If strlinein = addXrefs(y) Then
addXref = addXref + 1
End If
Next y
If addXref = 1 Then
strLineInFull = strlinein
strlinein = Right(strlinein, Len(strlinein) -
InStrRev(strlinein, "\"))
Writeline(4, Tab, strlinein, Tab, Tab, "[" & strLineInFull &
"]")
End If
x = x + 1
Next myObj
WriteLine(4)
WriteLine(4, "Pen Table for ", strLineIn, ":")
Writeline(4, Tab, "PC3FileName", Tab, Tab, "[PC3FilePath]"
WriteLine(4)
WriteLine(4)
FileClose(4)
End Sub
Private Function GetNested(ByVal objBlk As AcadBlock) As Integer
Dim objXref As AcadExternalReference
Dim objBlkRef As AcadBlockReference
Dim objEnt As AcadEntity
Dim objNext As AcadBlock
Dim x As Integer
x = 0
For Each objEnt In objBlk
If TypeOf objEnt Is AcadBlockReference Then
objBlkRef = objEnt
objNext = dwg.Blocks.Item(objBlkRef.Name) '********HERE IS
ONE OF THE QUESTION SPOTS
If objNext.IsXRef Then
objXref = objEnt
colXrefs.Add(objXref)
GetNested(objNext)
End If
End If
Next objEnt
GetNested = colXrefs.Count
End Function
End Module
