[AlexV]

Примитивно имеем объект.. Например, так:

Код:

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

Sub main()
Dim objBlk As AcadEntity
Dim varPoint As Variant
Dim strPrompt As String, tempstr As String, obj As Object
On Error Resume Next
strPrompt = "Выбери объект"
ThisDrawing.Utility.GetEntity obj, varPoint, strPrompt
Stop
End Sub

Можно ли как-то "изнутри него" определить имя листа, в котором он создан?

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

Попробуй посмотреть свойство OwnerID и потом преобразовывай его в указатель на пространство (насколько я помню, ObjectIDToObject - но там были возможны варианты: в некоторых версиях требовалось ObjectIDToObject, в некоторых - ObjectIDToObject32).

----- добавлено через ~11 мин. -----
P.S. VBA у меня сходит с ума при попытке выбора объекта, так что

Код:

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

Sub main()
Dim objBlk As AcadEntity
Dim varPoint As Variant
Dim strPrompt As String, tempstr As String, obj As Object
'On Error Resume Next
'strPrompt = "Âûáåðè îáúåêò"
'ThisDrawing.Utility.GetEntity obj, varPoint, strPrompt
'Stop
Dim oEnt As AcadEntity
  Set oEnt = ThisDrawing.ModelSpace.Item(0)
Dim ownID As Long
  ownID = oEnt.OwnerID32
Dim oOwner As AcadBlock
  Set oOwner = ThisDrawing.ObjectIdToObject32(ownID)
  MsgBox oOwner.Name
End Sub

----- добавлено через ~12 мин. -----
Обрати внимание - в 2013 используются OwnerID32 и ObjectIdToObject32. В других версиях может быть по-другому (а сделать универсальные коды в VBA, по-моему, не получится).

[AlexV]

Сообщение от Кулик Алексей aka kpblc Попробуй посмотреть свойство OwnerID и потом преобразовывай его в указатель на пространство (насколько я помню, ObjectIDToObject - но там были возможны варианты: в некоторых версиях требовалось ObjectIDToObject, в некоторых - ObjectIDToObject32). ----- добавлено через ~11 мин. ----- P.S. VBA у меня сходит с ума при попытке выбора объекта, так что Код: [Выделить все] Sub main() Dim objBlk As AcadEntity Dim varPoint As Variant Dim strPrompt As String, tempstr As String, obj As Object 'On Error Resume Next 'strPrompt = "Âûáåðè îáúåêò" 'ThisDrawing.Utility.GetEntity obj, varPoint, strPrompt 'Stop Dim oEnt As AcadEntity Set oEnt = ThisDrawing.ModelSpace.Item(0) Dim ownID As Long ownID = oEnt.OwnerID32 Dim oOwner As AcadBlock Set oOwner = ThisDrawing.ObjectIdToObject32(ownID) MsgBox oOwner.Name End Sub ----- добавлено через ~12 мин. ----- Обрати внимание - в 2013 используются OwnerID32 и ObjectIdToObject32. В других версиях может быть по-другому (а сделать универсальные коды в VBA, по-моему, не получится).

Да, в 2016 без "32".. И тип переменной стал ownID "дважды длинный".. LongLong. В Автокаде - все работает.
..А вот при попытке из Экселя этот финт ушами провернуть - эксель вылетает. Может, потому, что конфликт идет между типами (в excel вроде нету LongLong?).

[Сергей812]

Сообщение от AlexV в excel вроде нету LongLong?

есть

----- добавлено через ~57 мин. -----
Все же элементарно делается из экселя

Код:

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

Dim lParentObj As AcadObject
Set lParentObj = lDoc.ObjectIdToObject32(lSelAcadObj.OwnerID32)
'Set lParentObj = lDoc.ObjectIdToObject(lSelAcadObj.OwnerID)
Dim lLayout As AcadLayout
Set lLayout = lParentObj.Layout
Dim lNameLayout As String
lNameLayout = lLayout.Name

[AlexV]

