Print Page - Using AutoCad's ObjectDBX from Excel

Ok, i replied a couple of times to a thread in autolisps about getting attributes using objectdbx, that was very useful. Now I have a VBA question, I know there is a way, but haven't spent enough time on it, how to run odbx from within the excel's vba??? I want to avoid using AutoCad coding all together. Here's the outline of what i'm trying to create in excel:

Pull up a browser to select a number of drawings
Start OBDX
Extract a number of attributes from each file, each layout
Place each attribute in the excel file.

Any suggestions?
Any linkies or examples?

I'm a newbie to this, but with some explanations it clears up for me.
Thanks,
Viktor.

OK, first off you MUST have either A.)Autcad running, B.) Autocad installed so it can be started, C.)Purchased the stand-alone version of ObjectDBX (now called RealDWG) from Autodesk. The version that shipes with Acad is free to use, but requires an instance of Acad to be running....although it can be invisible so the user never sees it....
I just worked on an example recently, let me see if I can find it.

Edit....uhm, I seem to be on my home computer and I left my laptop at the office. It'll have to wait unless I can access the place I posted it, which may take me a while because I can't recall where I used it. :oops:

OK, I think I figured it out...it was Viktor I was offering to help over on the Adesk newsgroups. He never responded with the details so I never completed my example.....no wonder I couldn't recall where I posted it, I never did.

So, Viktor, I'll reiterate what I said before. Most of what you need for accessing Acad/ODBX within Excel is in the Sample provided with Acad. As for the browsing for folders/dwgs, there are a number of examples around. I'm pretty sure you will find some here at the Swamp, but that is a typical VBA code that could be pulled from many VBA sources.

If it's as wet here tomorrow as today was, I should have some time to throw something together, if you haven't yet done so.

Jeff, thanks for your reply.
Well, you got me there, i'm the same viktor, sorry i didn't get enough details on the adesk forum.
My only excuse is that i've been off and on with this little project. See, it's really not my job to do this, I'm a designer, not a programmer. But it seems that our Drafter Sr. is not about to do anything like this.

Like I said before, I set them up with a automatic process already, it is just very messy. And I do understand that Autocad should be running, that's not my concern. I just don't want it to open each drawing load everything, every xref and every image and then extract the attribute. The way that example that you wrote in the LISP thread worked was awesome! It's like 100 times faster!

But my problem is that half the people that will be using it will be very umm computer illiterate, they managed to screw up what i thought was hard to mess up. Soooo, i really want them to just open excel file, click a button, get the files, and have the autocad do the rest.

I do remember that sample, and it is also on my work's laptop, so I will check it out again, but there are a number of ways how to import the attributes back into the excel, isn't there?

I'm dealing with 50-300 drawings at a time and 5 attributes per drawing, so i'm not sure what would be the best way.

Thanks for your patience Jeff!

Viktor.

That's OK, Viktor....I'd rather help you here in theSamp anyway 8-)
I didn't post this yesterday as I got some bad news and I had to wake my wife and leave in a hurry. Due to the passing of my mother-in-law yesterday I'm not sure how much I'll be on in the next week as we'll be travelling to New York sometime.......

Anyway, here's what I have to show how to access the drawings using ObjectDBX from Excel. I don't have time to add in the folder search or anything else....i.e. this is setup as a 1 drawing type access....the acad/objectdbx objects creation should be done once, not everytime you access a drawing. Good luck and hopefully someone else can step in to help.

Code: [Select]

'Excel Code!
'Modified April 1, 2006 by Jeff Mishler to demonstrate the use of ObjectDBX.
'      ActiveX Sample
'
'      Copyright (C) 1997, 1999, 2002 by Autodesk, Inc.
'
'      Permission to use, copy, modify, and distribute this software
'      for any purpose and without fee is hereby granted, provided
'      that the above copyright notice appears in all copies and
'      that both that copyright notice and the limited warranty and
'      restricted rights notice below appear in all supporting
'      documentation.
'
'      AUTODESK PROVIDES THIS PROGRAM "AS IS" AND WITH ALL FAULTS.
'      AUTODESK SPECIFICALLY DISCLAIMS ANY IMPLIED WARRANTY OF
'      MERCHANTABILITY OR FITNESS FOR A PARTICULAR USE.  AUTODESK, INC.
'      DOES NOT WARRANT THAT THE OPERATION OF THE PROGRAM WILL BE
'      UNINTERRUPTED OR ERROR FREE.
'
'      Use, duplication, or disclosure by the U.S. Government is subject to
'      restrictions set forth in FAR 52.227-19 (Commercial Computer
'      Software - Restricted Rights) and DFAR 252.227-7013(c)(1)(ii)
'      (Rights in Technical Data and Computer Software), as applicable.

