Extract Block Att with ObjectDBX

[Anonymous]

I'm sure this has been done before, but my searches have left me somewhat empty-handed.
I have a drawing with a block called TITLEBLOCK in Paperspace, with 15 attributes.
I don't know LISP, but I do know VB so I'd like to use it along with ObjectDBX to do the following:
[1] Open a series of drawings one by one, in the background, not actually in the AutoCAD editor.
[2] Extract the block and write its attribute values to a text file.
[3] Close the drawing (no changes) without saving again, then move on to the next.

I'm using AC2006.
I'm new to the ObjectDBX or ARX stuff, but I've done a little VBA in AutoCAD, and I'm looking for any code samples to get me started. I've found a few, but I need some more to chew on, and any crumbs you can throw my way will be greatly appreciated.
Thanks.
Steve

[Anonymous]

did you do a google groups search on this ng?
should have yielded a ton of samples dbx

f1 will give you everything you need for writing to file "Print" "Open" etc
eg:
Dim iFileNum As Long
If Len(msLogFileName) > 0 Then
iFileNum = FreeFile
Open msLogFileName For Append As #iFileNum
Print #iFileNum, sMsg
Close #iFileNum
End If

are you stuck on a particular part?
what do you have so far?


wrote in message news:5731615@discussion.autodesk.com...
I'm sure this has been done before, but my searches have left me somewhat
empty-handed.
I have a drawing with a block called TITLEBLOCK in Paperspace, with 15
attributes.
I don't know LISP, but I do know VB so I'd like to use it along with
ObjectDBX to do the following:
[1] Open a series of drawings one by one, in the background, not actually in
the AutoCAD editor.
[2] Extract the block and write its attribute values to a text file.
[3] Close the drawing (no changes) without saving again, then move on to the
next.

I'm using AC2006.
I'm new to the ObjectDBX or ARX stuff, but I've done a little VBA in
AutoCAD, and I'm looking for any code samples to get me started. I've found
a few, but I need some more to chew on, and any crumbs you can throw my way
will be greatly appreciated.
Thanks.
Steve

[Anonymous]

Okay, I found one sample (thanks Tony T.) and I've tweaked it in a way that makes sense to me. I'm using AC2006, so I hope my AXDB16Lib is right.
Here's what I have so far - untested.
Any pointers will be heeded.

First, I'd set up a browser to navigate to a folder with the series of drawings. Once the folder was selected, I would cycle thru each file in the folder. For each file I would :

Call AttGet filename
Then I would write the text array (append) to a text file, (with each item separated by a semicolon) adding on new lines with each new file until all files have been examined. I've done this with CNC files, but they are text files, and the DWG files are a little more involved.

Here's the code for the sub AttGet.

Public Sub AttGet(DwgName as String)
Dim DbxDoc As AXDB16Lib.AxDbDocument
Set DbxDoc = GetInterfaceObject("ObjectDBX.AxDbDocument")
DbxDoc.Open (DwgName)
Dim Ent As AXDB16Lib.AcadEntity
Dim BlockRef As AXDB16Lib.AcadBlockReference
Dim AttRef As AXDB16Lib.AcadAttributeReference
Dim Attributes As Variant
Dim AttString() as String
Dim i As Integer

For Each Ent In DbxDoc.PaperSpace
If TypeOf Ent Is AXDB16Lib.AcadBlockReference Then
Set BlockRef = Ent
If BlockRef.Name = "TITLEBLOCK" Then
Attributes = BlockRef.GetAttributes
For i = LBound(Attributes) To UBound(Attributes)
Set AttRef = Attributes(i)

'///This I'm fuzzy on - haven't used ReDim much.///
ReDim AttString((Attributes) To UBound(Attributes))
'///This is to create a string array to hold attribute text.///
'///This is actually a known value, so I could just use it.///

AttString(i)=AttRef.TextString
'///Read every attribute in the block into a string array.///
Next i
End If
End If
Next Ent

Set DbxDoc = Nothing
'///Close without changing or saving.///
End Sub


Like I said, I haven't tested it yet. I need to set up a set of drawings to test. Any pointers will be greatly appreciated.

[Anonymous]

A few pointers.....
First, create the DbxDoc once before you start the loop through the drawings
and set it to nothing once when you are done. Just kjeep opening the
drawings, the previous one will be replaced with the next one.

I haven't looked at the code you found of Tony's, but he's usually right.
However, I've not seen where you need to explictly Dim the variables as
AxDb16LIB types. This is how I would do it: Make sure you have the ObjectDBX
type library referenced, then the code.....

Dim oDBX As AxDbDocument
Dim oEnt As AcadEntity
Dim oBlock As AcadBlockReference

The GetInterfaceObject needs the version info, for 2004-2006 it is:
Set oDBX = GetInterfaceObject("ObjectDBX.AxDbDocument.16")




"StevieLee" wrote in message news:5731696@discussion.autodesk.com...
Okay, I found one sample (thanks Tony T.) and I've tweaked it in a way that
makes sense to me. I'm using AC2006, so I hope my AXDB16Lib is right.
Here's what I have so far - untested.
Any pointers will be heeded.

[Anonymous]

Hi Steve
Try this one, gathered from many authors
on this NG

~'J'~

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
'' Requires:
'' AutoCAD/ObjectDBX Common 16.0 Type Library (for A2004-6)
'' Microsoft Scripting Runtime

Public Function BrowseForFolderF(ByVal msg As String) As String
Dim oBrowser, folderObj, folderAcpt As Object
Dim folderStr As String

Set oBrowser = ThisDrawing.Application.GetInterfaceObject("Shell.Application")
Set folderAcpt = oBrowser.BrowseForFolder(vbOKOnly, msg, vbDefaultButton3, 0)

With folderAcpt
Set folderObj = .Self
folderStr = folderObj.Path
End With
Set folderObj = Nothing
Set folderAcpt = Nothing
Set oBrowser = Nothing
BrowseForFolderF = folderStr

End Function

Public Function CheckFolder(ByVal strPath As String) As Variant
Dim objFolder ''As Scripting.Folder
Dim objFile ''As Scripting.File
Dim objSubdirs ''As Scripting.Folders
Dim objLoopFolder ''As Scripting.Folder
Dim varFs() As Variant
Dim m_objFSO, n, m_lngFileCount

Set m_objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = m_objFSO.GetFolder(strPath)
'
' Check files in this directory
'
n = -1
For Each objFile In objFolder.Files
If UCase$(Right$(objFile.ShortPath, 4)) = ".DWG" Then
m_lngFileCount = m_lngFileCount + 1
n = n + 1
ReDim Preserve varFs(n)
varFs(n) = objFile.Path
End If
Next objFile

' Loop through all subdirectories and
' do the same thing.
'
Set objSubdirs = objFolder.SubFolders
For Each objLoopFolder In objSubdirs
CheckFolder objLoopFolder.Path
Next objLoopFolder

Set objSubdirs = Nothing
Set objFolder = Nothing
CheckFolder = varFs
End Function

Private Sub CreateCSVFile(fso As Variant, strFname As String)
Dim tf
If Not fso.FileExists(strFname) Then
Set tf = fso.CreateTextFile(strFname, True)
Set tf = Nothing
End If
End Sub

Private Sub WriteToCSVFile(strFname As String, strData As String)
Open strFname For Append As #1
Write #1, strData
Close #1
End Sub

Sub BatchReadTitleBlock()
Dim oblkRef As AcadBlockReference
Dim objFnd As Object
Dim indx As Integer
Dim iFiles() As Variant
Dim m_objFSO
Dim fold, DwgName, cnt As Integer, nm As String

fold = BrowseForFolderF("Where are my title blocks?")
Set m_objFSO = CreateObject("Scripting.FileSystemObject")

iFiles = CheckFolder(fold)

CreateCSVFile m_objFSO, "C:\Temp\Test.csv" '// CHANGE TEXT FILE NAME HERE

Dim oDbx As New AxDbDocument

Set oDbx = GetInterfaceObject("ObjectDBX.AxDbDocument.16") '' or 17 for A2007-8

On Error Resume Next
For indx = LBound(iFiles) To UBound(iFiles)
DwgName = iFiles(indx)
oDbx.Open DwgName

For Each objFnd In oDbx.PaperSpace
If TypeOf objFnd Is AcadBlockReference Then
Set oblkRef = objFnd
If StrComp(UCase(oblkRef.Name), "TITLEBLOCK", 1) = 0 Then
Exit For
End If
End If
Next objFnd

