extrawurscht Posted January 2, 2011 Share Posted January 2, 2011 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) Quote Link to comment Share on other sites More sharing options...
fixo Posted January 4, 2011 Share Posted January 4, 2011 (edited) 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 Edited January 4, 2011 by fixo Quote Link to comment Share on other sites More sharing options...
extrawurscht Posted January 8, 2011 Author Share Posted January 8, 2011 Hello, Thank you. I will try this. A question, for what is the First Code? Where to add? Quote Link to comment Share on other sites More sharing options...
fixo Posted January 8, 2011 Share Posted January 8, 2011 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'~ Quote Link to comment Share on other sites More sharing options...
Recommended Posts
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.