Option Explicit
Sub Extract()
    Dim sheet As Object
    Dim elem As Object
    Dim excel As Object
    Dim excelSheet As Object
    Dim RowNum As Integer
    Dim Array1 As Variant
    Dim Count As Integer
    Dim acad As Object
    Dim doc As Object
    Dim mSpace As Object
    Dim NumberOfAttributes As Integer
    Dim AcadRunning As Boolean
    
    Set excel = GetObject(, "Excel.Application")
    Worksheets("Attributes").Activate
    Set excelSheet = excel.ActiveWorkbook.Sheets("Attributes")
    excelSheet.Range(Cells(1, 1), Cells(1000, 100)).Clear
    excelSheet.Range(Cells(1, 1), Cells(1, 100)).Font.Bold = True
    Set acad = Nothing
    On Error Resume Next
    Set acad = GetObject(, "AutoCAD.Application")
    If Err <> 0 Then
        Set acad = CreateObject("AutoCAD.Application")
        acad.Visible = False
        AcadRunning = False
        'MsgBox "Please open a drawing file and then restart this macro."
        'Exit Sub
    Else
        AcadRunning = True
    End If
    On Error GoTo 0 'Err_Handler
    If acad.Version Like "16*" Then
        Set doc = acad.getinterfaceobject("ObjectDBX.AxDbDocument.16")
    ElseIf acad.Version Like "17*" Then
        Set doc = acad.getinterfaceobject("ObjectDBX.AxDbDocument.17")
    Else
        Set doc = acad.getinterfaceobject("ObjectDBX.AxDbDocument")
    End If
    doc.Open "C:\Temp\Att-Test.dwg"
    RowNum = 1
    Dim Header As Boolean
    Header = False
    Dim oBlock As Object
    Dim oLayout As Object
    For Each oLayout In doc.Layouts
        If oLayout.Name <> "Model" Then
        Set oBlock = oLayout.block
        For Each elem In oBlock
            With elem
                If StrComp(.EntityName, "AcDbBlockReference", 1) = 0 Then
                   If UCase(.Name) = "TDG" Then
                    If .HasAttributes Then
                        Array1 = .GetAttributes
                        For Count = LBound(Array1) To UBound(Array1)
                            If Header = False Then
                                If StrComp(Array1(Count).EntityName, "AcDbAttribute", 1) = 0 Then
                                    excelSheet.Cells(RowNum, Count + 1).Value = Array1(Count).TagString
                                End If
                            End If
                        Next Count
                        RowNum = RowNum + 1
                        For Count = LBound(Array1) To UBound(Array1)
                            excelSheet.Cells(RowNum, Count + 1).Value = Array1(Count).TextString
                        Next Count
                        Header = True
                    End If
                    End If
                End If
            End With
        Next elem
        End If
    Next oLayout
    NumberOfAttributes = RowNum - 1
    If NumberOfAttributes > 0 Then
        Worksheets("Attributes").Range("A1").Sort _
        key1:=Worksheets("Attributes").Columns("A"), _
        Header:=xlGuess
    Else
        MsgBox "No attributes found in the current drawing."
    End If
    Set doc = Nothing
    If AcadRunning = False Then acad.Quit
    Set acad = Nothing
    Exit Sub
Err_Handler:
    Debug.Print Err.Number & " - " & Err.Description
    Err.Clear
    If AcadRunning = False Then acad.Quit
End Sub

I'm sorry to hear about your mother-in-law Jeff. Hug your wife for me.

I am sorry to hear that as well Jeff.

If you don't ABSOLUTELY require a code solution, from AutoCAD 2004 on I believe, you can use 'Advanced Attribute Extraction' (just type EATTEXT on the command line).

It will allow you to select multiple drawing files and pick the block and attributes form the block to be exported. If you have EXCEL on the machine you will get an option to save to an EXCEL file directly.

Cheers,
Glenn.

Jeff, thank you greatly for your reply, I am sorry to hear about your loss, and don't worry about me here, if i don't get the answer I have patience to help me out there.

Glenn, actually eattext is horrible, i don't believe it is a finished routine that adesk came up with. it does not work for multiple drawings, it works partially, but not as it should be. There are threads on adesk forums talking about it, but no solution has been posted. and this will allow me to acutally use my own spreadsheet and fill the cells i want, not just a new spreadsheet.

Thanks again, I will give the code a try.
Viktor.

ok, so i've been looking around a bit, and need a little help from someone...
What is the difference between getting stuff from a drawing via vba
OR
Getting stuff from the drawing VIA OBDX & VBA???
i'm mainly talking about the sample that is provided by autodesk and is posted above. So it's the same thing as just working with VBA in AutoCad, you just can't have selection sets, and you also don't have to have the drawing open, correct? (autocad running, but drawing does not have to be opened) so why is the sample still wanting that drawing to be opened?

yea, i'm a bit confused. someone give me a link to some tutorials or something.
Thanks,
Viktor.