Сообщение от Сергей812 есть ----- добавлено через ~57 мин. ----- Все же элементарно делается из экселя Код: [Выделить все] Dim lParentObj As AcadObject Set lParentObj = lDoc.ObjectIdToObject32(lSelAcadObj.OwnerID32) 'Set lParentObj = lDoc.ObjectIdToObject(lSelAcadObj.OwnerID) Dim lLayout As AcadLayout Set lLayout = lParentObj.Layout Dim lNameLayout As String lNameLayout = lLayout.Name

При попытке извлечь lSelAcadObj.OwnerID Excel умирает..

[trir]

При попытке извлечь lSelAcadObj.OwnerID Excel умирает..

правильно, а зачем вы это делаете? эта строчка не просто так закоментирована

[AlexV]

Сообщение от trir правильно, а зачем вы это делаете? эта строчка не просто так закоментирована

Ну, делаю я это для того, что бы получить то, что обозначено в названии темы..

А строчка закомментирована не просто как?

[Сергей812]

Пост 2 от Алексея читаем) Там просто два варианта привел сразу - а какой из них работает, проверяйте на своей связке Excel-Акад

[AlexV]

Сообщение от Сергей812 Пост 2 от Алексея читаем) Там просто два варианта привел сразу - а какой из них работает, проверяйте на своей связке Excel-Акад

Да я понял, что для разных вариантов акада.. Но, повторюсь, при использование lSelAcadObj.OwnerID в связке эксель - А2016 эксель мрёт..

[trir]

так надо использовать lSelAcadObj.OwnerID32 и желательно, чтобы разряднось Excel'я совпадала с разрядносьтью Акада

[AlexV]

Сообщение от trir так надо использовать lSelAcadObj.OwnerID32 и желательно, чтобы разряднось Excel'я совпадала с разрядносьтью Акада

OwnerID32 в А2016 отсутствует в списке свойств..

[trir]

Excel какой?

[Сергей812]

а ObjectIDToObject и ObjectIDToObject32 присутствуют? Если да - пробуйте с ними OwnerID по очереди. Заодно посмотрите в отладчике перед вызовом этих функций - есть ли вообще что-то удобоваримое в этом OwnerID. Ну и контрольный вопрос - все обновления установлены?

[AlexV]

Сообщение от trir Excel какой?

Excel 2016. Да, наверное, здесь и зарылась собака, как я и предположил в #3 - конфликт между типами данных в 64b версии.

по ссылке из #12:

Таким образом, для кода для работы в 64-разрядных версий Office необходимо найти и изменить все существующие инструкции Declare для использования спецификатора PtrSafe . И необходимо найти и изменить все типы данных в пределах эти инструкции Declare , дескрипторы ссылку или указатели на использование совместимого 64-разрядная версия LongPtr введите псевдоним и типы, которые необходимы для хранения целых чисел 64-разрядная версия с новой LongLong Тип данных. Кроме того необходимо обновить любые пользовательские типы, которые содержат указатели или значками и 64-разрядных целых чисел используйте типы данных 64-разрядная версия и проверить все назначения переменной, верны для предотвращения ошибок Несоответствие типа.

..хотя я пытался объявлять переменную as LongPtr, и в нее запихивать lSelAcadObj.OwnerID, все равно вылетало..

Кстати сказать, при работе Excel2016 с A2012 и использовании lSelAcadObj.OwnerID32 - тоже вылет экселя..


...А, блин, эксель у меня 32 битный, вот он и не может скушать автокадовский указатель на тип LongLong.. И как его можно экселю скормить?

[Сергей812]

Ну с VBA (правда самого акадовского) я очень быстро свалил в сторону Interop на VB.NET из-за каких то постоянных ограничений и спонтанных ошибок. Синтаксис по сути один и тот же с VBA - надо только уговорить админа поставить бесплатную студию какую-нибудь с поддержкой VB.NET. Ну или в тот же .Net уходить сразу, не приходя в сознание)

[doctorraz]

Сообщение от AlexV Можно ли как-то "изнутри него" определить имя листа, в котором он создан?

так?

Код:

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

Sub obId()
Dim returnObj As AcadObject
    ThisDrawing.Utility.GetEntity returnObj, Null, "Выберите объект"
    NameVkladkiObiekta = ThisDrawing.ObjectIdToObject(returnObj.OwnerID).Layout.Name
    MsgBox "Объект принадлежит " & NameVkladkiObiekta
