CAD Forum - Database of tips, tricks and utilities for AutoCAD, Inventor and other Autodesk products [www.cadforum.cz]
CZ | EN | DE
Login or
registration
  Visitors: 4543
RSS channel - CAD tips RSS tips
RSS discussions

Discussion Discussion forum

 

HelpCAD discussion

 
CAD Forum - Homepage CAD discussion forum - ask any CAD-related questions here, share your CAD knowledge on AutoCAD, Inventor, Revit and other Autodesk software with your peers from all over the world. To start a new topic, choose an appropriate forum.

Please abide by the rules of this forum.

How to post questions: register or login, go to the specific forum and click the NEW TOPIC button.
  FAQ FAQ  Forum Search   Events   Register Register  Login Login

Topic ClosedProblem detaching XREF with ObjectDBX library

 Post Reply Post Reply
Author
chmtc94 View Drop Down
Newbie
Newbie


Joined: 11.Mar.2010
Status: Offline
Points: 1
Direct Link To This Post Topic: Problem detaching XREF with ObjectDBX library
    Posted: 11.Mar.2010 at 17:25
Hi,
 
Using the following VBA code with ObjectDBX Library, 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 same code WITHOUT the ObjectDBX library
-succeeds if references exist in only one layout (fails with ObjectDBX library)
-fails if references exist  in mulriple layouts 
 
2) After having removed the references with this code, opening the file in AUTOCAD removes the block from the blocs collection!!! (but not re-opening it with ObjectDBX Library!)
 
 
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 ODBX As ODBXClass
   
'*** SUMMARY 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 OVERWRITED 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 SUMMARY OF MY ODBX Class **************

    
    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...
        ODBX.Blocks(sXrefToRemove).Detach '=> ERROR: method detach of object 'IAcadBlock' failed
        GoTo SubExit
       
        'Other possibility but with same result
        For Each oBlock In ODBX.Blocks
            If oBlock.IsXRef Then
                'Debug.Print oBlock.Name
                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



Edited by chmtc94 - 11.Mar.2010 at 17:30
Back to Top

Related CAD tips:


 Post Reply Post Reply
  Share Topic   

Forum Jump Forum Permissions View Drop Down



This page was generated in 0,340 seconds.