The open in the sample is a different find of open. Think of it being more like opening a dxf file in notepad. You can find all the info in the drawing in the text (I'm not quite sure how odbx works). You can open 10 dwgs in cad with vba and you see each dwg flash on the screen, you can also open 10 dwgs in odbx and you will see nothing. It's faster and runs in the background.

Thanks :) that's how i thought of it too.

Noooooooooow, i need some more help. Here's what I got:

Code: [Select]

Public acad As Object
Public odbx As Object
Public mspace As Object
Public excel As Object
Public AcadRunning As Integer
Public excelSheet As Object
Sub Extract()
    Dim sheet As Object
    Dim shapes As Object
    Dim excel As Object
    Dim excelSheet As Object
    Dim RowNum As Integer
    Dim Array1 As Variant
    Dim i As Integer
    Dim ent As AcadEntity
    Dim Layouts As AcadLayouts
    Dim Layout As AcadLayout
    Dim blkref As AcadBlockReference
    Dim filetoopen As Variant
        
    'Prepare Excel
    
    Set excelSheet = ActiveWorkbook.Sheets("test")
    

'getfilenames
filetoopen = Application.GetOpenFilename("Drawing Files (*.dwg), *.dwg", , "Select Drawings", "Get Attributes", True)


On Error Resume Next
Set acad = GetObject(, "AutoCAD.Application")
If Err <> 0 Then
Set acad = CreateObject("AutoCAD.Application")
End If
On Error GoTo 0
Set odbx = acad.GetInterfaceObject("ObjectDBX.AxDbDocument.16")
odbx.Open

    
        
    RowNum = 0
    
    'Work in AutoCad
    
    Set doc = acad.ActiveDocument
    Set Layouts = doc.Layouts
    

For Each Layout In Layouts
If Layout.Name <> "Model" Then
    For Each ent In Layout.Block
        If ent.ObjectName = "AcDbBlockReference" Then
            Set blkref = ent
                If blkref.Name = "CORP-D" Then
                    Array1 = blkref.GetAttributes
                    
                    RowNum = RowNum + 1
                    For i = LBound(Array1) To UBound(Array1)
                        If Array1(i).TagString = "4" Then

                        excelSheet.Cells(RowNum, 1).Value = Array1(i).TextString
                        End If
                        
                        If Array1(i).TagString = "5" Then

                        excelSheet.Cells(RowNum, 2).Value = Array1(i).TextString
                        End If
                        
                        If Array1(i).TagString = "6" Then

                        excelSheet.Cells(RowNum, 3).Value = Array1(i).TextString
                        End If
                        
                        If Array1(i).TagString = "7" Then

                        excelSheet.Cells(RowNum, 4).Value = Array1(i).TextString
                        End If
                        
                        If Array1(i).TagString = "8" Then

                        excelSheet.Cells(RowNum, 5).Value = Array1(i).TextString
                        End If
                        
                    Next i
                End If
              End If
            Next ent
            End If
        Next Layout
    Set acad = Nothing
    Set odbx = Nothing
End Sub

my question is in the FILETOOPEN area and GetOpenFilename, at the beginning.
So GetOpenFilename allows me to get a list of files that I want to process, in a clean way. FileToOpen is a variant and it then contains a list of these files.
Now, how do I get ODBX to go through each one of those files?
I understand, For Each doc in docs do this and that, but it seems that odbx is not opening those files, can someone help me out here?
What do i have wrong?
Thanks,
Viktor.

First off, thanks to all for the kind words.

Next, Bryco explained ObjectDBX pretty well.

Quote from: Viktor on April 04, 2006, 12:31:06 PM

Thanks :) that's how i thought of it too.

Noooooooooow, i need some more help. Here's what I got:

Code: [Select]
snipped the code
my question is in the FILETOOPEN area and GetOpenFilename, at the beginning.
So GetOpenFilename allows me to get a list of files that I want to process, in a clean way. FileToOpen is a variant and it then contains a list of these files.
Now, how do I get ODBX to go through each one of those files?
I understand, For Each doc in docs do this and that, but it seems that odbx is not opening those files, can someone help me out here?
What do i have wrong?
Thanks,
Viktor.

I've never used the GetOpenFileName function so I don't know what it returns, but I'd venture a guess that it is probably either a collection or an array. In either case you can use
For Each filename In filetoopen
odbx.open filename
do whatever with the odbx, such as cycle the layouts collection
Next doc

Also, you set doc to the active acad document........forget that you have acad open! ALL work is to be done with the ODBX object, which is a document.

So you will do this after opening the odbx file:
Set Layouts = odbx.Layouts
then cycle through those layouts.

Does that make more sense?

Thanks Jeff, you are as always filled with wisdo advice!

It works! do you think this could also be somehow improved? it is a bit slow... am i running some loop too much or complicating it a bit? It's not slow slow, but its not flash and done kind of thing.