End Sub

Спасибо Маратовичу

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

Сообщение от doctorraz ObjectIdToObject

Проблема именно тут. Может быть ObjectIdToObject, а может быть и ObjectIdToObject32. И что оно потребует - тайна

[AlexV]

Сообщение от doctorraz так? Код: [Выделить все] Sub obId() Dim returnObj As AcadObject ThisDrawing.Utility.GetEntity returnObj, Null, "Выберите объект" NameVkladkiObiekta = ThisDrawing.ObjectIdToObject(returnObj.OwnerID).Layout.Name MsgBox "Объект принадлежит " & NameVkladkiObiekta End Sub Спасибо Маратовичу

Да все так, проблема в том, что мне надо автокадовское (A2016 64b) свойство OwnerID, коее имеет тип данных LongLong, выцепить через vba excel, который у меня 32-битный и тип LongLong не поддерживает, вследствие чего умирает при попытке прочитать returnObj.OwnerID..

[doctorraz]

vb6 же х-32??
если объект получен GetEntity, то OwnerID ошибка, OwnerID32 то же
а если SelectOnScreen , все работает..

Код:

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

        objSelSet.SelectOnScreen
       Set ff = objSelSet.Item(0)
       ff = ff.OwnerID

[Boxa]

нда... лучше бы VBA сдох быстро и достойно, чем такие мучения. =о)
Office 2016 + acad 2017 - дохнет сразу из-за типов данных.
Видимо тут придется из автокада подключаться к excel и читать данные.

[doctorraz]

пробуй так

Код:

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

Dim ThisDrawing
Sub testId()
'Dim returnObj As AcadObject
Set objAutoCAD = GetObject(, "AutoCAD.Application")
Set ThisDrawing = objAutoCAD.ActiveDocument
ThisDrawing.Activate 'активируем док из которого запущена печать
AppActivate objAutoCAD.Caption 'передаем фокус окну AutoCAD
Set objSelSet = vbdPowerSet("SPDSFORMAT")
objSelSet.SelectOnScreen 'arr_intType, arr_varDat
Set returnObj = objSelSet.Item(0)
NameVkladkiObiekta = ThisDrawing.ObjectIdToObject(returnObj.OwnerID).Layout.Name
NameVkladkiObiekta = ThisDrawing.ObjectIdToObject(returnObj.OwnerID).Layout.Name
Stop
rr = returnObj.OwnerID
Stop
MsgBox "Объект принадлежит " & NameVkladkiObiekta
End Sub
Public Function vbdPowerSet(strName As String) As Object 'AcadSelectionSet
'<EhHeader>

'</EhHeader>
Dim objSelSet As Object ' AcadSelectionSet
Dim objSelCol As Object ' AcadSelectionSets
100     Set objSelCol = ThisDrawing.SelectionSets
110     For Each objSelSet In objSelCol
120         If objSelSet.Name = strName Then
130             objSelSet.Delete
                Exit For
            End If
        Next
140     Set objSelSet = ThisDrawing.SelectionSets.Add(strName)
150     Set vbdPowerSet = objSelSet

End Function

[AlexV]

Сообщение от doctorraz vb6 же х-32?? если объект получен GetEntity, то OwnerID ошибка, OwnerID32 то же а если SelectOnScreen , все работает.. Код: [Выделить все] objSelSet.SelectOnScreen Set ff = objSelSet.Item(0) ff = ff.OwnerID

VB6 - 32b. Коий в офисе 2016. А вот Автокад 2016 - там уже vb7 и 64b.

Сообщение от Boxa нда... лучше бы VBA сдох быстро и достойно, чем такие мучения. =о) Office 2016 + acad 2017 - дохнет сразу из-за типов данных. Видимо тут придется из автокада подключаться к excel и читать данные.

Так vba фактически и сдох, просто потом его чуть-чуть реанимировали.. Он ожил и чутка задвигался, но пока в инвалидной коляске