With oblkRef
Dim atts As Variant
Dim strData As String
strData = .Name
atts = .GetAttributes
For i = 0 To UBound(atts)
strData = strData & "," & atts(i).TextString
Next i
End With

WriteToCSVFile "C:\Temp\Test.csv", strData '// CHANGE TEXT FILE NAME HERE

Set oDbx = Nothing

Next indx

End Sub

[Anonymous]

Thanks for the reply. I can paste Tony's code in here, if it'll help, but my tweaks make up about 5% of the code, so the vast majority of it is Tony's. I wish we could hire him, or one of you guys to do this, but by the time I did all the paperwork to illustrate the need for the program, to justify the time and cost, plus all of the normal back and forth to fine tune it, I know I can write it myself, with the help of you guys. Plus, they'd probably turn down the request, and I'd be back to square one.

I've written a half dozen programs, mostly on my lunch half-hours, about 15 minutes a day. There's over a dozen people in my department and we use two or three of my programs every day, all day long. I've looked at VB programs out there, and I rate as a beginning programmer at best, but I write these for myself, to make me more efficient, and if they work well enough, I pass them around and everybody gets new toys. I feel like a big geeky Santa.:)

One of them turned a data entry job that might take a day and a half into a thirty-second browse and click. Made my day.

I'll integrate your code changes into the mix, and try to do some testing today. Hopefully it'll work, but if not, I'm sure I'll come whining back with some error documentation.

One thing: Tony wrote this as a VBA. I'm planning on using this in VB, with a browser and all. Is there some in-between code that I need to set up for the hand-off between VBA and VB? I guess I'll know more as I test it today. Wish me luck.

Thanks again to Tony and Jeff, and all you guys. The stuff I learn from this will go a long way toward better programs in future lunch half-hours.:)

[Anonymous]

Gadzooks! Fatty, wow, thanks. Talk about above and beyond. I'll hook this up, plug it in and let you know how it goes.

I love code snippets. I recognize some of these from my searches, and want to thank everybody on these message boards for sharing the wealth.

Thanks again Fatty.

[Anonymous]

Hi Steve

Let me know if you want something
to change there

~'J'~

[Anonymous]

Okay, this is where my lack of experience comes in. When I get to the SubBatchReadTitleBlock, it chokes on the following:

Dim oDbx As New AxDbDocument

It gives "User-defined type not defined."

I'm assuming that something hasn't been registered. Registering is something I've never had to do, so I really don't understand much about it.

I used the following code from the thread on importing layouts using ObjectDBX:

Sub regObjectDBX()
Shell "REGSVR32 /s " + Chr$(34) + Tools.findfile("AXDB16.DLL", True) + Chr$(34), 0
End Sub

but I'm still getting the same error.

I'm going to go look thru the boards, but if someone wants to throw me a bone, I'll wag my tail when I get back. 🙂

[Anonymous]

Hi again, Steve,
Just a thoughts, did you add the reference
to AutoCAD/ObjectDBX Common 16.0 Type Library
and to Microsoft Scripting Runtime?
I can't test it in A2006
Try also to declare ODbx as Jeff Mishler said

~'J'~

[Anonymous]

How do I add a reference to these things? I'm pretty sure that this is my stumbling block. I've been looking, and others talk about Tools/References, but I can't find ... ok, it's not in AutoCAD. It's in VBA. Ok, now it's doing stuff. Came up with a blank cvs file, but let me dig into it a bit...

Thanks.

[Anonymous]

Okay, let's go, but do not dig too deep 🙂

~'J'~

[Anonymous]

[Dancing in my cubicle]
[Doing Tiger Woods fist pump]
It's alive!! Muahahaha! Ok, now everybody's staring...

Fatty, you're my hero.
I now have a text file called CutList.txt, that has several lines of text items, separated by semicolons. I'll run that thru a program to format our cutlists without re-typing all the info.

Thank you very much.

[Anonymous]

Sounds like you've arrived here pretty much the same way I did.

When working with ObjectDbx you must have a running session of Autocad open
anyway, so I've found it best to just use VBA. Far easier to debug that way
and you don't end up running out-of-process which slows things down.

Looks like Fatty's got you hooked up, your in good hands with the Russian
with a strange handle. 🙂

Good Luck!

"StevieLee" wrote in message news:5732215@discussion.autodesk.com...
.... I know I can write it myself, with the help of you guys. Plus, they'd
probably turn down the request, and I'd be back to square one.