Now I have to combine 2 attributes before inserting it into cad, that should be fun...
Thanks again Jeff!
Viktor.

I'd like to try a bit more to further clarify what ObjectDBX is.

Think of ObjectDBX as nothing more than Autocad without a graphics engine that works ONLY in SDI (single document) mode. So everytime you you use the Open method you will be eliminating any reference to the previously opened document. Unlike Autocad, there are no prompts or warnings to ask if you want to save or discard changes. It is up to you, the programmer, to make that determination prior to executing the Open method. If you intend to save any changes, do so with the SaveAs method before calling the Open method. Additionally, anytime you save a drawing in ODBX you lose the thumbnail preview image. There is a workaround for this, but I will save that for another time.

As I was posting this I ssaw that Viktor had made another post.....
No one said it will be done in a flash, Viktor. :-) What we have said is that it will be MUCH faster than using Autocad and cycling through the drawings in it. That being said, I have a routine (sorry, I cannot share it) that accesses, records, and revises 14 attributes in every Layout of approx. 2000 drawings and it takes some time. But I know, without even trying, that this it far faster than opening each in Acad.

One other thing, if your block is inserted only once per layout then exit out of the For..Next loop once it's found.......

well, you are right Jeff, it is allot quicker than opening each file and cycling through layouts. And if this is how it should be I'm more than glad with it, it's much cleaner and user friendly than the method i had before.
And I won't beg you to share your routine, :) u certaintly deserve to have something unique :-)

Thanks again, I will post the final routine here if you think it's worth it, it works good for a spreadsheet that you have already designed and you just need to populate certain cells with certain attributes.

u wouldn't happen to know how to add a progress bar in vba, now would u? i can look it up too, but you're more than welcome to share :)

Thanks again,
Viktor.

You're welcome, Viktor. I'm glad you got something working.

Please do share your final routine. It may help others or we may be able to show you how to cut down a bit on the processing time.

I've never used a progress bar in VBA. But THIS (http://hacks.oreilly.com/pub/h/2607) looks like it would be simple to implement.

Jeff

Sure thing, i will post it tomorrow, i've been swapped at work again so no time to play with it much. One thing i did notice, is that you don't have to have autocad running for obdx to work, but you only have to open it once and then you can close it and it will still work until you reboot the computer. This may only be the deal with network licenses, but that's the story with me. kind of freeked me out today.

