Jump to content

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


extrawurscht

Recommended Posts

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)

Link to comment
Share on other sites

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 by fixo
Link to comment
Share on other sites

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

Link to comment
Share on other sites

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.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
×
  • Create New...