[evgm]

Привет всем.
Подскажите, пожалуйста, возможно ли на VB6 работать с динамическими блоками?
В частности, пока интересует только задание и считывание линейных параметров.
Autocad 2006 En.
Нигде не смог ничего подобного найти...
Заранее спасибо.

[Дима_]

.GetDynamicBlockProperties

[evgm]

А это для какой версии???
Что-то не вижу такого метода для объекта AcadBlockReference в 2006 Autocade...

[evgm]

неужели никак нельзя? может на лиспе можно?
а из VB вызывать lisp-функцию?

[DEM]

БРРР
ну вот кусок кода для чтения атрибутов и параметров динамических...

Код:

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

Public Sub testSpec1()
        If SM_t.Rows.Count = 0 Then SM_t = ReadAndCreateTable(SM_t, "SM")
        If SP_t.Rows.Count = 0 Then SP_t = ReadAndCreateTable(SP_t, "SP")
        If IMH_t.Rows.Count = 0 Then IMH_t = ReadAndCreateTable(IMH_t, "IMH")
        dtDataTable.Clear()
        If dtDataTable.Columns.Count = 0 Then
            dtDataTable.Columns.Add("Naimenovanie", GetType(String))
            dtDataTable.Columns.Add("H_level", GetType(Integer))
            dtDataTable.Columns.Add("Count", GetType(Integer))
            dtDataTable.Columns.Add("DL", GetType(Integer))
            dtDataTable.Columns.Add("KR_count", GetType(Integer))
        End If
        dtDataTable.NewRow()
        Dim acDoc As Document = AuAcApp.Application.DocumentManager.MdiActiveDocument
        Dim acCurDb As Database = acDoc.Database  '' Старт транзакции
        Using acTrans As Transaction = acCurDb.TransactionManager.StartTransaction()    '' Создание массива TypedValue для определение критериев фильтра
            Dim acTypValAr(0) As TypedValue 'Выбираем только Блоки
            acTypValAr.SetValue(New TypedValue(DxfCode.Start, "INSERT"), 0)
            acCurDb.TileMode = True
            Dim acSelFtr As SelectionFilter = New SelectionFilter(acTypValAr) '' Запрос выбора объектов в области чертежа
            Dim acSSPrompt As PromptSelectionResult = acDoc.Editor.GetSelection(acSelFtr)            '' Если статус запроса равен OK, объекты выбраны
            If acSSPrompt.Status = PromptStatus.OK Then
            Else
                Exit Sub
            End If
            Dim acSSet As SelectionSet = acSSPrompt.Value
            N = 0
            For Each acSSObj As SelectedObject In acSSet '' Перебор объектов в наборе
                If Not IsDBNull(acSSObj) Then '' Проверка, нужно убедится в правильности полученного объекта
                    Dim acEnt As Entity = CType(acTrans.GetObject(acSSObj.ObjectId, _
                                                            OpenMode.ForRead), Entity) '' Открытие объекта для чтения
                    If Not IsDBNull(acEnt) Then
                        If TypeOf acEnt Is BlockReference Then
                            Dim acBlock As BlockReference
                            acBlock = CType(acEnt, BlockReference)
                            Dim blName As String = acBlock.Name
                            'Проверяю является ли выделенный блок динамическим
                            If acBlock.IsDynamicBlock = True Then
                                'Получаю настоящие/родное имя динамического блока
                                Dim blr As BlockTableRecord = CType(acTrans.GetObject(acBlock.DynamicBlockTableRecord, OpenMode.ForRead), BlockTableRecord)
                                'Проверяю наличие аттрибутов
                                If blr.HasAttributeDefinitions Then
                                    'Если все условия соблюдены, добавляю блок в коллекцию
                                    Dim blr_nam As BlockTableRecord = CType(acTrans.GetObject(blr.ObjectId, OpenMode.ForRead), BlockTableRecord)
                                    Dim acBlock_nam As String = blr_nam.Name
                                    ' Задается путь и имя файла без раcширения
                                    Dim listblk(5) As String
                                    listblk(0) = ""
                                    listblk(1) = "1"
                                    listblk(2) = "0"
                                    listblk(3) = "0"
                                    listblk(4) = "0"
                                    listblk(5) = "0"

                                    For Each idAtt As ObjectId In acBlock.AttributeCollection
                                        Dim obj As DBObject = acTrans.GetObject(idAtt, OpenMode.ForRead)
                                        If TypeOf obj Is AttributeReference Then
                                            Dim attRef As AttributeReference = CType(obj, AttributeReference)
                                            If InStr(attRef.Tag, "MARK") = 1 Or InStr(attRef.Tag, "НАИМЕНОВАНИЕ") = 1 Then
                                                listblk(0) = attRef.TextString
                                            End If
                                            If attRef.Tag = "COUNT" Then
                                                If attRef.TextString = "" Then listblk(1) = 0 Else listblk(1) = attRef.TextString
                                            End If
                                            If InStr(attRef.Tag, "H") = 1 Or InStr(attRef.Tag, "Н") = 1 Then
                                                If attRef.TextString = "" Then
                                                    MsgBox("Высота этажа не может быть пустым значением" & vbCrLf & "принято H=0")
                                                    listblk(2) = 0
                                                Else
                                                    listblk(2) = attRef.TextString
                                                End If
                                            End If
                                            If attRef.Tag = "N_KR" Then
                                                listblk(4) = attRef.TextString.Replace("шт.", "")
                                            End If

                                        End If
                                    Next
                                    If listblk(0) = "" Then
                                    Else
                                        dtDataTable.Rows.Add()
                                        dtDataTable.Rows(N).Item("Naimenovanie") = listblk(0)
                                        dtDataTable.Rows(N).Item("Count") = CInt(listblk(1))
                                        dtDataTable.Rows(N).Item("H_level") = CInt(listblk(2))
                                        Dim pc As DynamicBlockReferencePropertyCollection = acBlock.DynamicBlockReferencePropertyCollection
                                        For Each prop As DynamicBlockReferenceProperty In acBlock.DynamicBlockReferencePropertyCollection
                                            If prop.PropertyName = "L_raskladki_200" Then
                                                If acBlock_nam = "МС_КС" Then listblk(3) = prop.Value + 100
                                                If acBlock_nam = "СМГ" Then listblk(3) = prop.Value + 450

                                            End If
                                            If prop.PropertyName = "L_raskladki_100" Then
                                                listblk(3) = prop.Value + 400
                                            End If
                                            If prop.PropertyName = "Тип_отверстия" Then
                                                If InStr(prop.Value, "(-1)") = 1 Then listblk(5) = 0
                                                If InStr(prop.Value, "(+1)") = 1 Then listblk(5) = 0
                                                If InStr(prop.Value, "(+2)") = 1 Then listblk(5) = 1
                                                If InStr(prop.Value, "(+3)") = 1 Then listblk(5) = 2
                                            End If
                                        Next
                                        dtDataTable.Rows(N).Item("Count") = CInt(listblk(1)) + CInt(listblk(5))
                                        dtDataTable.Rows(N).Item("DL") = CInt(listblk(3))
                                        dtDataTable.Rows(N).Item("KR_count") = CInt(listblk(4))
                                        N = N + 1
                                    End If
                                End If
                            End If
                        End If
                    End If
                End If
            Next
            '' Сохранение нового объекта в базе данных
            acTrans.Commit()
            '' Очистка транзакции
        End Using
        acCurDb.TileMode = False