BTW, i was thinking of launching autocad with shell and then closing it back when done (that is if it's not found).

And, i am having trouble with error proofing it, i'm a bit lost why my error checks are not working.
I'll post it tomorrow.
Thanks again.
Viktor.

Well, here's the code, its not as smooth as i want it to be, maybe over the weekend i will have some time to mess around with it.

Code: [Select]

Public acad As Object
Public odbx As Object
Public mspace As Object
Public excel As Object
Public AcadRunning As Integer
Public excelSheet As Object
Sub Extract()
    ActiveSheet.Unprotect
    Dim sheet As Object
    Dim shapes As Object
    Dim excel As Object
    Dim excelSheet As Object
    Dim RowNum As Integer
    Dim Array1 As Variant
    Dim i As Integer
    Dim ent As AcadEntity
    Dim Layouts As AcadLayouts
    Dim Layout As AcadLayout
    Dim blkref As AcadBlockReference
    Dim filetoopen As Variant
    Dim tag5 As String
        
    'Prepare Excel
    
    Set excelSheet = ActiveWorkbook.Sheets("transmittal")
    Range("prow1").Select
    Do
    If IsEmpty(ActiveCell) = False Then
    ActiveCell.Offset(1, 0).Select
    End If
    Loop Until IsEmpty(ActiveCell) = True
    ActiveCell.Offset(-1, 0).Select

'getfilenames
filetoopen = Application.GetOpenFilename("Drawing Files (*.dwg), *.dwg", , "Select Drawings", "Get Attributes", True)



RowNum = ActiveCell.Row
On Error Resume Next
Set acad = GetObject(, "AutoCAD.Application")
If Err <> 0 Then
Set acad = CreateObject("AutoCAD.Application")
End If
On Error GoTo 0
Set odbx = acad.GetInterfaceObject("ObjectDBX.AxDbDocument.16")


For Each Filename In filetoopen



odbx.Open Filename

    
        
   
    
    'Work in AutoCad
    
    Set Layouts = odbx.Layouts
    

For Each Layout In Layouts
If Layout.Name <> "Model" Then
    For Each ent In Layout.Block
        If ent.ObjectName = "AcDbBlockReference" Then
            Set blkref = ent
                If blkref.Name = "CORP-D" Then
                    Array1 = blkref.GetAttributes
                    
                    RowNum = RowNum + 1
                    For i = LBound(Array1) To UBound(Array1)
                        If Array1(i).TagString = "7" Then

                        excelSheet.Cells(RowNum, 2).Value = Array1(i).TextString
                        End If
                        
                        If Array1(i).TagString = "8" Then

                        excelSheet.Cells(RowNum, 4).Value = "Rev. " & Array1(i).TextString
                        End If
                        
                        If Array1(i).TagString = "5" Then
                        tag5 = Array1(i).TextString

                        'excelSheet.Cells(RowNum, 2).Value = Array1(i).TextString
                        End If
                        
                        If Array1(i).TagString = "6" Then

                        excelSheet.Cells(RowNum, 5).Value = tag5 & " " & Array1(i).TextString
                        End If
                        
                                              
                        If Array1(i).TagString = "1" Then

                        excelSheet.Cells(RowNum, 8).Value = Array1(i).TextString
                        End If
                        
                    Next i
                End If 'blkref
              End If 'ent
           Next ent 'each ent
         End If 'layout
        Next Layout
        Next Filename
    Set acad = Nothing
    Set odbx = Nothing
    
    ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:= _
        False, AllowFormattingCells:=True, AllowFormattingColumns:=True, _
        AllowFormattingRows:=True, AllowInsertingColumns:=True, AllowInsertingRows _
        :=True, AllowInsertingHyperlinks:=True, AllowDeletingColumns:=True, _
        AllowDeletingRows:=True, AllowSorting:=True, AllowFiltering:=True, _
        AllowUsingPivotTables:=True
    
    
    
End Sub

Thanks allot to Jeff, great tips and advice!

Viktor.

One thing I see that MAY speed things up a tad.......you have a number of
"If Array1(i)= something Then whatever" checks......this can be made a bit more streamlined in 2 ways, the second one being the better of the bunch.

Code: [Select]

If Array1(i) = whatever Then
  do something
ElseIf Array1(i) = somethingelse Then
  do somethingelseentirely
ElseIf Array1(i) = thisotherthing Then
  let's do lunch
End If

Then there's the preferred method...

Code: [Select]

Select Case Array1(i)
  Case Is = something
    do something
  Case Is = somethingelse
    do somethingelse
  Case Is = "Lunch"
    do lunch
  Case Else
    do something you hadn't planned on
End Select

And I'll repeat one thing from a few posts ago in case you missed it. If you expect to find only 1 block named "CORP-D" per Layout then Exit the For..Each loop once it is processed. Most PS layouts I use don't have that many entities in them and for me it probably wouldn't speed it up too much, but if you have a lot of things in PS it will probably be noticable.

that works nicely, very good tip (doing the select case rather than if).

One more q,
what if i have the file open? i get the error, is obdx not able to open something if it's already open?
Can i open drawings partially?

And about ending the FOR after a object is found, i can't figure out how to do that, if i end it then i get a BLOCK IF error, and i didn't have time to look into it that much. how does ending FOR work?

Correct, you found an error that needs to be trapped. You cannot open a dwg with ODBX that is open in the CURRENT Acad session....i.e. the one that was used to get the ODBX object. Although I usually will just trap for any errors on opening, since it will also error if you try to open a dwg saved in a newer release.

No to the partial open.

To exit out of a For...Next or For..Each loop (extremely simplified!):

Code: [Select]

For Each ent In Block
   If ent.Name = "MyBlock" Then
      'do whatever with "MyBlock"
      Exit For 'we don't need to process this block any further than this
   End If
Next

Thanks for the For exit.

So, what if someone else has that file open, it is in read only state, will that cause an error as well?
by trapping what do you mean? sorry errors are really my biggest weakness, do you mean to let go to 0 or exit out or stop?
Is there a way to record all the errors, for example, if drawing 111112.123 is open, have it record that number then continue unto the next one, and at the end display a msgbox with drawings that need to be fixed?

Thanks again.
Viktor.

Ok, i still can't get it to exit the FOR... What's killing me here? I'm getting end if without block bla bla error

Code: [Select]

For Each Layout In Layouts
If Layout.Name <> "Model" Then
    For Each ent In Layout.Block
        If ent.ObjectName = "AcDbBlockReference" Then
            Set blkref = ent
            If UCase(blkref.Name) = "CORP-D" Then
                   Array1 = blkref.GetAttributes
                        RowNum = RowNum + 1
                        For i = LBound(Array1) To UBound(Array1)
                        Select Case Array1(i).TagString
                        Case Is = "7"
                        excelSheet.Cells(RowNum, 2).Value = Array1(i).TextString
                        Case Is = "8"
                        excelSheet.Cells(RowNum, 4).Value = "Rev. " & Array1(i).TextString
                        Case Is = "5"
                        tag5 = Array1(i).TextString
                        Case Is = "6"
                        excelSheet.Cells(RowNum, 5).Value = tag5 & " " & Array1(i).TextString
                        Case Is = "1"
                        excelSheet.Cells(RowNum, 8).Value = Array1(i).TextString
                        End Select
                        
                    Next i
                  Exit For                   '<-----------SO WE EXIT IT HERE?
                End If         ' if name  '<-----------Do we still need to end the if within the FOR?
              End If           ' if block
            Next Layout
        Next Filename

Thanks Jeff, sorry to be a pain, it works now, people are using it, i'm just trying to make it a bit more bulletproof.
Thanks again.
Viktor.

Quote from: Viktor on April 07, 2006, 03:09:27 PM

Thanks for the For exit. You're welcome

So, what if someone else has that file open, it is in read only state, will that cause an error as well? It shouldn't, unless you try to save it.
by trapping what do you mean? sorry errors are really my biggest weakness, do you mean to let go to 0 or exit out or stop? The simplest form of an error trap (or handler) is "On Error Resum Next", but if not used correctly can wreak havoc trying to debug problems. Used correctly, though, it can be very easy to use...see below
Is there a way to record all the errors, for example, if drawing 111112.123 is open, have it record that number then continue unto the next one, and at the end display a msgbox with drawings that need to be fixed? Sure....again, see below

Thanks again.
Viktor.

Code: [Select]

For Each dwg In DwgList
    On Error Resume Next
    ODBX.Open dwg
    If Err.Number <> 0 Then
        ThisDrawing.Utility.Prompt dwg & " could not be worked with."
        Err.Clear
        Resume Resume_Here
    Else
        On Error GoTo 0 'or, preferably, have an error handler for things that may go wrong here.
        'Do your thing with the drawing
    End If
Resume_Here:
Next dwg

Ideally though, you should know what error may occur and trap for those specific errors and have your code act accordingly.

In response to the message you posted while I was typing this......you are missing the Next ent

Jeff, thank u! i'm learning as I go... That makes sense :)
I am getting a error if someon has the drawing open though, and i'm just doing the obdx.open and then set odbx = 0
What is my problem? or should I not use obdx.open?

Hi Viktor, just a note to let you know that I'm not ignoring this :-)

I'm currently in upstate New York and won't return home to Calif. until Apr. 17, so my checking in here will be minimal.

If you are getting an error when a drawing's open, just catch the error, report it, and move on.......

I find this error interesting as I haven't been very happy with gathering information from a group of drawings, especially when one drawing is crashed.
I havent been able to use the dbx saveas to help. But( with limited testing) I did manage to copy the file, open it and delete it.

Code: [Select]

Sub opdbx()
    On Error GoTo Err_Control

    Dim sDwg As String
    Dim sSaveas As String
    Dim dbxDoc As AxDbDocument
    Dim Atts As Variant, att As Variant
    Dim Fs, NewFile, F  'As File,
    Dim CopyName As String
    Dim MakeCopy As Boolean
    
    
    sDwg = "X:\PutsomethingValidInHere.DWG"
    Debug.Print sDwg

    Set dbxDoc = New AxDbDocument
  'Pick your version
 
        Set dbxDoc = GetInterfaceObject("ObjectDBX.AxDbDocument.16")
  
    dbxDoc.Open sDwg
   
    
    If MakeCopy Then
        Set Fs = CreateObject("Scripting.FileSystemObject")
        Set F = Fs.GetFile(sDwg)
        CopyName = F.ParentFolder & "\Copy" & F.Name
        Debug.Print F.Path, CopyName
        F.Copy CopyName, True
        Set NewFile = Fs.GetFile(CopyName)
        dbxDoc.Open CopyName
     End If
    
    Debug.Print dbxDoc.LAYERS.Count
    If MakeCopy Then
        Set dbxDoc = Nothing
        NewFile.Delete
        MakeCopy = False
    End If



Exit_Here:
    Exit Sub
Err_Control:
    Select Case Err.Number
        Case -2147467259   'Method 'Open' of object 'IAxDbDocument' failed
            MakeCopy = True
            Resume Next
        Case Else
        Debug.Print Err.Number, Err.Description
        MsgBox Err.Description
        Err.Clear
        Resume Exit_Here
    End Select
End Sub

It's alright Jeff,
This error is making my head scratch. I don't quiet get it. I haven't had any time to work on it recently, but after work i will look at it, test it and get bad results. I just don't get it.
Bryco, thanks for your reply. I will try to work with it, that's an idea to use the case for that particular error.
Thanks again.
Viktor.

OK, I'm finally back in action. My brother-in-law & I ended up driving a moving van from Watkins Glen, NY to Santa Rosa, CA in roughly 48 hours........not a trip I want to make again.

Can you post your code that you've tried to work over this error? This is what I came up with that should allow it to run without error. Could you post the Excel workbook that you use? (I don't use excel enough to even know how to create that Range you reference.....) The only errors I get with this code are those raised due to Excel coding which may be induced by me only having Excel2000.

