Detach XRefs using DBX

[Joro--]

Hi,

I'm trying in VBA to detach xrefs from several .dwg files using the DBX approach. But it seems not to work so far. The problem comes in the next lines:

   Set oDBX = GetInterfaceObject("ObjectDBX.AxDBDocument.17")
   oDBX.Open FolderPath & "/" & F
       Dim BL As AcadBlock
       Dim ExRef As AcadExternalReference
       
       For Each BL In oDBX.Blocks
           If BL.IsXRef Then
               Set ExRef = BL
               UF1.lbXRefList.AddItem BL.Name
               ExRef.Detach
           End If
       Next

Application crashes at:

Set ExRef = BL

 

Any ideas?

[gile]

Hi,

 

I don't know much about VBA but BL type is AcadBlock, not

AcadExternalReference...

[Joro--]

gile, thanks for the suggestion. I tried it using just

BL.Detach

but it doesn't help, the same approach works when I open the files as AcadDocuments....

[Lee Mac]

This is how it might look in LISP:

 

(defun c:test (/ *error* ObjRelease Get_Subs DirDialog ObjectDBXDocument

                DBX DOCLST DWLST ERR FILE FILEPATH FLAG FOLDER PATH SUBS)

 ;; Lee Mac  ~  25.01.10
 (vl-load-com)

 (setq *acad (cond (*acad) ((vlax-get-acad-object)))
       *adoc (cond (*adoc) ((vla-get-ActiveDocument *acad))))

 (defun *error* (msg)
   (ObjRelease '( ))
   (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
       (princ (strcat "\n** Error: " msg " **")))
   (princ))
 

 (defun ObjRelease (lst)
   (mapcar
     (function
       (lambda (x)
         (if (and (eq (type x) 'VLA-OBJECT)
                  (not (vlax-object-released-p x)))
           (vl-catch-all-apply
             (function vlax-release-object) (list x))))) lst))
 

 (defun Get_Subs (folder / file) ;; CAB
   (mapcar
     (function
       (lambda (x) (setq file (strcat folder "\\" x))
                   (cons file (apply (function append) (get_subs file)))))
       (cddr (vl-directory-files folder nil -1))))
 
 
 (defun DirDialog (msg dir flag / Shell Fold Path)
   ; Lee Mac  ~ 07.06.09

   (setq *acad (cond (*acad) ((vlax-get-acad-object))))

   (setq Shell (vla-getInterfaceObject *acad "Shell.Application")
         Fold  (vlax-invoke-method Shell 'BrowseForFolder
                 (vla-get-HWND *acad) msg flag dir))
   (vlax-release-object Shell)

   (if Fold
     (progn
       (setq Path (vlax-get-property
                    (vlax-get-property Fold 'Self) 'Path))
       (vlax-release-object Fold)

       (and (= "\\" (substr Path (strlen Path)))
            (setq Path (substr Path 1 (1- (strlen Path)))))))
   
   Path)
 

 (defun ObjectDBXDocument (/ acVer)

   (setq *acad (cond (*acad) ((vlax-get-acad-object))))
   
   (vla-GetInterfaceObject *acad
     (if (< (setq acVer (atoi (getvar "ACADVER"))) 16) "ObjectDBX.AxDbDocument"
       (strcat "ObjectDBX.AxDbDocument." (itoa acVer)))))

 

 (if (setq Path (DirDialog "Select Directory to Process" nil 0))
   (progn

     (initget "Yes No")
     (setq subs (cond ((getkword "\nProcess SubDirectories? <Yes> : ")) ("Yes")))

     (vlax-for doc (vla-get-Documents *acad)
       (setq DocLst
         (cons
           (cons
             (strcase
               (vla-get-fullname doc)) doc) DocLst)))

     (foreach dwg (setq dwLst (apply (function append)
                                     (vl-remove 'nil
                                       (mapcar
                                         (function
                                           (lambda (Filepath)
                                             (mapcar
                                               (function
                                                 (lambda (Filename)
                                                   (strcat Filepath "\\" Filename)))
                                               (vl-directory-files Filepath "*.dwg" 1))))
                                         (append (list Path)
                                                 (apply (function append)
                                                        (if (= "Yes" subs) (Get_Subs Path))))))))

       (setq flag (and (setq dbx (cdr (assoc (strcase dwg) DocLst)))))

       (and (not dbx)
            (setq Err (vl-catch-all-apply
                        (function vla-open)
                          (list (setq dbx (ObjectDBXDocument)) dwg))))

       (if (or flag (not (vl-catch-all-error-p Err)))
         (progn

           (vlax-for blk (vla-get-Blocks dbx)

             (if (eq :vlax-true (vla-get-isXRef blk))

               (vl-catch-all-apply (function vla-Detach) (list blk))))

           (vla-saveas dbx dwg))
           
         (princ (strcat "\n** Error Opening File: " (vl-filename-base dwg)  ".dwg **"))))
     
     (princ (strcat "\n<< " (itoa (length dwLst)) " Drawings Processed >>")))

   (princ "\n*Cancel*"))

 (ObjRelease '(dbx))
 (princ))

[Joro--]

Lee,

lisp is good but I need it in VBA because I need to use it in a bigger VBA application. I suppose it is possible, but unfortunately I can't go any further than just getting the names of the XRefs in the drawing...

[Lee Mac]

Well, the above will just prompt for a directory, and iterate through the drawings, detaching all xRefs - I thought you may be able to get some help from it

[Joro--]

Lee,

 

I tried to use your code, but in fact the xrefs were not detached from either of the drawings in the folder selected. Do you have any idea why?

[gile]

Hi,

 

It seems a (vla-SaveAs dbx dwg) is missing to save the changes...

[Lee Mac]

Hi,

 

It seems a (vla-SaveAs dbx dwg) is missing to save the changes...

 

Ahh, thanks Gile - my mistake

[Joro--]

So what would be the version after applying this change?

[Lee Mac]

Code in my post updated.

[Joro--]

Lee, 10x for the improvement of the code, but the references still remain in the drawings, may be there is some other reason

[Lee Mac]

Perhaps there is an error when detaching, could you try this, and see if there are any errors?

 

(defun c:test (/ *error* ObjRelease Get_Subs DirDialog ObjectDBXDocument

                DBX DOCLST DWLST ERR FILE FILEPATH FLAG FOLDER PATH SUBS)

 ;; Lee Mac  ~  25.01.10
 (vl-load-com)

 (setq *acad (cond (*acad) ((vlax-get-acad-object)))
       *adoc (cond (*adoc) ((vla-get-ActiveDocument *acad))))

 (defun *error* (msg)
   (ObjRelease '( ))
   (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
       (princ (strcat "\n** Error: " msg " **")))
   (princ))
 

 (defun ObjRelease (lst)
   (mapcar
     (function
       (lambda (x)
         (if (and (eq (type x) 'VLA-OBJECT)
                  (not (vlax-object-released-p x)))
           (vl-catch-all-apply
             (function vlax-release-object) (list x))))) lst))
 

 (defun Get_Subs (folder / file) ;; CAB
   (mapcar
     (function
       (lambda (x) (setq file (strcat folder "\\" x))
                   (cons file (apply (function append) (get_subs file)))))
       (cddr (vl-directory-files folder nil -1))))
 
 
 (defun DirDialog (msg dir flag / Shell Fold Path)
   ; Lee Mac  ~ 07.06.09

   (setq *acad (cond (*acad) ((vlax-get-acad-object))))

   (setq Shell (vla-getInterfaceObject *acad "Shell.Application")
         Fold  (vlax-invoke-method Shell 'BrowseForFolder
                 (vla-get-HWND *acad) msg flag dir))
   (vlax-release-object Shell)

   (if Fold
     (progn
       (setq Path (vlax-get-property
                    (vlax-get-property Fold 'Self) 'Path))
       (vlax-release-object Fold)

       (and (= "\\" (substr Path (strlen Path)))
            (setq Path (substr Path 1 (1- (strlen Path)))))))
   
   Path)
 

 (defun ObjectDBXDocument (/ acVer)

   (setq *acad (cond (*acad) ((vlax-get-acad-object))))
   
   (vla-GetInterfaceObject *acad
     (if (< (setq acVer (atoi (getvar "ACADVER"))) 16) "ObjectDBX.AxDbDocument"
       (strcat "ObjectDBX.AxDbDocument." (itoa acVer)))))

 

 (if (setq Path (DirDialog "Select Directory to Process" nil 0))
   (progn

     (initget "Yes No")
     (setq subs (cond ((getkword "\nProcess SubDirectories? <Yes> : ")) ("Yes")))

     (vlax-for doc (vla-get-Documents *acad)
       (setq DocLst
         (cons
           (cons
             (strcase
               (vla-get-fullname doc)) doc) DocLst)))

     (foreach dwg (setq dwLst (apply (function append)
                                     (vl-remove 'nil
                                       (mapcar
                                         (function
                                           (lambda (Filepath)
                                             (mapcar
                                               (function
                                                 (lambda (Filename)
                                                   (strcat Filepath "\\" Filename)))
                                               (vl-directory-files Filepath "*.dwg" 1))))
                                         (append (list Path)
                                                 (apply (function append)
                                                        (if (= "Yes" subs) (Get_Subs Path))))))))

       (setq flag (and (setq dbx (cdr (assoc (strcase dwg) DocLst)))))

       (and (not dbx)
            (setq Err (vl-catch-all-apply
                        (function vla-open)
                          (list (setq dbx (ObjectDBXDocument)) dwg))))

       (if (or flag (not (vl-catch-all-error-p Err)))
         (progn

           (vlax-for blk (vla-get-Blocks dbx)

             (if (eq :vlax-true (vla-get-isXRef blk))

               (vla-detach blk)))

               ;(vl-catch-all-apply (function vla-Detach) (list blk))))

           (vla-saveas dbx dwg))
           
         (princ (strcat "\n** Error Opening File: " (vl-filename-base dwg)  ".dwg **"))))
     
     (princ (strcat "\n<< " (itoa (length dwLst)) " Drawings Processed >>")))

   (princ "\n*Cancel*"))

 (ObjRelease '(dbx))
 (princ))

[ronjonp]

I believe that xrefs are not loaded into a DBX doc.....instead of trying to detach them, just erase them (all references).