• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 853
  • Last Modified:

Can anyone provide a VBA code example to read dwg file title block

We have a dwg files with title block which contains name of the customer, components etc. I want to read those information and display on the screen.
  • 2
  • 2
  • 2
  • +1
1 Solution
If you have the title block with attributes you can extract the information to Excel.
Extracting a database from attributes
After you insert all your blocks and attributes, you can extract the data using the
Attribute Extraction Wizard. To start the wizard, choose
Tools➪Attribute Extraction.
✦ The horizontal view is like a spreadsheet, with a column for each tag and a
row for each incident of the block.
✦ The vertical view lists the attribute values vertically so that each value gets
its own row.
Choose No Template
Click Alternate view to see each view.
n the Select Attributes screen, shown in Figure 18-28, you choose the blocks you
want to work with and their attributes.
In the Export screen, you name the file that will contain the extracted attributes.
Click the Ellipsis button to specify the location and file name in a typical file
dialog box.

✦ Microsoft Excel (*.xls): Creates an Excel spreadsheet.
To create the file, click Finish. A dialog box asks if you want to write to the file. Click
Yes. The wizard closes.

I can supply the complete text if needed.


sandip_patankarAuthor Commented:

I need VB code to read the title block.  
What I did was to make a block and enter attribute data. I then had the information saved into an excel file, complete with column titles that reflected the attribute descriptions.  The text is in "2004 Bible" e-book.
Free Tool: SSL Checker

Scans your site and returns information about your SSL implementation and certificate. Helpful for debugging and validating your SSL configuration.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

Corey ScheichDeveloperCommented:
For 125 points you get the function I used to replace text in autocad modify it to suit your needs

Function acadREPLACETEXT() As String
Dim myBLOCK As AcadBlock
Dim ThisBlock As AcadBlockReference
Dim atts As Variant
Dim NewString As String
Dim ThisAtt As AcadAttributeReference
Dim Loc As Long
Dim thisText As AcadText
Dim txtLength As Long
Dim Find500 As Boolean
Dim FindHRSHT As Boolean
Dim FindSHT As Boolean

Find500 = False
FindHRSHT = False
FindSHT = False

Dim MSIcount As Long
Dim Ent As AcadEntity

MSIcount = 1

For MSIcount = 1 To (ACADapp.ActiveDocument.ModelSpace.Count - 1)
    If ACADapp.ActiveDocument.ModelSpace.Item(MSIcount).ObjectName = "AcDbBlockReference" Then
        Set ThisBlock = ACADapp.ActiveDocument.ModelSpace.Item(MSIcount)
        atts = ThisBlock.GetAttributes
        Count = 0
        For Count = 0 To UBound(atts)
            Set ThisAtt = atts(Count)
            Loc = 0
            Loc = VBA.InStr(1, ThisAtt.TextString, "500", vbTextCompare)
            txtLength = 0
            txtLength = Len(ThisAtt.TextString)
            If Loc = 1 And txtLength = 6 Then
                ThisAtt.TextString = "500610"
                Find500 = True
            End If
            Loc = VBA.InStr(1, ThisAtt.TextString, "HRSHT", vbTextCompare)
            If Not Loc = 0 Then
                ThisAtt.TextString = "HRSHT(72X120)"
                FindHRSHT = True
            End If
            Loc = VBA.InStr(1, ThisAtt.TextString, " SHT", vbTextCompare)
            If Not Loc = 0 Then
                ThisAtt.TextString = StkQty & " SHT"
                FindSHT = True
            End If
    End If
    If ACADapp.ActiveDocument.ModelSpace.Item(MSIcount).ObjectName = "AcDbText" Then
        Set thisText = ACADapp.ActiveDocument.ModelSpace.Item(MSIcount)
        Loc = VBA.InStr(1, thisText.TextString, "LAST PLOT", vbTextCompare)
        If Not Loc = 0 Then
            thisText.TextString = "LAST PLOT DATE: " & Date & " " & Time
        End If
    End If
acadREPLACETEXT = "Didn't find: "
If Find500 = False Then
    acadREPLACETEXT = acadREPLACETEXT & "500, "
End If
If FindHRSHT = False Then
End If
If FindSHT = False Then
End If
If acadREPLACETEXT = "Didn't find: " Then
    acadREPLACETEXT = "Replaced all strings"
End If
End Function
did you ever come up wit a solution?
IMO, Corey should get this one, that should have gotten them started.
Corey ScheichDeveloperCommented:
Thank you Norrin

Featured Post

Important Lessons on Recovering from Petya

In their most recent webinar, Skyport Systems explores ways to isolate and protect critical databases to keep the core of your company safe from harm.

  • 2
  • 2
  • 2
  • +1
Tackle projects and never again get stuck behind a technical roadblock.
Join Now