Code: [Select]

Public acad As Object
Public odbx As Object
Public mspace As Object
Public excel As Object
Public AcadRunning As Integer
Public excelSheet As Object
Sub Extract()
    ActiveSheet.Unprotect
    Dim sheet As Object
    Dim shapes As Object
    Dim excel As Object
    Dim excelSheet As Object
    Dim RowNum As Integer
    Dim Array1 As Variant
    Dim i As Integer
    Dim ent As AcadEntity
    Dim Layouts As AcadLayouts
    Dim Layout As AcadLayout
    Dim blkref As AcadBlockReference
    Dim filename As Variant
    Dim filetoopen As Variant
    Dim tag5 As String
       
    'Prepare Excel
   
    Set excelSheet = ActiveWorkbook.Sheets("transmittal")
    Range("prow1").Select
    Do
    If IsEmpty(ActiveCell) = False Then
    ActiveCell.Offset(1, 0).Select
    End If
    Loop Until IsEmpty(ActiveCell) = True
    ActiveCell.Offset(-1, 0).Select

'getfilenames
filetoopen = Application.GetOpenFilename("Drawing Files (*.dwg), *.dwg", , "Select Drawings", "Get Attributes", True)



RowNum = ActiveCell.Row
On Error Resume Next
Set acad = GetObject(, "AutoCAD.Application")
If Err <> 0 Then
Set acad = CreateObject("AutoCAD.Application.16")
End If
On Error GoTo 0
Set odbx = acad.GetInterfaceObject("ObjectDBX.AxDbDocument.16")


