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'~