Tool for cabel list, export Atrribute from ACAD to Excel with zoom an "live" edit

[extrawurscht]

Hello,

i am looking for a tool to export attributes from autocad to excel for a cable list. In the drawing are 2 blocks with the same cable number as one attribute and the FROM block contains the attribute to device and the TO block contains the attribute from device. Then i want to connect ACAD with Excel.
The tool can be an external programm...
In excel i want to edit the values of the attributes. If i click on a cell in excel, i want to zoom center to the value in ACAD. For example, if i click in excel to cabel number V1040 i want to zoom to the position where this text is included in acad.
If i change something in excel, and leave the cell with enter, it should change the value in acad at once. (Backward is not so important) I also want to use the excel editing options.
I have a give style of excel cable list with the headline:

cable Nr, core, from device, from junction, from room, to device, to junction, to room.
Al other cells i will fill by hand, and no need to write back in acad.
I have seen a tool like this a few weeks ago at a laptop of a college. This tool worked with comments in excel:
for cable number e.g. two entries: Zeichnung3.dwg2119022128
Zeichnung3.dwg2119022160
and for to device: Zeichnung3.dwg2119022136
and from device: Zeichnung3.dwg2119022168

I know the tools attout and attin. maybe its better to work with this HANDLE numbers as comments in excel because in this tool i can not reconnect to a existing excel.

Can sombody help me? Some advice?
Thank you very much.
Greetings

(a long text, i know)

[fixo]

For the quick test add this code into ThisWorkBook module in VBAIDE (Alt+F11)etc

 
Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
MsgBox "Cell double  clicked: """ & Target.Row & ":" & Target.Column & """" & vbCr & _
"Value: " & Target.Value & vbCr & _
"Add your code after this line"
Cancel = True
End Sub

Insert module in your Excel file
paste the following code in there
this will get you started I hope

Option Explicit
' Requires:
' AutoCAD 200X Object Library (tested on A2009 only)
'Tools->Options->General tab->Error trapping ->Break on Unhandled Errors
Const folderPath As String = "C:\Users\...\TempVBA\" '<-- change the folder name here (add backslash at the end)
'by Randall Rath
Function IsExcelRunning() As Boolean
     Dim objACAD As Object
     On Error Resume Next
     Set objACAD = GetObject(, "AutoCAD.Application")
     IsExcelRunning = (Err.Number = 0)
     Set objACAD = Nothing
     Err.Clear
End Function
 
Public Sub GotoAcad()
    Application.Cursor = xlWait
    Application.WindowState = xlMinimized
    Dim dwgName As String
    Dim rng As Range
   Dim handle As String
    Dim cel As Range
    Dim i As Long
    Dim j As Long
    Dim n As Long
    Dim k As Long
    Dim attArr As Variant
    Dim acApp As AcadApplication
    Dim acDocs As AcadDocuments
    Dim oLayout As AcadLayout
    Dim oEnt As AcadEntity
    Dim blkRefObj As AcadBlockReference
    Dim adoc As AcadDocument
    Dim attObj As AcadAttributeReference
    '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
    On Error GoTo Error_Control
 
    Set rng = ActiveSheet.Range("C2") ' <--Zeichnung3.dwg2119022168 must be a handle instead of ObjectID
    dwgName = Trim(CStr(rng.Value))
    n = InStr(1, dwgName, "dwg", 1) + 3
   handle = Trim(Mid(dwgName, n))
dwgName = Left(dwgName, n - 1)
'MsgBox folderPath & dwgName & vbCr & "Handle: " & handle '<-- debug only
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
    On Error Resume Next
        'late binding to Acad
     Dim oACAD As Object
     Dim blnAcadRunning As Boolean
     blnAcadRunning = IsExcelRunning()
     If blnAcadRunning Then
          Set oACAD = GetObject(, "AutoCAD.Application")
     Else
          Set oACAD = CreateObject("AutoCAD.Application")
          oACAD.Visible = True
     End If
'    acApp.ActiveDocument.SetVariable "SDI", 0 'optional
    Set acDocs = oACAD.Documents
 
Set adoc = acDocs.Open(folderPath & dwgName, False)
adoc.Activate
 
Dim oAtt As AcadAttributeReference
Dim oBref As AcadBlockReference
Dim p1 As Variant
Dim p2 As Variant
Dim layoutname As String
Dim layout As AcadLayout
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
Set oEnt = adoc.HandleToObject(handle)
If oEnt Is Nothing Then
MsgBox "Invalid handle, exit..."
Exit Sub
End If
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
If TypeOf oEnt Is AcadAttributeReference Then
Set oAtt = oEnt
Set oBref = adoc.ObjectIdToObject(oAtt.OwnerID)
oBref.GetBoundingBox p1, p2
layoutname = adoc.ObjectIdToObject(oBref.OwnerID).layout.Name
Set layout = adoc.Layouts.Item(layoutname)
adoc.ActiveLayout = layout
adoc.Application.ZoomWindow p1, p2
Dim attStr As String
attStr = oAtt.TextString
'MsgBox attStr'<-- debug only
oAtt.TextString = "New Value"
oAtt.Update
oBref.Update
Else
MsgBox "Object is not an attribute, exit..."
Exit Sub
End If
        adoc.SaveAs folderPath & dwgName, acNative
        adoc.Close
 
    Set adoc = Nothing
    Set acDocs = Nothing
    oACAD.ActiveDocument.Close
 
    oACAD.Quit
    Set oACAD = Nothing
 
    '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
    DoEvents
    Application.WindowState = xlMaximized
    Application.Cursor = xlDefault
    MsgBox "Done, check a changes in the drawing"
 
Error_Control:
If Err.Number <> 0 Then
Err.Clear
MsgBox Err.Description
End If
End Sub

[extrawurscht]

Hello,
Thank you.
I will try this.
A question, for what is the First Code? Where to add?

[fixo]

Hello,
Thank you.
I will try this.
A question, for what is the First Code? Where to add?

This one is just for dispalying selected cell value
So forget about them
(Usualy it is embedded in ThisWorkBook module)

~'J'~