For Each filename In filetoopen
    On Error Resume Next
    odbx.Open filename
    If Err Then
        Err.Clear
        Debug.Print filename
        GoTo Resume_Here
    End If
    On Error GoTo 0
    'Work in AutoCad
    
    Set Layouts = odbx.Layouts
    
    For Each Layout In Layouts
        If Layout.Name <> "Model" Then
        For Each ent In Layout.Block
            If ent.ObjectName = "AcDbBlockReference" Then
            Set blkref = ent
                If blkref.Name = "CORP-D" Then
                    Array1 = blkref.GetAttributes
                   
                    RowNum = RowNum + 1
                    For i = LBound(Array1) To UBound(Array1)
                        Select Case Array1(i).TagString
                        
                        Case Is = "7"
                        excelSheet.Cells(RowNum, 2).Value = Array1(i).TextString
                                               
                        Case Is = "8"
                        excelSheet.Cells(RowNum, 4).Value = "Rev. " & Array1(i).TextString
                       
                        Case Is = "5"
                        tag5 = Array1(i).TextString
                        'excelSheet.Cells(RowNum, 2).Value = Array1(i).TextString
                        
                        Case Is = "6"
                        excelSheet.Cells(RowNum, 5).Value = tag5 & " " & Array1(i).TextString
                                             
                        Case Is = "1"
                        excelSheet.Cells(RowNum, 8).Value = Array1(i).TextString
                        
                        End Select
                    Next i
                    Exit For
                End If 'blkref
              End If 'ent
           Next ent 'each ent
         End If 'layout
    Next Layout
Resume_Here:
Next filename
     Set odbx = Nothing
     Set acad = Nothing 
 
    ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:= _
        False, AllowFormattingCells:=True, AllowFormattingColumns:=True, _
        AllowFormattingRows:=True, AllowInsertingColumns:=True, AllowInsertingRows _
        :=True, AllowInsertingHyperlinks:=True, AllowDeletingColumns:=True, _
        AllowDeletingRows:=True, AllowSorting:=True, AllowFiltering:=True, _
        AllowUsingPivotTables:=True
   
End Sub

Welcome back Jeff. My issue is resolved with that error, let me try to post the whole thing. you will also need the dwg, for it to work.
Bryco had a good idea to isolate just that error, because it seems if you do if err <> 0 then you will get tripped allot, odbx sends some type of error often, like error 20, i'm not sure why.

Ok, so, here's the files. I have another version with progress bar, but this one does not have it yet.
I will remove the attachments in a day or so, so go ahead and look at it.

and u know, i once had to drive for 36 hours to alaska with my brother, that was something i would not want to do again...
ok, it seems i can't add xls files. So here's the border and you should be able to just drop the code into a workbook and it would run.

Code: [Select]

Public acad As Object
Public odbx As Object
Public mspace As Object
Public excel As Object
Public AcadRunning As Integer
Public excelSheet As Object

Sub Extract()
    ActiveSheet.Unprotect
    Dim sheet As Object
    Dim shapes As Object
    Dim excel As Object
    Dim excelSheet As Object
    Dim RowNum As Integer
    Dim Array1 As Variant
    Dim i As Integer
    Dim ent As AcadEntity
    Dim Layouts As AcadLayouts
    Dim Layout As AcadLayout
    Dim blkref As AcadBlockReference
    Dim filetoopen As Variant
    Dim tag5 As String
    Dim X As Variant
    