Да из автокада - не проблема, в принципе, и без excel обойтись. Тут просто задумка была - коллегам помочь одной утилиткой, ввиду того, что далеко не только лишь все имеют vba enabler, как и желание узнать, что это такое. А эксель - у всех есть, и vba в офисе встроенный.. На самом деле, можно кончено обойтись и без фильтра, перебором листов и таблиц, просто через эксель это прилично дольше получается.

[Boxa]

AlexV, так может вообще без VBA обойтись и написать утилитку на нормальном языке... Вы бы сформулировали в чем смысл задачи, нашлись бы варианты

[doctorraz]

AlexV ты все же попробуй этот код

[AlexV]

Сообщение от doctorraz пробуй так

Да не, не прокатит, - как ни получай returnObj, в любом случае returnObj.OwnerID в объектной модели автокад 64b будет иметь тип LongLong, и при попытке его съесть / положить в привычный тип Long Excel 32b давится..

Сообщение от Boxa AlexV, так может вообще без VBA обойтись и написать утилитку на нормальном языке... Вы бы сформулировали в чем смысл задачи, нашлись бы варианты

Да задачка простейшая - прошерстить все открытые в текущем сеансе файлы автокада, найти и отфильтровать все необходимые объекты ACAD_TABLE с определенными значениями определенных параметров, считать в массив значения определенных ячеек, отсортировать и вывалить результат на лист в файле excel. В дальнейшем возможно - добавить к выборке ACAD_TABLE еще и таблицы СПДС CS. В еще более дальнейшем - реализовать обратную задачу - пакетное заполнение и форматирование таблиц в Автокаде на основе шаблона в Excel.

В принципе, почти все это я "на коленке" уже сделал на Autocad vba, хотелось просто перенести на excel.

..а "другими языками" не владею, увы..

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

Сообщение от doctorraz AlexV ты все же попробуй этот код

..О, и правда.. а в чем тут прикол? Почто при SelectOnScreen OwnerID нормально обрабатывается?

А, дело, пожалуй, не в SelectOnScreen.. С Select тоже получилось.. То ли дело в типе переменной returnObj из кода в #21 (я ее пытался то как AcadTable, то как AcadEntity, то как AcadObject, а у doctorraz тип не задается.. Хотя как variant я вроде тож пытался.. Или, может, то что я этот returnObj параметром в другую функцию передавал, а тут все внутри "главной" процедуры..

[doctorraz]

Сообщение от AlexV А, дело, пожалуй, не в SelectOnScreen

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

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

Сообщение от AlexV То ли дело в типе переменной returnObj из кода

думае все дело в способе ее получения, на 64х разницы нет на 32х есть.... не знаю почему

[AlexV]

Сообщение от doctorraz дело в селектионсет автокад под твою задачу самое то.. одним селектом со всего документа собираешь все нужные таблицы, можно еще задать кучу фильтров и условий для селекта, потом спокойно в цикле тянешь из них данные.. аналогично таблицы спдс, только по ссылке передаешь их в мссом и тоже шерстишь средствами спдс.. ну и общий цикл по всем документам... только не забывай, что селсет принадлежит документу.. дл каждого свой... ----- добавлено через ~2 мин. ----- думае все дело в способе ее получения, на 64х разницы нет на 32х есть.... не знаю почему

Ну так да, я и пытаюсь селект использовать. Дело оказалось в типе переменной, с которой снимается OwnerID - эксель согласен только на variant, в других случаях вылетает..

Код:

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

Sub main()
'***
Dim returnObj As AcadTable
On Error Resume Next
Set objApp = GetObject(, "AutoCAD.Application") '
        If Err Then
        Err.Clear
        Set objApp = CreateObject("AutoCAD.Application")
    End If
Set objDoc = objApp.ActiveDocument
Set objSelectionSet = SelectTable(10)
On Error GoTo 0
If objSelectionSet.Count > 0 Then
    For i = 0 To objSelectionSet.Count - 1 
        Set returnObj = objSelectionSet.Item(i)
        MsgBox returnObj.OwnerID   
    Next i
End If
End Sub

[maratovich]

Развели демагогию... String он.

[AlexV]

Сообщение от maratovich Развели демагогию... String он.

Кто он?

[maratovich]