I've written a half dozen programs, mostly on my lunch half-hours, about 15
minutes a day.

[Anonymous]

Glad to help
Happy coding,
Cheers

~'J'~

[Anonymous]

Wait...
On closer inspection of the text file, it looks like something's amiss...
I put three drawings in the folder, SS001.DWG, SS002.DWG and SS003.DWG.
I got three lines of info, but they're all from SS001.DWG.

I'll go ahead and post the code before I dig back into it:




Public Function BrowseForFolderF(ByVal msg As String) As String
Dim oBrowser, folderObj, folderAcpt As Object
Dim folderStr As String

Set oBrowser = ThisDrawing.Application.GetInterfaceObject("Shell.Application")
Set folderAcpt = oBrowser.BrowseForFolder(vbOKOnly, msg, vbDefaultButton3, 0)

With folderAcpt
Set folderObj = .Self
folderStr = folderObj.Path
End With
Set folderObj = Nothing
Set folderAcpt = Nothing
Set oBrowser = Nothing
BrowseForFolderF = folderStr

End Function


Public Function CheckFolder(ByVal strPath As String) As Variant
Dim objFolder ''As Scripting.Folder
Dim objFile ''As Scripting.File
Dim objSubdirs ''As Scripting.Folders
Dim objLoopFolder ''As Scripting.Folder
Dim varFs() As Variant
Dim m_objFSO, n, m_lngFileCount

Set m_objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = m_objFSO.GetFolder(strPath)
'
' Check files in this directory
'
n = -1
For Each objFile In objFolder.Files
If UCase$(Right$(objFile.ShortPath, 4)) = ".DWG" Then
m_lngFileCount = m_lngFileCount + 1
n = n + 1
ReDim Preserve varFs(n)
varFs(n) = objFile.Path
End If
Next objFile

' Loop through all subdirectories and
' do the same thing.
'
Set objSubdirs = objFolder.SubFolders
For Each objLoopFolder In objSubdirs
CheckFolder objLoopFolder.Path
Next objLoopFolder

Set objSubdirs = Nothing
Set objFolder = Nothing
CheckFolder = varFs
End Function


Private Sub CreateCSVFile(fso As Variant, strFname As String)
Dim tf
If Not fso.FileExists(strFname) Then
Set tf = fso.CreateTextFile(strFname, True)
Set tf = Nothing
End If
End Sub


Private Sub WriteToCSVFile(strFname As String, strData As String)
Open strFname For Append As #1
Write #1, strData
Close #1
End Sub


Sub BatchReadTitleBlock()
Dim oblkRef As AcadBlockReference
Dim objFnd As AcadEntity
Dim indx As Integer
Dim iFiles() As Variant
Dim m_objFSO
Dim fold, DwgName, cnt As Integer, nm As String

fold = BrowseForFolderF("Select Folder for CutList Generation")
Set m_objFSO = CreateObject("Scripting.FileSystemObject")

iFiles = CheckFolder(fold)

CreateCSVFile m_objFSO, "C:\AutoLoft\CutList.txt"

Dim oDbx As AxDbDocument

Set oDbx = GetInterfaceObject("ObjectDBX.AxDbDocument.16") '/// or 17 for A2007-8

On Error Resume Next
For indx = LBound(iFiles) To UBound(iFiles)
DwgName = iFiles(indx)
oDbx.Open DwgName

For Each objFnd In oDbx.PaperSpace
If TypeOf objFnd Is AcadBlockReference Then
Set oblkRef = objFnd
If StrComp(UCase(oblkRef.Name), "TITLEBLOCK", 1) = 0 Then
Exit For
End If
End If
Next objFnd

With oblkRef
Dim atts As Variant
Dim strData As String
strData = .Name
atts = .GetAttributes
For i = 0 To UBound(atts)
strData = strData & ";" & atts(i).TextString
Next i
End With

WriteToCSVFile "C:\AutoLoft\CutList.txt", strData
Set oDbx = Nothing

Next indx

MsgBox "Text File Created: C:\AutoLoft\CutList.txt"

End Sub



It almost has to be in the latter part of BatchReadTitleBlock.

I'm goin' in...

[Anonymous]

Steve, I can test it tomorrow
Hope this is not urgent work for you
Later,

~'J'~

[Anonymous]