[Boxa]

Сообщение от DEM БРРР ну вот кусок кода для чтения атрибутов и параметров динамических...

Автор просил на VB6 (соответственно используя COM), а у тебя VB.NET (NET.API) код. Ты его тестировал на 2006 автокаде?
Если мне не изменяет память, там многие NET методы просто отсутствуют, как иллюстрация в 2006 автокаде для того что бы получить длину полилинии нужно писать:

Код:

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

'Для автокада 2006
Dim length As Double = acPline.GetDistanceAtParameter(acPline.EndParam)
'Для автокада 2012
'Dim length As Double = acPline.length

----- добавлено через ~22 мин. -----

Сообщение от evgm А это для какой версии??? Что-то не вижу такого метода для объекта AcadBlockReference в 2006 Autocade...

А попробовать, вдруг получися. Вот ссылка по теме http://www.caduser.ru/forum/index.ph...D=25&TID=49554

[DEM]

тьфу ты, чтой то про VB6 не прочел...

[evgm]

ничего не получается...

Dim props() As AcadDynamicBlockReferenceProperty
props = acadBlockRef.GetDynamicBlockProperties 'хоть такого метода и нет в подсказке но ошибка не возникает и props заполняется
For k = LBound(props) To UBound(props)
If LCase$(Trim$(props(k).PropertyName)) Like "distance" Then 'при обращении к к свойству никакой ошибки не генерируется но VB вылетает из процедуры
props(k).Value = varAttributes(5).TextString * 1000 'при попытке задать значение - генерируется ошибка metod failed
Exit For
End If
Next k

[maratovich]

vb6...
Dim props() As AcadDynamicBlockReferenceProperty...
С привязкой к версии Автокада ?

Совет - возьмите пример из справки и смотрите как там это реализовано.

[Boxa]

Сообщение от evgm ничего не получается... Код: [Выделить все] Dim props() As AcadDynamicBlockReferenceProperty props = acadBlockRef.GetDynamicBlockProperties 'хоть такого метода и нет в подсказке но ошибка не возникает и props заполняется For k = LBound(props) To UBound(props) If LCase$(Trim$(props(k).PropertyName)) Like "distance" Then 'при обращении к к свойству никакой ошибки не генерируется но VB вылетает из процедуры props(k).Value = varAttributes(5).TextString * 1000 'при попытке задать значение - генерируется ошибка metod failed Exit For End If Next k

Простите, но это ПИПЕЦ!!!! За гранью добра и зла!

Код:

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

Sub temp()
   ' Ïåðåìåííûå àêàäà(âûäåëåíèå)
    Dim ssetObj As AcadSelectionSet 'Ïåðâîíà÷àëüíàÿ âûáîðêà ýëåìåíòîâ
    Dim arm As New Collection 'Êîëëåêöèÿ áëîêîâ àðìàòóðû
'Îáðàáîò÷èê îøèáîê
    On Error Resume Next
'Ñîçäàíèå îáúåêòà âûáîðêè è ñàìà âûáîðêà áëîêîâ
    Set ssetObj = ThisDrawing.SelectionSets("Boxa_arm")
    If Err <> 0 Then
        Err.Clear
        Set ssetObj = ThisDrawing.SelectionSets.Add("Boxa_arm")
    End If
    ssetObj.Clear
    ssetObj.SelectOnScreen
'Îáðàáîò÷èê îøèáîê
    On Error GoTo fuck
   For Each Item In ssetObj
        BlockProperties = Item.GetDynamicBlockProperties
            For Each i In BlockProperties
                If i.PropertyName = "distance" Then
                   i.Value = CDbl(Val(Trim(varAttributes(5).TextString))) * 1000
                   Exit For
                End If
            Next
    Next
fuck:
    If Err <> 0 Then MsgBox "Îøèáî÷êà áûëà"
    'Çàâåðøåíèå ïðîãðàììû è çàêðûòèå âñåõ îáúåêòîâ.
    ssetObj.Clear
    ssetObj.Delete
End Sub

[evgm]

спасибо огромное - все получилось!!!