'Last Empty Cell
    Set excelSheet = ActiveWorkbook.Sheets("transmittal")
    Range("prow1").Select
    Do
    If IsEmpty(ActiveCell) = False Then
    ActiveCell.Offset(1, 0).Select
    End If
    Loop Until IsEmpty(ActiveCell) = True
    ActiveCell.Offset(-1, 0).Select


 
 'Check AutoCad Status
 Set acad = Nothing
    On Error Resume Next
    Set acad = GetObject(, "AutoCAD.Application")
    If Err <> 0 Then
        MsgBox "Please Start AutoCad and Click Again."
        Exit Sub
    End If
Set odbx = acad.GetInterfaceObject("ObjectDBX.AxDbDocument.16")


'Get Files
filetoopen = Application.GetOpenFilename("Drawing Files (*.dwg), *.dwg", , "Select Drawings", "Get Attributes", True)

If filetoopen <> False Then
Resume Next
Else: GoTo cancel
End If

'Each file process
On Error GoTo Errortrap
For Each Filename In filetoopen
'If Err.Number < 0 Then
'GoTo Errortrap
'Else: Resume Next
'End If

Continue:
RowNum = ActiveCell.Row

'Open dwg in odbx
odbx.Open Filename

   

'Work in AutoCad
Set Layouts = odbx.Layouts
For Each Layout In Layouts
If Layout.Name <> "Model" Then
    For Each ent In Layout.Block
        If ent.ObjectName = "AcDbBlockReference" Then
            Set blkref = ent
            If InStr(UCase(blkref.Name), "CORP") > 0 Then
                        Array1 = blkref.GetAttributes
                        RowNum = RowNum + 1
                        For i = LBound(Array1) To UBound(Array1)
                        Select Case Array1(i).TagString
                        Case Is = "7"
                        excelSheet.Cells(RowNum, 2).Value = Array1(i).TextString
                        Case Is = "8"
                        excelSheet.Cells(RowNum, 4).Value = "Rev. " & Array1(i).TextString
                        Case Is = "5"
                        tag5 = Array1(i).TextString
                        Case Is = "6"
                        excelSheet.Cells(RowNum, 5).Value = tag5 & " " & Array1(i).TextString
                        Case Is = "1"
                        excelSheet.Cells(RowNum, 8).Value = Array1(i).TextString
                        End Select
                     Next i
                     
                   Exit For
                End If
              End If
           Next ent
          End If
        Next Layout
        
Resume_Here:
        
       Next Filename
    

    

    GoTo cancel


Errortrap:
Select Case Err.Number
        Case -2147467259   'Method 'Open' of object 'IAxDbDocument' failed
            X = X & vbCrLf & Filename
            Resume Resume_Here
        Case Else
        Err.Clear
 End Select
 Resume Resume_Here
   
cancel:

If Not IsEmpty(X) Then
MsgBox "Following files were not accessed: " & X
End If




'end all

Set acad = Nothing
Set odbx = Nothing
    
    ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:= _
        False, AllowFormattingCells:=True, AllowFormattingColumns:=True, _
        AllowFormattingRows:=True, AllowInsertingColumns:=True, AllowInsertingRows _
        :=True, AllowInsertingHyperlinks:=True, AllowDeletingColumns:=True, _
        AllowDeletingRows:=True, AllowSorting:=True, AllowFiltering:=True, _
        AllowUsingPivotTables:=True
End Sub

just name a top left row "PROW1" you can name it by going to insert >name>define...
and make sure your worksheet is named "transmittal"
The rest should work.
Any advice is welcome :)

Thanks again Jeff!
and Thanks Bryco!

Quote from: Viktor on April 20, 2006, 11:20:34 AM

Bryco had a good idea to isolate just that error, because it seems if you do if err <> 0 then you will get tripped allot, odbx sends some type of error often, like error 20, i'm not sure why.
<snip>
Thanks again Jeff!
and Thanks Bryco!

You're welcome. FWIW, I don't think ODBX is throwing the error that you are getting......I rarely get any errors from ODBX......if it IS error 20, this isfrom the help as to what it means:

Quote

Trappable Errors
Trappable errors can occur while an application is running. Some trappable errors can also occur during development or compile time. You can test and respond to trappable errors using the On Error statement and the Err object. Unused error numbers in the range 1 – 1000 are reserved for future use by Visual Basic.

Code Message
<more snippage>
20 Resume without error

Which points me to the line:
Resume Resume_Here

This is the one located just after the Err handler......
Which gets executed at times when it really shouldn't be. Commenting out that line allowed it to work just fine for me, that is except for the ActiveSheet.Protect part. That part fails everytime, but after looking at the Excel help files it appears there are now more options available than there were in Excel 9.

Jeff

TheSwamp

Code Red => VB(A) => Topic started by: Viktor on March 31, 2006, 09:23:29 PM