Сообщение от AlexV Кто он?

То что суёте в ThisDrawing.ObjectIdToObject()

[doctorraz]

Сообщение от AlexV Set objSelectionSet = SelectTable(10)

что это?

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

Код:

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

Public ThisDrawing As Object
Sub method_not_implemented_under_this_platform()
Dim intType(0) As Integer '(2)
Dim varDat(0)  As Variant
Dim objSelSet  As Object
Dim objNanoCAD As Object
'<Сбор таблиц селсетом
    Set spds = CreateObject("McCOM2.Server")
On Error Resume Next
    Set objNanoCAD = GetObject(, "AutoCAD.Application")
    If Err.Number <> 0 Then
        Err.Number = 0
        Debug.Print Err.Number
        Set objNanoCAD = GetObject(, "NanoCAD.Application")
        If Err.Number <> 0 Then
            MsgBox "Не запущен CAD" 
            Exit Sub
        End If
    End If
On Error GoTo 0
    Set ThisDrawing = objNanoCAD.ActiveDocument
    intType(0) = 0
    varDat(0) = "spdstable2" 'таблицы СПДС от 8,0 и младше, за СПДС 11, 12 не скажу _
    старые версии СПДС, старше 8,0 "spdstable" 
    Set objSelSet = vbdPowerSet("seTEST")
    objSelSet.Select 5, , , intType, varDat
    Debug.Print "spdstable-" & objSelSet.Count
Dim objAK As Object
Dim ObjMC As Object
    For Each objAK In objSelSet
        Set ObjMC = spds.Object(objAK) 'имеем полный доступ к свойствам СПДС в АК но в нане "method not implemented under this platform" 
        namee = ObjMC("Name")
    'или
        nameeee = ObjMC!Name
        Debug.Print "Имя таблицы-" & namee
    'работаем с ним дальше
    Next
End Sub
Public Function vbdPowerSet(strName As String) As Object 'AcadSelectionSet
Dim objSelSet As Object ' AcadSelectionSet
Dim objSelCol As Object ' AcadSelectionSets
    Set objSelCol = ThisDrawing.SelectionSets
    For Each objSelSet In objSelCol
        If objSelSet.Name = strName Then
            objSelSet.Delete
            Exit For
        End If
    Next
    Set objSelSet = ThisDrawing.SelectionSets.Add(strName)
    Set vbdPowerSet = objSelSet
End Function

в нанокад этот код не работает, в автокад на ура

[AlexV]

Сообщение от maratovich То что суёте в ThisDrawing.ObjectIdToObject()

Ну, не знаю, справка вроде говорит, что не стринг..

ObjectIDToObject Method (ActiveX) Gets the object that corresponds to the given object ID. Supported platforms: Windows only Signature VBA: RetVal = object.ObjectIDToObject(ID)object Type: Database, Document The objects this method applies to. ID Access: Input-only Type: Long_PTR The object ID of the object to return.

Сообщение от doctorraz что это?

Это секретная функция , которая возвращает Select с фильтром..

Private Function SelectTable(y) As AcadSelectionSet
***
objSelSet.Select acSelectionSetAll, , , groupCode, dataCode
Set SelectTable = objSelSet
End Function

[Сергей812]

В общем, позднее связывание рулит - на виртуалке потестил A2016х64 + E2016х32:

Код:

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

Public Sub TestA2016_64_Excel32()
  Dim lAcadApp As Object
  Set lAcadApp = GetObject(, "AutoCAD.Application")
  Dim lActiveDoc As Object
  Set lActiveDoc = lAcadApp.ActiveDocument
  Dim lSelObj As Object
  Dim lBasePoint As Variant
  lActiveDoc.Utility.GetEntity lSelObj, lBasePoint, "Выберите объект:"
  Dim lParentObj As Object
  Set lParentObj = lActiveDoc.ObjectIdToObject(lSelObj.OwnerID)
  Dim lNameLayout As String
  lNameLayout = lParentObj.Layout.Name
  MsgBox lNameLayout
  Set lParentObj = Nothing
  Set lActiveDoc = Nothing
  Set lAcadApp = Nothing
End Sub