Linking Text to Excel.....Is It Possible?

[Bizkit]

Is it possible to link text from Excel cells to attributes in a block ...

We basically have to make over 100 drawings that have 100 diffrent borders with diffrent data in them...And we would like to have them all in one central location.

[ReMark]

Yes it is. Take a look at this:

 

http://thecadgeek.com/blog/2008/03/12/update-block-attributes-using-excel/

[Bizkit]

not quite what i was looking for....I need something more dynamic to manage all this text....Even if its third party software.

[ReMark]

Would fields and a linked database be of any usefulness?

[Bizkit]

That would be a possability.....Please explain

[dbroada]

I'm not if sure you can link to attributes directly but you might be able to set up a data link from your drawing to excel and then use fields to link to the table. This is just thinking out loud so may not work.

 

I have had problems using fields referencing objects as it seems to only work on "this" drawing. If you cut & paste into another drawing the links get broken (I think)

[Bizkit]

Please explain?

[ReMark]

Bizkit: If I could beg your indulgence for one brief moment and ask a favor. Could you provide a bit more detail about what you would like to do and/or the results you're looking to achieve? That would get everyone thinking along the same lines. Thanks.

[Bizkit]

What I am trying to achive is a simple way to update data on a large amount of drawings for example.:

I will have 100 or so Landplats one for each land owner involved in this project.

I would like to have a spread sheet that has all the land owner names and have those cell with the landowner names linked to come out in the title block of each drawing. And if we get more upto date information (which we do...all the time) All that would need to happen is someone would edit the spread sheet and then re-plot the drawing.

 

is this possible?

[ReMark]

I see your using Civil 3D 2008. And the link I provided above just didn't do for you. I believe that the Excel->AutoCAD and AutoCAD ->Excel linkage has finally been fully established in 2009. I just can't recall if it that was the case for 2008 products. Unfortunately, my one good source for that info is sitting in another office at the moment. None-the-less, I truely believe you can achieve your end result using blocks/attributes and Excel. Take heart, someone will come along and point us both in the right direction.

[Bizkit]

We are about to Roll out Civil3D 2009....Do you mind explaing how this is better in 2009

[ReMark]

I'm working on a little research. But I did stumble across this interesting tidbit from DotSoft regarding XL2CAD. Check it out. Pricing shown at bottom of web page.

 

http://www.dotsoft.com/xl2cad.htm

[CmdrDuh]

