[Unreal_2007]

здраствуйте.
необходимо перенести данные из атрибутов блоков в excel.
Сейчас делаю это командой attout (из дополнений), сохраняю в текстовый файл, запускаю excel открыть файл, (выбрать кодировку)
и далее обрабатываю макровом VBA...
Как можно это дело свести до одной команды Autocad.
Т.е. выгрузить данные и запустить excel с моим макросом...

примного благодарен...

[VVA]

Попробуй _eattext, может понравится

[fixo]

Очень мутно поставлен вопрос, я по слабости ума
так и не понял, что тебе нужно конкретно.
Для образца:

Код:

[Выделить все]

Option Explicit

Public Sub WriteAttributes()

Dim oSset As AcadSelectionSet
Dim oEnt As AcadEntity
Dim oBlkRef As AcadBlockReference
Dim oAtt As AcadAttributeReference
Dim varAtt As Variant
Dim i As Long
Dim ftype(1) As Integer
Dim fdata(1) As Variant
ftype(0) = 0: fdata(0) = "INSERT"
ftype(1) = 66: fdata(1) = 1
Dim dxftype As Variant
Dim dxfdata As Variant
dxftype = ftype
dxfdata = fdata
'---------------------
Dim xlApp As Object
Dim xlBook As Workbook
Dim xlSheet As Worksheet
Dim lngRow As Long, lngCol As Long

'---------------------
On Error Resume Next
Set xlApp = GetObject(, "Excel.Application")
If Err <> 0 Then
Err.Clear
Set xlApp = CreateObject("Excel.Application")
If Err <> 0 Then
MsgBox "Impossible to initialize an Excel.", vbExclamation
End
End If
End If
'---------------------

On Error Resume Next
Set oSset = ThisDrawing.SelectionSets.Item("$Attribs$")
If Err Then
Err.Clear
Set oSset = ThisDrawing.SelectionSets.Add("$Attribs$")
End If

On Error GoTo Err_Control

oSset.SelectOnScreen dxftype, dxfdata
'---------------------
xlApp.Visible = True
Set xlBook = xlApp.Workbooks.Add
xlBook.Sheets.Add.Name = 1
Set xlSheet = xlBook.Sheets(1)
lngRow = 1
xlSheet.Cells(lngRow, 1).Value = "Tag"
xlSheet.Cells(lngRow, 2).Value = "Value"
xlSheet.Cells(lngRow, 1).Font.Bold = True
xlSheet.Cells(lngRow, 2).Font.Bold = True
'---------------------

For Each oEnt In oSset

Set oBlkRef = oEnt
varAtt = oBlkRef.GetAttributes
For i = 0 To UBound(varAtt)
Set oAtt = varAtt(i)
lngRow = lngRow + 1
xlSheet.Cells(lngRow, 1).Value = oAtt.TagString
xlSheet.Cells(lngRow, 2).Value = oAtt.TextString
Next i

Next oEnt

'--------------------
xlSheet.Columns.HorizontalAlignment = xlHAlignLeft
xlSheet.Columns.AutoFit
xlBook.SaveAs ThisDrawing.Path & "\Attributes.xls"
xlBook.Close
'--------------------
xlApp.Application.Quit
Set xlApp = Nothing
Set xlBook = Nothing
Set xlSheet = Nothing
'--------------------
MsgBox "Done"
'--------------------
Err_Control:

End Sub

~'J'~

[Unreal_2007]

мне надо экспортировать данные аттрибутов блоков в Excel и запустьть макрос Excel на выполнение...

сейчас попробую прогу, Fatty спасибо

[Unreal_2007]

не пашет, я наверно гдето туплю...


:cry: User-defined type not defined
на строчках:
Dim xlBook As Workbook
Dim xlSheet As Worksheet

[VVA]

мне надо экспортировать данные аттрибутов блоков в Excel

Настоятельно рекомендую попробывать
_EATTEXT

[Unreal_2007]

да дело не втом какой командой...
у меня вопрос как объединить все действия...
1)выгрузить в txt
2) загрузить в excel
3) запустить мой макрос для обработки...

[fixo]

