+ Reply to Thread
Results 1 to 4 of 4
  1. #1
    Forum Newbie
    Using
    AutoCAD 2010
    Join Date
    Dec 2010
    Posts
    6

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

    Registered forum members do not see this ad.

    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)

  2. #2
    Super Member fixo's Avatar
    Computer Details
    fixo's Computer Details
    Operating System:
    Windows 7
    Motherboard:
    E7500
    CPU:
    Intel(R)Core(TM)2 DUO CPU 2.93HGz
    RAM:
    4098 Gb
    Graphics:
    1024 Gb
    Using
    AutoCAD 2009
    Join Date
    Jul 2005
    Location
    Thanks God, I'm far enough from Hitleropa
    Posts
    1,697

    Default

    For the quick test add this code into ThisWorkBook module in VBAIDE (Alt+F11)etc
    Code:
     
    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
    Code:
    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
    Last edited by fixo; 4th Jan 2011 at 11:50 pm.
    The soul is healed by being with children. - Fyodor Dostoyevsky, novelist (1821-1881)

  3. #3
    Forum Newbie
    Using
    AutoCAD 2010
    Join Date
    Dec 2010
    Posts
    6

    Default

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

  4. #4
    Super Member fixo's Avatar
    Computer Details
    fixo's Computer Details
    Operating System:
    Windows 7
    Motherboard:
    E7500
    CPU:
    Intel(R)Core(TM)2 DUO CPU 2.93HGz
    RAM:
    4098 Gb
    Graphics:
    1024 Gb
    Using
    AutoCAD 2009
    Join Date
    Jul 2005
    Location
    Thanks God, I'm far enough from Hitleropa
    Posts
    1,697

    Default

    Registered forum members do not see this ad.

    Quote Originally Posted by extrawurscht View Post
    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'~
    The soul is healed by being with children. - Fyodor Dostoyevsky, novelist (1821-1881)

Similar Threads

  1. Wheel mouse zoom - "already zoomed out as far as possible"
    By nscherneck in forum Hardware & Operating Systems
    Replies: 17
    Last Post: 13th Jul 2011, 01:00 am
  2. "Export Layout To Model" eKey not found error?
    By muck in forum AutoLISP, Visual LISP & DCL
    Replies: 1
    Last Post: 6th Aug 2009, 12:26 pm
  3. Replies: 1
    Last Post: 8th May 2009, 08:04 pm
  4. Edit "Space Generate" Tool
    By caddie in forum Architecture & ADT
    Replies: 0
    Last Post: 18th Mar 2009, 09:58 pm
  5. Land Desktop "ZOOM TO POINTS" zooms to space....
    By bubbalenko in forum Civil 3D & LDD
    Replies: 2
    Last Post: 21st May 2008, 02:03 am

Bookmarks

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts