[Дима_]

Всем здравствуйте. Есть "логический" аналог вот такого кода:

Код:

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

(mapcar '(lambda (atr)
           (cons (vla-get-tagstring atr) 
                 (vla-get-textstring atr)))
        (vlax-safearray->list
         (vlax-variant-value 
          (vla-getattributes
           (vlax-ename->vla-object (entlast))))))

- читающий атрибуты и их значения - в автокаде он работает прекрасно, но беда в том, что мне нужно запустить аналогичный код "снаружи" и судя по всему, между каждым обращением к объектной модели идет приличная трата времени, а "все разом" их не прочеть. Соответственно вопрос - можно-ли прочитать все атрибуты за одно обращение, либо есть ли ,например, у acad.application некий метод "сосредоточения ресурсов" на внешние запросы (ну типа свернуть его и после "опроса" развернуть, или какой-нибудь метод, после которого, он на обращения "снаружи" повнимательней смотрит и т.д.).

[Кулик Алексей aka kpblc]

VBA, по-быстрому и коряво. Улучшай сам

Код:

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

Option Explicit

Type TypeAttr
  sTag As String
  sValue As String
End Type

Public Function GetBlockAttrByBlockName(BlockName As String) As TypeAttr()
Dim oAcadApp As AcadApplication
Dim oAcadDoc As AcadDocument
  Set oAcadApp = GetObject(, "AutoCAD.Application")
  Set oAcadDoc = oAcadApp.ActiveDocument  'oAcadApp.ActiveDocument
Dim Res() As TypeAttr, objAttr As AcadAttributeReference
Dim objCounter As AcadEntity, objBlockRef As AcadBlockReference
Dim iCounter As Integer
  For Each objCounter In oAcadDoc.ModelSpace
    If (UCase(objCounter.ObjectName) Like "*BLOCK*") Then
      Set objBlockRef = objCounter
      If UCase(objBlockRef.EffectiveName) Like UCase(BlockName) Or UCase(objBlockRef.Name) Like UCase(BlockName) Then
        For iCounter = LBound(objBlockRef.GetAttributes) To UBound(objBlockRef.GetAttributes)
          On Error GoTo lErrorReDim
          ReDim Res(UBound(Res) + 1)
          Res(UBound(Res)).sTag = objBlockRef.GetAttributes(iCounter).TagString
          Res(UBound(Res)).sValue = objBlockRef.GetAttributes(iCounter).TextString
          On Error GoTo 0
        Next
      End If
    End If
  Next
  GetBlockAttrByBlockName = Res
  Exit Function
lErrorReDim:
  ReDim Res(0)
  Resume Next
End Function

Public Sub test()
  GetBlockAttrByBlockName "qwer"
End Sub

[Дима_]

Алексей - большая просьба (я VB толком не знал, да еще и забыл), ИХМО здесь все то-же самое:

Код:

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

Res(UBound(Res)).sTag = objBlockRef.GetAttributes(iCounter).TagString
Res(UBound(Res)).sValue = objBlockRef.GetAttributes(iCounter).TextString

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

[Лиспер]

Прогнал так:

Код:

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

Option Explicit
 
Type TypeAttr
  sTag As String
  sValue As String
End Type
 
Public Function GetBlockAttrByBlockName_EarlyBind(BlockName As String) As TypeAttr()
Dim oAcadApp As AcadApplication
Dim oAcadDoc As AcadDocument
  Set oAcadApp = GetObject(, "AutoCAD.Application")
  Set oAcadDoc = oAcadApp.ActiveDocument  'oAcadApp.ActiveDocument
