Excel и AutoCAD Electrical

[bablzz]

Здравствуйте
Есть файл екселя с кнопкой. при нажатии кнопки должно выполняться следующее:
1) Открыться автокад с новым чертежом(новый файл)
2) Есть папка готовых файлов автокада(.dwg). в 1 файле - 1 блок(ну то что там я начертил). нужно, желательно, не открывая эти файлы, скопировать то что хранится в них в открытый автокад, исходя из данный в екселе.
3) Данные в экселе:


попроще, а то я сам не особо понял что написал)
при нажатии кнопки открывается автокад. идет считывание с таблицы эксель. и если напротив названия чертежа стоит не 0, то с того файла(чертежа) копируется в новый автокад то, что там есть. чертежи лежат в одной папке.

[doober]

А теперь еще раз и помедленнее.
У вас открыт -создан новый файл dwg.
В него вы собираетесь вставить блоки,или то что начерчено,это большие две разницы.
Это выполнимо.
А как задать точку вставки( координаты X,Y,Z)?.Без нее ничего не получится.Можно все сделать проще макросом из Автокада загрузить данные с Екселя и произвести вставку чертежей.
Если у вас начерченый блок-то у него есть имя,это все упростит задачу.
Можете загрузить пару чертежей и файл Екселя.На пальцах объяснение не поможет

[bablzz]

В чертежах начерчен блок- в каждом файле по 1.
при нажатии кнопки нужно открыть автокад с новым чертежом и на него выкинуть те самые блоки.
То есть:
нажал кнопку->открылся автокад->выкинулись блоки.
а с точками вставки я где то видел. как найду, отпишусь

вот нашел на форуме

Sub InsertBlocksFromBook(name As String)

Dim rng As Range
Dim attData()
Dim acadApp As AcadApplication
Dim acadDocs As AcadDocuments
Dim acadDoc As AcadDocument
Dim Util As AcadUtility
Dim i As Long, j As Long, cnt As Integer, n As Integer, num As Integer
Dim pt As Variant
Dim blockName As String
Dim blkRef As AcadBlockReference
Dim varAttributes As Variant
Dim oAttribute As AcadAttributeReference

On Error GoTo Error_Control

exHwnd = Application.hwnd
Set rng = Application.Application.InputBox(Pr ompt:="Выберите диапазон ячеек", Title:="Вставка блоков в Autocad", Type:=8)

rng.Select

ReDim attData(0 To rng.Rows.Count - 1, 0 To rng.Columns.Count - 1)
For i = 1 To rng.Rows.Count
For j = 1 To rng.Columns.Count
attData(i - 1, j - 1) = rng.Cells(i, j)
Next
Next


Set acadApp = ConnectToAcad
acHwnd = acadApp.HWND32
Putfocus acHwnd
Set acadDocs = acadApp.Documents
Set acadDoc = acadDocs.Open(name)

acadApp.WindowState = acMax
acadDoc.Activate
acadDoc.ActiveSpace = acModelSpace
MsgBox "Вставьте блоки в автокад"
For i = 0 To UBound(attData)
num = CInt(attData(i, 0))
blockName = CStr(attData(i, 1))

For cnt = 0 To num - 1

Set Util = acadDoc.Utility

pt = acadDoc.Utility.GetPoint(, vbCr & "Выбирете точку вставки блока >>")

Set blkRef = acadDoc.ModelSpace.InsertBlock(pt, blockName, 1, 1, 1, 0)
varAttributes = blkRef.GetAttributes
For n = 0 To UBound(varAttributes)
Set oAttribute = varAttributes(n)
Dim tag As String
If oAttribute.TagString = "TYPE" Then
oAttribute.TextString = CStr(attData(i, 2))
oAttribute.Update
ElseIf oAttribute.TagString = "VOLT" Then
oAttribute.TextString = CStr(attData(i, 3))
oAttribute.Update
ElseIf oAttribute.TagString = "CAT" Then
oAttribute.TextString = CStr(attData(i, 4))
oAttribute.Update
End If
Next n
blkRef.Update
Next cnt
Next i

acadApp.ZoomExtents
Set acadDoc = Nothing
Set acadDocs = Nothing
Set acadApp = Nothing

Putfocus exHwnd

Inserts_Exit:
If Err.Number <> 0 Then
MsgBox Err.Description
Else
MsgBox "ок!"
End If
On Error GoTo 0
Exit Sub

Error_Control:
Resume Inserts_Exit

End Sub

[doober]

Этот код немного не с той оперы.
Открываем чертежи и просто копируем блоки в чертеж,а дальше вы будете их раставлять как надо.
Теперь более менее понятно.

[bablzz]

ну так это выполнимо?

[doober]

Конечно выполнимо.Сохраните файлы в формате DXF.Для доступа к ним.Во вложении два варианта
1.сохранение файла.
2.просмотр.
точка вставки одна для всех.можете добавить сдвиг
Если надо соответствующее количество блоков вставлять,копирование поставте в цикл

Не забудьте в Референсах ссылку на библиотеку Autokad добавить.У меня стоит на 2008

[bablzz]

Спасибо большое!