Yes, you are right
This was my mistake there
I 've release DBX object too early
Try this instead

Option Explicit

Public Function BrowseForFolderF(ByVal msg As String) As String
Dim oBrowser, folderObj, folderAcpt As Object
Dim folderStr As String

Set oBrowser = ThisDrawing.Application.GetInterfaceObject("Shell.Application")
Set folderAcpt = oBrowser.BrowseForFolder(vbOKOnly, msg, vbDefaultButton3, 0)

With folderAcpt
Set folderObj = .Self
folderStr = folderObj.Path
End With
Set folderObj = Nothing
Set folderAcpt = Nothing
Set oBrowser = Nothing
BrowseForFolderF = folderStr

End Function


Public Function CheckFolder(ByVal strPath As String) As Variant
Dim objFolder ''As Scripting.Folder
Dim objFile ''As Scripting.File
Dim objSubdirs ''As Scripting.Folders
Dim objLoopFolder ''As Scripting.Folder
Dim varFs() As Variant
Dim m_objFSO, n, m_lngFileCount

Set m_objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = m_objFSO.GetFolder(strPath)
'
' Check files in this directory
'
n = -1
For Each objFile In objFolder.Files
If UCase$(Right$(objFile.ShortPath, 4)) = ".DWG" Then
m_lngFileCount = m_lngFileCount + 1
n = n + 1
ReDim Preserve varFs(n)
varFs(n) = objFile.Path
End If
Next objFile

' Loop through all subdirectories and
' do the same thing.
'
Set objSubdirs = objFolder.SubFolders
For Each objLoopFolder In objSubdirs
CheckFolder objLoopFolder.Path
Next objLoopFolder

Set objSubdirs = Nothing
Set objFolder = Nothing
CheckFolder = varFs
End Function


Private Sub CreateCSVFile(fso As Variant, strFname As String)
Dim tf
If Not fso.FileExists(strFname) Then
Set tf = fso.CreateTextFile(strFname, True)
Set tf = Nothing
End If
End Sub


Private Sub WriteToCSVFile(strFname As String, strData As String)
Open strFname For Append As #1
Write #1, strData
Close #1
End Sub


Sub BatchReadTitleBlock()
Dim oblkRef As AcadBlockReference
Dim objFnd As AcadEntity
Dim indx As Integer
Dim iFiles() As Variant
Dim m_objFSO
Dim fold, DwgName, cnt As Integer, nm As String

fold = BrowseForFolderF("Select Folder for CutList Generation")
Set m_objFSO = CreateObject("Scripting.FileSystemObject")

iFiles = CheckFolder(fold)

CreateCSVFile m_objFSO, "C:\AutoLoft\CutList.txt"

Dim oDbx As AxDbDocument

Set oDbx = GetInterfaceObject("ObjectDBX.AxDbDocument.16") '/// or 17 for A2007-8

On Error Resume Next
For indx = LBound(iFiles) To UBound(iFiles)
DwgName = iFiles(indx)
oDbx.Open DwgName

For Each objFnd In oDbx.PaperSpace
If TypeOf objFnd Is AcadBlockReference Then
Set oblkRef = objFnd
If StrComp(UCase(oblkRef.Name), "TITLEBLOCK", 1) = 0 Then
Exit For
End If
End If
Next objFnd

With oblkRef
Dim atts As Variant
Dim strData As String
Dim i
strData = .Name
atts = .GetAttributes
For i = 0 To UBound(atts)
strData = strData & ";" & atts(i).TextString
Next i
End With

WriteToCSVFile "C:\AutoLoft\CutList.txt", strData

Next indx

Set oDbx = Nothing

MsgBox "Text File Created: C:\AutoLoft\CutList.txt"

End Sub

[Anonymous]

That was it. I was called away and didn't get to dig into it.

I did add a sub to clear out the text file before filling it up. Otherwise, it'd always just append onto the old file.

Thanks again for everything. And I hope this code benefits others out there.

One thing I'd like to suggest for everybody posing questions on the message boards - Try to be specific in your subject. There's a whole slew of posts with one word - "ObjectDBX" as a subject. One has to open all of them to see what they are about. If you put important words relating to your question, then they can be found with different searches, and are easier to sort thru.

Thanks again, Fatty.

[Anonymous]

Glad you figured it out
Youre welcome

~'J'~