Dim Res() As TypeAttr, objAttr As AcadAttributeReference
Dim objCounter As AcadEntity, objBlockRef As AcadBlockReference
Dim iCounter As Integer
  For Each objCounter In oAcadDoc.ModelSpace
    If (UCase(objCounter.ObjectName) Like "*BLOCK*") Then
      Set objBlockRef = objCounter
      If UCase(objBlockRef.EffectiveName) Like UCase(BlockName) Or UCase(objBlockRef.Name) Like UCase(BlockName) Then
        For iCounter = LBound(objBlockRef.GetAttributes) To UBound(objBlockRef.GetAttributes)
          On Error GoTo lErrorReDim
          ReDim Res(UBound(Res) + 1)
          Res(UBound(Res)).sTag = objBlockRef.GetAttributes(iCounter).TagString
          Res(UBound(Res)).sValue = objBlockRef.GetAttributes(iCounter).TextString
          On Error GoTo 0
        Next
      End If
    End If
  Next
  GetBlockAttrByBlockName_EarlyBind = Res
  Exit Function
lErrorReDim:
  ReDim Res(0)
  Resume Next
End Function
 
Public Function GetBlockAttrByBlockName_LateBind(BlockName As String) As TypeAttr()
Dim oAcadApp As Object
Dim oAcadDoc As Object
  Set oAcadApp = GetObject(, "AutoCAD.Application")
  Set oAcadDoc = oAcadApp.ActiveDocument  'oAcadApp.ActiveDocument
Dim Res() As TypeAttr, objAttr As Object
Dim objCounter As Object, objBlockRef As Object
Dim iCounter As Integer
  For Each objCounter In oAcadDoc.ModelSpace
    If (UCase(objCounter.ObjectName) Like "*BLOCK*") Then
      Set objBlockRef = objCounter
      If UCase(objBlockRef.EffectiveName) Like UCase(BlockName) Or UCase(objBlockRef.Name) Like UCase(BlockName) Then
        For iCounter = LBound(objBlockRef.GetAttributes) To UBound(objBlockRef.GetAttributes)
          On Error GoTo lErrorReDim
          ReDim Res(UBound(Res) + 1)
          Res(UBound(Res)).sTag = objBlockRef.GetAttributes(iCounter).TagString
          Res(UBound(Res)).sValue = objBlockRef.GetAttributes(iCounter).TextString
          On Error GoTo 0
        Next
      End If
    End If
  Next
  GetBlockAttrByBlockName_LateBind = Res
  Exit Function
lErrorReDim:
  ReDim Res(0)
  Resume Next
End Function
 
Public Sub test()
Dim vStartTime As Date, vEndTime As Date, EarlyBind As Date, LateBind As Date
  vStartTime = Time()
  GetBlockAttrByBlockName_EarlyBind "qwer"
  vEndTime = Time()
  EarlyBind = vEndTime - vStartTime
  vStartTime = Time()
  GetBlockAttrByBlockName_LateBind "qwer"
  vEndTime = Time()
  LateBind = vEndTime - vStartTime
  MsgBox "Real time : " + Chr(10) + Chr(13) + _
        "(early binding): " + CStr(EarlyBind) + Chr(10) + Chr(13) + _
        "(late binding) : " + CStr(LateBind), _
        , vbOKOnly + vbInformation + vbApplicationModal
End Sub

Результаты видны сразу. У меня на Excel 2007 + AutoCAD 2008 - не больше секунды.
Одна функция - для случая раннего связывания, вторая - для позднего (без импорта соответствующих библиотек)

[Дима_]

Вобщем как ни крутил - tagstring и textstring "снаружи", если несколько аттрибутов, обрабатываются долго (в 2010 по крайней мере), а у тех-же аттрибутов handle, например, - моментально. Пришлось DCL (динамический) "прикрутить", уж больно com, в этом случае, не удобно регестрировать (изначально хотел внешним exe ограничиться который к acad'у обращается).

[Лиспер]

Дима_, у тебя явно что-то не то с алгоритмом. Посмотри - я в GetBlockAttrByBlockName_LateBind указатель и на приложение, и на документ создаю всего один раз. Попробуй делать это снаружи, и передавать в качестве параметров в свою функцию (например, ByRef).
Мне как-то слабо верится, что подобное сделать невозможно...

[Дима_]

Я же говорю - что, например, handle тех-же аттрибутов "достается" мгновенно - алгоритм - полный аналог лиспа в 1 посте - то есть все "предобьекты" создаются один раз.

[Лиспер]

Тогда я пас

[Дима_]

Я тоже (см. пост № 5).