Option Explicit
Public Sub PushAttributes()
     Dim objSelSet As AcadSelectionSet
     Dim objExcel As Excel.Application
     Dim objExcelSheet As Excel.Worksheet
     Dim intActR As Integer
     Dim blnFoundAttributes As Boolean
     Dim blnRunning As Boolean
     Dim strDwgNo As String
     Dim strProjectName As String
     Dim strLogName As String
     Dim foundCell As Range
     Dim intType(0 To 1) As Integer
     Dim varData(0 To 1) As Variant
     Dim objBlkRef As AcadBlockReference
     Dim atts As Variant
     Dim objSelCol As AcadSelectionSets
     Dim XL(6) As String
     Dim objAttRef As AcadAttributeReference
     On Error GoTo Err_Control:
     ThisDrawing.SetVariable "PROJECTNAME", "PushAtts"
     Set objSelCol = ThisDrawing.SelectionSets
     If objSelCol.Count > 0 Then
           For Each objSelSet In objSelCol
                 If objSelSet.Name = "Title" Then
                       objSelSet.Delete
                       Exit For
                 End If
           Next
     End If
     strProjectName = ThisDrawing.GetVariable("Projectname")
          strLogName = "c:\PMS\" & strProjectName & ".xls"
     blnRunning = IsAppRunning
     If blnRunning Then
           Set objExcel = GetObject(, "Excel.Application")
           If objExcel.ActiveWorkbook = strProjectName Then
                 objExcel.Workbooks.Open strLogName
                 Set objExcelSheet = objExcel.ActiveWorkbook.Sheets("Sheet1")
           End If
     Else
           Set objExcel = CreateObject("Excel.Application")
           objExcel.UserControl = True
           objExcel.Visible = True
           objExcel.Workbooks.Open strLogName
           objExcel.Sheets("Sheet1").Activate
           Set objExcelSheet = objExcel.ActiveWorkbook.Sheets("Sheet1")
     End If


     '      objExcel.Workbooks.Open strLogName
     '      Set objExcelSheet = objExcel.ActiveWorkbook.Sheets("Sheet1")
     strDwgNo = Left(ThisDrawing.Name, Len(ThisDrawing.Name) - 4)
     Set foundCell = objExcelSheet.Range("b4", objExcelSheet.Range("b4").End(xlDown)).Find(strDwgNo)
     If foundCell Is Nothing Then
           MsgBox ("Did not find a drawing #")
           objExcel.ActiveWorkbook.Save
           objExcel.Quit
           Exit Sub
     Else
           foundCell.Activate
           intActR = objExcel.ActiveCell.Row
           Set foundCell = Nothing
     End If

     XL(0) = StrConv(objExcelSheet.Cells(intActR, 1).Value, 1)     'Sheet Number
     XL(1) = StrConv(objExcelSheet.Cells(intActR, 2).Value, 1)     'Drawing Number
     XL(2) = StrConv(objExcelSheet.Cells(intActR, 3).Value, 1)     'Revision Number
     XL(3) = StrConv(objExcelSheet.Cells(intActR, 4).Value, 1)     'Code Number
     XL(4) = StrConv(objExcelSheet.Cells(intActR, 5).Value, 1)     'Line 1
     XL(5) = StrConv(objExcelSheet.Cells(intActR, 6).Value, 1)     'Line 2
     XL(6) = StrConv(objExcelSheet.Cells(intActR, 7).Value, 1)     'Line 3
     Set objSelSet = objSelCol.Add("Title")
     intType(0) = 0: varData(0) = "INSERT"
     intType(1) = 2: varData(1) = "TITLINFO,VTITLINFO,8.5x11_BDR,vinfo"
     objSelSet.Select Mode:=acSelectionSetAll, filtertype:=intType, filterdata:=varData
     For Each objBlkRef In objSelSet
           If objBlkRef.HasAttributes Then
                 blnFoundAttributes = True
                 atts = objBlkRef.GetAttributes
                 Set objAttRef = atts(0)
                 objAttRef.TextString = XL(4)
                 Set objAttRef = atts(1)
                 objAttRef.TextString = XL(5)
                 Set objAttRef = atts(2)
                 objAttRef.TextString = XL(6)
                 Set objAttRef = atts(3)
                 objAttRef.TextString = XL(1)
                 Set objAttRef = atts(4)
                 objAttRef.TextString = XL(2)
                 Set objAttRef = atts(5)
                 objAttRef.TextString = XL(3)
                 Set objAttRef = atts(6)
                 objAttRef.TextString = XL(0)
           End If
     Next objBlkRef
     If Not blnRunning Then
     'We started the instance, so we can close it
           objExcel.ActiveWorkbook.Save
           objExcel.Quit
     End If
     ThisDrawing.Save
Exit_Here:
     strDwgNo = ""
     ThisDrawing.SetVariable "PROJECTNAME", "."
     Set objExcel = Nothing
     Set objExcelSheet = Nothing
     Exit Sub
Err_Control:
     objExcel.Quit
     Set objExcel = Nothing
     Set objExcelSheet = Nothing
     MsgBox Err.Description, vbOKOnly, Err.Number
     Resume Exit_Here
End Sub
'This determines how to set the Excel instance.
Private Function IsAppRunning() As Boolean
     Dim objExcel As Excel.Application
     On Error Resume Next
     Set objExcel = GetObject(, "Excel.Application")
     IsAppRunning = (Err.Number = 0)
     Set objExcel = Nothing
     Err.Clear
End Function

[CmdrDuh]

The above code is what I use to take values from an excel spreadsheet and populate my titleblocks for 100's of drawings at a time. I use a script to open the dwg and call the PushAttributes. It finds the drawing number in the SS and looks at the other colums on that row, and takes that data back to autocad

[CmdrDuh]

Bear in mind I have other stuff going on in that you might have to just erase. browse thru this, and let me know if you need help

[fontebk1]

I'm using your code and i'm trying to populate mutiple blocks with different lines from excel. How do you loop through each block and assign each cell to the correct block attribute? It runs throught the first block and then gives me a error "subscript out of range"

[CmdrDuh]

Can you post what you have so far and include a dwg file with the blocks

[fontebk1]

I got it, its not pertty but it works. It been along time since I have done any vba.

 

Thanks