[scainet]

Кто бы мог привести текст программы, которая осуществляла бы вставку блоков в Autocad по данным из таблицы Excel. В таблице присутствуют названия блоков, их количесво, которое должно появиться в Acade, и значения атрибутов этих блоков...

[Nike]

Вот пример такой программы
http://dwg.ru/dnl/101

[scainet]

Нужно чтоб было выполнено в VBA т.е. при нажатии кнопки в экселе запускался автокад и в чертеж загружались бы нужные блоки, описанные в таблице эксель

[Олег (jr.)]

Сообщение от scainet Кто бы мог привести текст программы, которая осуществляла бы вставку блоков в Autocad по данным из таблицы Excel. В таблице присутствуют названия блоков, их количесво, которое должно появиться в Acade, и значения атрибутов этих блоков...

Покажи скриншот диапазона Эксель или
залей файл Эксель сюда

~'J'~

[scainet]

Вот так примерно должен выглядет эксель..

P.S.: блоки достаются по названию из библиотеки(папки, где блоки лежат)

[Олег (jr.)]

Сообщение от scainet Вот так примерно должен выглядет эксель.. P.S.: блоки достаются по названию из библиотеки(папки, где блоки лежат)

Обработай напильником до нужной кондиции

Код:

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

Option Explicit

' require reference to 'AutoCAD 2008 Type Library' and also
' go to Tools -> Options -> General -> check 'Break on Unhandled Errors'

Private Declare Function Putfocus Lib "user32" Alias "SetFocus" (ByVal hwnd As Long) As Long

Dim acHwnd As Long
Dim exHwnd As Long

Private Sub CommandButton1_Click()
    Dim dwgname As String
    dwgname = "C:/Test.dwg"    '<-- change drawing name here
    InsertBlocksFromBook (dwgname)
End Sub


Sub InsertBlocksFromBook(dwgname 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(Prompt:="Select range", Title:="Insert Blocks To ACAD", 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.hwnd
    Putfocus acHwnd
    Set acadDocs = acadApp.Documents
    Set acadDoc = acadDocs.Open(dwgname)
    
    acadApp.Visible = True
    acadApp.WindowState = acMax
    acadDoc.Activate
    acadDoc.ActiveSpace = acModelSpace
    
    Set Util = acadDoc.Utility

        MsgBox "***   INSERTING " & num & " BLOCKS TO PICKING POINTS ON SCREEN   ***" & vbCr & _
        "ACTIVATE AutoCAD"
    For i = 0 To UBound(attData)
        num = CInt(attData(i, 0))
  
        blockName = CStr(attData(i, 1))
        For cnt = 0 To num - 1
        
            pt = acadDoc.Utility.GetPoint(, vbCr & "Pick insertion point of block >>")

            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
                End If
            Next n
            blkRef.Update
        Next cnt
    Next i
  
    acadApp.ZoomExtents
    acadDoc.Close True
    Set acadDoc = Nothing
    Set acadDocs = Nothing
    acadApp.Quit
    Set acadApp = Nothing

    Putfocus exHwnd
    
Inserts_Exit:
    If Err.Number <> 0 Then
        MsgBox Err.Description
        Else
        MsgBox "Done"
    End If
    On Error GoTo 0
    Exit Sub

Error_Control:
    Resume Inserts_Exit

End Sub

' http://www.bigresource.com/VB-Can-I-open-an-exe-program-with-Visual-basic-6--AliDZf6X9.html#APPnTjA72l
Function ConnectToAcad() As AcadApplication
    Dim scratchApp As AcadApplication

    On Error Resume Next
    'see if it's already open
    Set scratchApp = GetObject(, "AutoCAD.Application.17")
    If Err Then
        Err.Clear
'        if not open it
        Set scratchApp = CreateObject("AutoCAD.Application.17")
        If Err Then
            Exit Function
        End If
    End If

    Set ConnectToAcad = scratchApp

End Function

ЗЫ Нет времени

~'J'~

[scainet]

Спасибо большое, с кодом немного разобрался... Вот только как сделать, чтобы автокад при запуске открывал новый чертеж, и в этот чертеж вставлялись бы блоки, взятые из папки "BLOCKS". Просто код тут написан так, что открывается тот чертеж, в котором сами блоки присутствуют и берет эти блоки из этого же чертежа..

[Олег (jr.)]

Сообщение от scainet Спасибо большое, с кодом немного разобрался... Вот только как сделать, чтобы автокад при запуске открывал новый чертеж, и в этот чертеж вставлялись бы блоки, взятые из папки "BLOCKS". Просто код тут написан так, что открывается тот чертеж, в котором сами блоки присутствуют и берет эти блоки из этого же чертежа..

Навскидку (сижу на другом компьтере) вроде:

Код:

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

Set acadDoc = acadDocs.Add

~'J'~

[scainet]

А по подробнее можно?

[Олег (jr.)]

Сообщение от scainet А по подробнее можно?

См. Help - там подробно

~'J'~

[scainet]

Вобщем получилось так, новый чертеж добавляется по верх того, с которого берутся блоки, НО блоки не добавляются в новый чертеж...

Да и вот еще ругается че-то на .hwnd, и причем токо в этом месте, выложил скрин

[mini]

для вставки блоков с атрибутами из таблицы *.csv (в столбцах: BLK-NAME X Y Z ATTRIBUTE) обычно использую InsertBlock2.lsp.

[Сергей Дубина]

Я делаю пользовательские функции (см. вложение). Эксель, при открытии, не обновляйте.

[AlexV]

Сообщение от Сергей Дубина Я делаю пользовательские функции (см. вложение). Эксель, при открытии, не обновляйте.

Наверное, без файла "AutoCAD.xla" эти функции работать не будут?

[Сергей Дубина]

Сообщение от AlexV Наверное, без файла "AutoCAD.xla" эти функции работать не будут?

Выкладывать .xla смысла нет т.к. коммандная строка чуствительна к версии автокад, и функции "заточены" под мои задачи, ветвлений диалогов сложных комманд я не предусматривал.