Сообщение от Unreal_2007 не пашет, я наверно гдето туплю... :cry: User-defined type not defined на строчках: Dim xlBook As Workbook Dim xlSheet As Worksheet

Ты не добавил ссылку на библиотеку Excel

В редакторе VBA:

Tools->References->Microsof Excel XX.0 Object Library
И еще там же:
Tools->Options->General->Erorr Trapping->Break on Unhandled Errors

И все будет чикипуки

~'J'~

[Unreal_2007]

Млин, СУПЕРРРР...
А можно только в excel загонять в следующем вормате.
имя блока \\ Атрибут1\\ Артебут2\\...
блок1 \\ 1 \\ 2 \\
блок2 \\ 1 \\ 2 \\

плиZZZ

[fixo]

Легко

~'J'~

[fixo]

Небольшая редакция:

Код:

[Выделить все]

Option Explicit

Public Sub WriteAttributes()

Dim oSset As AcadSelectionSet
Dim oEnt As AcadEntity
Dim oBlkRef As AcadBlockReference
Dim oAtt As AcadAttributeReference
Dim varAtt As Variant
Dim i As Long
Dim ftype(1) As Integer
Dim fdata(1) As Variant
ftype(0) = 0: fdata(0) = "INSERT"
ftype(1) = 66: fdata(1) = 1
Dim dxftype As Variant
Dim dxfdata As Variant
dxftype = ftype
dxfdata = fdata
'---------------------
Dim xlApp As Object
Dim xlBook As Workbook
Dim xlSheet As Worksheet
Dim lngRow As Long, lngCol As Long

'---------------------
On Error Resume Next
Set xlApp = GetObject(, "Excel.Application")
If Err <> 0 Then
Err.Clear
Set xlApp = CreateObject("Excel.Application")
If Err <> 0 Then
MsgBox "Impossible to initialize an Excel.", vbExclamation
End
End If
End If
'---------------------

On Error Resume Next
Set oSset = ThisDrawing.SelectionSets.Item("$Attribs$")
If Err Then
Err.Clear
Set oSset = ThisDrawing.SelectionSets.Add("$Attribs$")
End If

On Error GoTo Err_Control

oSset.SelectOnScreen dxftype, dxfdata
'---------------------
xlApp.Visible = True
Set xlBook = xlApp.Workbooks.Add
xlBook.Sheets.Add.Name = 1
Set xlSheet = xlBook.Sheets(1)
lngRow = 1
xlSheet.Cells(lngRow, 1).Value = "Block Name"
'For i = 2 To 11
'xlSheet.Cells(lngRow, i).Value = "Attribue " & CStr(i - 1)
'Next
xlSheet.Rows(1).Font.Bold = True
xlSheet.Rows(1).Font.ColorIndex = 5
'---------------------
lngRow = 2
For Each oEnt In oSset

Set oBlkRef = oEnt
If oBlkRef.IsDynamicBlock Then
xlSheet.Cells(lngRow, 1).Value = oBlkRef.EffectiveName
Else
xlSheet.Cells(lngRow, 1).Value = oBlkRef.Name
End If
varAtt = oBlkRef.GetAttributes
lngCol = 2
For i = 0 To UBound(varAtt)
Set oAtt = varAtt(i)
xlSheet.Cells(lngRow, lngCol).Value = oAtt.TagString
xlSheet.Cells(lngRow + 1, lngCol).Value = oAtt.TextString
lngCol = lngCol + 1

Next i

lngRow = lngRow + 2

Next oEnt
'--------------------
Dim oRange As Range
Set oRange = xlSheet.UsedRange
For i = 2 To oRange.Columns.Count
xlSheet.Cells(1, i).Value = "Attribue " & CStr(i - 1)
Next
'--------------------
xlSheet.Columns.HorizontalAlignment = xlHAlignLeft
xlSheet.Columns.AutoFit
xlBook.SaveAs ThisDrawing.Path & "\Attributes.xls"
xlBook.Close
'--------------------
xlApp.Application.Quit
Set xlApp = Nothing
Set xlBook = Nothing
Set xlSheet = Nothing
'--------------------
MsgBox "Done"
'--------------------

'[А здесь выполняешь свой макрос]

Err_Control:

End Sub

~'J'~