Results 1 to 3 of 3

Thread: Problem detaching XREF with ObjectDBX library

  1. #1
    Member
    Join Date
    2010-03
    Location
    PARIS
    Posts
    7
    Login to Give a bone
    0

    Default Problem detaching XREF with ObjectDBX library

    Hi,

    My purpose is to remove XREF from multiple AUTOCAD files without having to open them in AUTOCAD (that takes too much time)

    Using the following VBA code with ObjectDBX Library (AUTOCAD 2007), it seems impossible to detach (or delete) a XREF block from the Blocks collection even after having previously deleted all the references to the block. Has anyone any idea or suggestion?

    In addition:

    1) The almost same code in VBA Autocad WITHOUT the ObjectDBX library (replacing ODBX with the Active Document)
    -succeeds if references exist in only one layout (fails with ObjectDBX library)
    -fails if references exist in multiple layouts (deleting references succeeds but detaching block also fails!)

    2) After having removed the references with the ObjectDBX code, opening the file in AUTOCAD removes the block from the blocs collection!!! (but not re-opening it with ObjectDBX Library!) but takes a lot of time!

    The Code:

    Code:
    Sub DetachXrefTest()
        Dim oLayout As AXDBLIB.AcadLayout
        Dim oBlock As AXDBLIB.AcadBlock
        Dim oRef As AXDBLIB.AcadExternalReference
        Dim oEntity As AXDBLIB.AcadEntity
        Dim vFileName As Variant
        Dim sXrefToRemove As String
     
        Dim ODBX As ODBXClass
        
        On Error GoTo ErrHandler
        
        Set ODBX = New ODBXClass
        
        vFileName = GetOpenFilename(HWND, , "Fichiers Autocad, *.dwg", , "Sélectionner un fichier", , False)
        
        If IsArray(vFileName) Then
        
            ODBX.OpenFile (vFileName(0))
            
            sXrefToRemove = "Name of the XREF to Remove"
            
            For Each oLayout In ODBX.Layouts
                 For Each oEntity In oLayout.Block
                      If TypeOf oEntity Is AcadExternalReference Then
                           Set oRef = oEntity
                           If oRef.Name = sXrefToRemove Then
                                Debug.Print "Deleting "; oRef.Name
                                oRef.Delete
                           End If
                      End If
                 Next
            Next
            'At this point no error occured but block sXrefToRemove is
            'still present in Blocks collection
            
            'Trying to remove it...
            Set oBlock = ODBX.Blocks(sXrefToRemove)
            Debug.Print "Detaching "; oBlock.Name
            oBlock.Detach '=> ERROR: method detach of object 'IAcadBlock' failed
            
            GoTo SubExit
            
            'Other possibility but with same result
            For Each oBlock In ODBX.Blocks 'or ODBX.Database.Blocks
                If oBlock.IsXRef Then
                    If oBlock.Name = sXrefToRemove Then
                        Debug.Print "Detaching "; oBlock.Name
                        oBlock.Detach 'Same result at this line
                    End If
                End If
            Next
            
        End If
    
    SubExit:
        Set oBlock = Nothing
        Set oLayout = Nothing
        Set oEntity = Nothing
        Set oRef = Nothing
        Set ODBX = Nothing
        Exit Sub
    
    ErrHandler:
        Debug.Print "ERROR: "; Err.Description
        Resume SubExit
    
    End Sub
    
    '*** EXTRACT OF ODBXClass also usable in all VBA interface (EXCEL VBA, WORD VBA,...) *******
    
    Private AxDbDoc As AXDBLIB.AxDbDocument
    Private AcadApp As AcadApplication
    Private AcadWasNotRunning As Boolean
    
    Private Sub Class_Initialize()
        On Error Resume Next
        Set AcadApp = GetObject(, "Autocad.Application")
        If Err <> 0 Then 'AUTOCAD is not running
            AcadWasNotRunning = True
            Err.Clear
            Set AcadApp = CreateObject("Autocad.Application") 'Run a new instance of AUTOCAD
            AcadApp.Visible = False 'Make it not visible
        Else
            AcadWasNotRunning = False
        End If
        On Error GoTo 0
        'Get interface object for all ObjectDBX functions and link it with the
        'AcadApp instance
        Set AxDbDoc = AcadApp.GetInterfaceObject("ObjectDBX.AxDbDocument.17")
    End Sub
    
    Private Sub Class_Terminate()
        Cleanup
    End Sub
    
    Private Sub Cleanup()
        On Error Resume Next
        Set AxDbDoc = Nothing
        If AcadWasNotRunning Then
            AcadApp.Quit
        End If
        Set AcadApp = Nothing
    End Sub
    
    Property Get Application() As AcadApplication
        Set Application = AcadApp
    End Property
    '
    'ALL ORIGINAL PROPERTIES AND METHODS ARE THEN OVERWRITTEN AS FOLLOW
    '
    Property Get Blocks() As AXDBLIB.AcadBlocks
        Set Blocks = AxDbDoc.Blocks
    End Property
    
    Public Function ObjectIdToObject(ObjectID As AXDBLIB.LONG_PTR) As Object
        Set ObjectIdToObject = AxDbDoc.ObjectIdToObject(ObjectID)
    End Function
    
    Public Sub OpenFile(FileName As String, Optional Password)
        Call AxDbDoc.Open(FileName, Password)
    End Sub
    '
    'ETC.....
    '
    '******** END OF EXTRACT OF MY ODBX Class **************
    Last edited by christian.montagnac; 2010-03-11 at 06:53 PM.

  2. #2
    Member
    Join Date
    2017-07
    Posts
    4
    Login to Give a bone
    0

    Default Re: Problem detaching XREF with ObjectDBX library

    Hi!

    Did you manage to remove the XREF?

    What I did is to check all entities rather than blocks but it takes a long process for each file.

    Is there a proper way to detect all xref?

    What about the RasterImage?

    Kindly share your new code.

    Thanks


    Quote Originally Posted by christian.montagnac View Post
    Hi,

    My purpose is to remove XREF from multiple AUTOCAD files without having to open them in AUTOCAD (that takes too much time)

    Using the following VBA code with ObjectDBX Library (AUTOCAD 2007), it seems impossible to detach (or delete) a XREF block from the Blocks collection even after having previously deleted all the references to the block. Has anyone any idea or suggestion?

    In addition:

    1) The almost same code in VBA Autocad WITHOUT the ObjectDBX library (replacing ODBX with the Active Document)
    -succeeds if references exist in only one layout (fails with ObjectDBX library)
    -fails if references exist in multiple layouts (deleting references succeeds but detaching block also fails!)

    2) After having removed the references with the ObjectDBX code, opening the file in AUTOCAD removes the block from the blocs collection!!! (but not re-opening it with ObjectDBX Library!) but takes a lot of time!

    The Code:

    Code:
    Sub DetachXrefTest()
        Dim oLayout As AXDBLIB.AcadLayout
        Dim oBlock As AXDBLIB.AcadBlock
        Dim oRef As AXDBLIB.AcadExternalReference
        Dim oEntity As AXDBLIB.AcadEntity
        Dim vFileName As Variant
        Dim sXrefToRemove As String
     
        Dim ODBX As ODBXClass
        
        On Error GoTo ErrHandler
        
        Set ODBX = New ODBXClass
        
        vFileName = GetOpenFilename(HWND, , "Fichiers Autocad, *.dwg", , "Sélectionner un fichier", , False)
        
        If IsArray(vFileName) Then
        
            ODBX.OpenFile (vFileName(0))
            
            sXrefToRemove = "Name of the XREF to Remove"
            
            For Each oLayout In ODBX.Layouts
                 For Each oEntity In oLayout.Block
                      If TypeOf oEntity Is AcadExternalReference Then
                           Set oRef = oEntity
                           If oRef.Name = sXrefToRemove Then
                                Debug.Print "Deleting "; oRef.Name
                                oRef.Delete
                           End If
                      End If
                 Next
            Next
            'At this point no error occured but block sXrefToRemove is
            'still present in Blocks collection
            
            'Trying to remove it...
            Set oBlock = ODBX.Blocks(sXrefToRemove)
            Debug.Print "Detaching "; oBlock.Name
            oBlock.Detach '=> ERROR: method detach of object 'IAcadBlock' failed
            
            GoTo SubExit
            
            'Other possibility but with same result
            For Each oBlock In ODBX.Blocks 'or ODBX.Database.Blocks
                If oBlock.IsXRef Then
                    If oBlock.Name = sXrefToRemove Then
                        Debug.Print "Detaching "; oBlock.Name
                        oBlock.Detach 'Same result at this line
                    End If
                End If
            Next
            
        End If
    
    SubExit:
        Set oBlock = Nothing
        Set oLayout = Nothing
        Set oEntity = Nothing
        Set oRef = Nothing
        Set ODBX = Nothing
        Exit Sub
    
    ErrHandler:
        Debug.Print "ERROR: "; Err.Description
        Resume SubExit
    
    End Sub
    
    '*** EXTRACT OF ODBXClass also usable in all VBA interface (EXCEL VBA, WORD VBA,...) *******
    
    Private AxDbDoc As AXDBLIB.AxDbDocument
    Private AcadApp As AcadApplication
    Private AcadWasNotRunning As Boolean
    
    Private Sub Class_Initialize()
        On Error Resume Next
        Set AcadApp = GetObject(, "Autocad.Application")
        If Err <> 0 Then 'AUTOCAD is not running
            AcadWasNotRunning = True
            Err.Clear
            Set AcadApp = CreateObject("Autocad.Application") 'Run a new instance of AUTOCAD
            AcadApp.Visible = False 'Make it not visible
        Else
            AcadWasNotRunning = False
        End If
        On Error GoTo 0
        'Get interface object for all ObjectDBX functions and link it with the
        'AcadApp instance
        Set AxDbDoc = AcadApp.GetInterfaceObject("ObjectDBX.AxDbDocument.17")
    End Sub
    
    Private Sub Class_Terminate()
        Cleanup
    End Sub
    
    Private Sub Cleanup()
        On Error Resume Next
        Set AxDbDoc = Nothing
        If AcadWasNotRunning Then
            AcadApp.Quit
        End If
        Set AcadApp = Nothing
    End Sub
    
    Property Get Application() As AcadApplication
        Set Application = AcadApp
    End Property
    '
    'ALL ORIGINAL PROPERTIES AND METHODS ARE THEN OVERWRITTEN AS FOLLOW
    '
    Property Get Blocks() As AXDBLIB.AcadBlocks
        Set Blocks = AxDbDoc.Blocks
    End Property
    
    Public Function ObjectIdToObject(ObjectID As AXDBLIB.LONG_PTR) As Object
        Set ObjectIdToObject = AxDbDoc.ObjectIdToObject(ObjectID)
    End Function
    
    Public Sub OpenFile(FileName As String, Optional Password)
        Call AxDbDoc.Open(FileName, Password)
    End Sub
    '
    'ETC.....
    '
    '******** END OF EXTRACT OF MY ODBX Class **************

  3. #3
    Member tuomo.jarvinen's Avatar
    Join Date
    2015-09
    Location
    Jyväskylä, Finland
    Posts
    49
    Login to Give a bone
    0

    Default Re: Problem detaching XREF with ObjectDBX library

    Have you got the Reference Manager available?

    RefMan.JPG

Similar Threads

  1. 2008: Content Library Problem
    By bnutkins in forum ACA General
    Replies: 0
    Last Post: 2011-07-13, 05:33 PM
  2. Problem with Australian structural steel library RAC2012
    By kimheaver in forum Revit Architecture - General
    Replies: 1
    Last Post: 2011-06-14, 12:26 PM
  3. Replies: 2
    Last Post: 2007-05-30, 03:40 PM
  4. Replies: 5
    Last Post: 2006-12-20, 04:11 PM
  5. Problem with a New Library
    By T1rippaman in forum Inventor - General
    Replies: 1
    Last Post: 2006-08-02, 07:42 AM

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •