Schöck
| Правила | Регистрация | Пользователи | Поиск | Сообщения за день | Все разделы прочитаны |  Справка по форуму | Файлообменник |

Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > VBA Autocad 2019 Events Ошибка в событии зависает (возможно рекурсия)

VBA Autocad 2019 Events Ошибка в событии зависает (возможно рекурсия)

Ответ
Поиск в этой теме
Непрочитано 19.02.2021, 11:44 #1
VBA Autocad 2019 Events Ошибка в событии зависает (возможно рекурсия)
Vadim_EC
 
Регистрация: 08.02.2018
Сообщений: 11

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

Код основного модуля:

Код:
[Выделить все]
 Option Explicit
Public oDicIDObjToDelete As New Scripting.Dictionary ' словарь контейнер
Public oDicObjOfEvents As New Scripting.Dictionary 'словарь с событиями
Public LayerOfSupport$
Public arrFilterData()
Public arrFilterType(2) As Integer
Public dDist#
Public bCheckMain As Boolean

'Dim X As New EventClass
Sub main()
    bCheckMain = False
    LayerOfSupport = "0"
    dDist = 0.5
    arrFilterType(0) = 0
    arrFilterType(1) = 8
    arrFilterType(2) = 67
    arrFilterData = Array("LWPOLYLINE", "__Слой_Не_Печатается_1", 0)
    oDicIDObjToDelete.RemoveAll
    oDicObjOfEvents.RemoveAll
    Call InitializeEvents
End Sub
Sub InitializeEvents()
    Dim oSelSet As AcadSelectionSet
    Dim oPLine As AcadLWPolyline
    'Dim dDist As Double
    Dim arrPLinesID
    

    Set oSelSet = pf_SelectionSet_CreateInThisDrawing(False, "Temp", 1)
    Set oSelSet = pf_SelectionSet_MultiSelect(oSelSet, True, arrFilterType, arrFilterData)
    ReDim arrPLinesID(1)
    For Each oPLine In oSelSet

        Call f_ClassObjectNew(oPLine)
        'arrPLinesID = pf_LWPolyLine2Offset(oPLine, dDist, LayerOfSupport) временно убрал функцию но все равно зависает
        'Call oDicIDObjToDelete.Add(CStr(oPLine.ObjectID), arrPLinesID) временно убрал функцию но все равно зависает
    Next
    oSelSet.Delete
End Sub


Sub f_ClassObjectNew(oPLine As AcadLWPolyline)
    Dim oEvent As New EventsClass
    Dim arrID
    Set oEvent.Object = oPLine
    Call oDicObjOfEvents.Add(CStr(oPLine.ObjectID), oEvent)
End Sub

Код класса события:


Option Explicit
Public WithEvents Object As AcadLWPolyline

Код:
[Выделить все]
 Private Sub Object_Modified(ByVal pObject As IAcadObject) ' IAcadObject)
    Dim oPLineToDelete As AcadLWPolyline
    Dim arrPLinesID, arrPLinesIDTemp
    Dim arrIDToDelete
    Dim sLayerName$
    Dim sID$
    Dim oPLineTemp1 As AcadLWPolyline, oPLineTemp2 As AcadLWPolyline
    Dim retObj As Variant
    Dim arrIdNewLines(1)
    
    If bCheckMain And Not pObject.Layer = "__Слой_Не_Печатается_1" Then GoTo good
    bCheckMain = True
    On Error Resume Next
    Set oPLineTemp1 = pObject.Copy 'копирую объект события
    sID = CStr(pObject.ObjectID) ' ID для получения объектов к удалению
    arrIDToDelete = oDicIDObjToDelete(sID) ' получаю id объектов к удалению
    Set oPLineToDelete = ThisDrawing.ObjectIdToObject(arrIDToDelete(0))
    oPLineToDelete.Delete
    Set oPLineToDelete = ThisDrawing.ObjectIdToObject(arrIDToDelete(1))
    oPLineToDelete.Delete
    oPLineTemp1.Layer = LayerOfSupport


    retObj = oPLineTemp1.Offset(dDist)
    Set oPLineTemp2 = retObj(0)
    arrIdNewLines(0) = oPLineTemp2.ObjectID
    retObj = oPLineTemp1.Offset(-dDist)

    Set oPLineTemp2 = retObj(0)
    arrIdNewLines(1) = oPLineTemp2.ObjectID
    oDicIDObjToDelete(sID) = arrIdNewLines
    oPLineTemp1.Delete
    'Debug.Print pObject.ObjectID
    
        
    
    On Error GoTo 0

good:

bCheckMain = False

End Sub
Просмотров: 1142
 
Непрочитано 19.02.2021, 11:56
#2
Сергей812


 
Регистрация: 10.08.2013
Сообщений: 9,227


в среде разработки VBA есть пошаговая отладка - по F8 проходите по коду построчно и смотрите - не "прыгнет" ли снова исполнение на начало метода.
Сергей812 вне форума  
 
Автор темы   Непрочитано 19.02.2021, 12:04
#3
Vadim_EC


 
Регистрация: 08.02.2018
Сообщений: 11


Побывал, но весь код проходит нормально, потом пишет в Акаде что "Невозможно выполнить макрос, т.к. AutocCAD занят." Но если просто запустить F5 тогда зависает.

----- добавлено через ~16 мин. -----
Сделал более простую процедуру для теста все операции с pObject исключил и да работает. Может кто знает есть ли возможность временно отключить исполнения события?

Код:
[Выделить все]
Private Sub Object_Modified(ByVal pObject As IAcadObject) ' IAcadObject)
    Dim oPLineToDelete As AcadLWPolyline
    Dim arrPLinesID, arrPLinesIDTemp
    Dim arrIDToDelete
    Dim sLayerName$
    Dim sID$
    Dim oPLineTemp1 As AcadLWPolyline, oPLineTemp2 As AcadLWPolyline
    Dim retObj As Variant
    Dim arrIdNewLines(1)
    
    If bCheckMain And Not pObject.Layer = "__Слой_Не_Печатается_1" Then GoTo good
    bCheckMain = True
    On Error Resume Next
    MsgBox "Done"
    
    On Error GoTo 0

good:

bCheckMain = False
End Sub
Vadim_EC вне форума  
 
Непрочитано 19.02.2021, 13:08
#4
Сергей812


 
Регистрация: 10.08.2013
Сообщений: 9,227


а это вообще плохая идея - внутри события модификации БД модифицировать БД) Собираете в обработчике информацию об объектах, что надо изменить и где-то сохраняете в коллекции. А потом в событие idle (простоя) обрабатываете коллекцию. При этом можно тот же флаг использовать, чтобы снова не сохраняло в коллекцию. Либо просто на время отписать обработчик события.
Сергей812 вне форума  
 
Автор темы   Непрочитано 19.02.2021, 14:17
#5
Vadim_EC


 
Регистрация: 08.02.2018
Сообщений: 11


Цитата:
Сообщение от Сергей812 Посмотреть сообщение
а это вообще плохая идея - внутри события модификации БД модифицировать БД)
согласен так себе решение, был глуп и безумен.

Идею вашу понял. Осталось понять как это реализовать.

ПС Может кто подскажет где найти рабочую прогу для нахождения режима простоя idle для VBA?
Vadim_EC вне форума  
 
Непрочитано 19.02.2021, 14:49
1 | #6
Сергей812


 
Регистрация: 10.08.2013
Сообщений: 9,227


Цитата:
Сообщение от Vadim_EC Посмотреть сообщение
где найти рабочую прогу для нахождения режима простоя idle для VBA?
это такой же обработчик события уровня приложения (application), только не факт - что он "вытащен" в VBA. В хэлпе официальном его не вижу, во всяком случае.
Сергей812 вне форума  
 
Автор темы   Непрочитано 19.02.2021, 15:48
#7
Vadim_EC


 
Регистрация: 08.02.2018
Сообщений: 11


Нашел решение: вместо копирования объекта с событием беру его координаты и создаю новую линию. После этого создаю линии offset от данной линии. И все оки-доки.
Вообщем полилиния "превратилась" почти в мультилинию))

Код:
[Выделить все]
Private Sub Object_Modified(ByVal pObject As IAcadObject) ' IAcadObject)
    Dim oPLineToDelete As AcadLWPolyline
    Dim arrPLinesID, arrPLinesIDTemp
    Dim arrIDToDelete
    Dim sLayerName$
    Dim sID$
    Dim oPLineTemp1 As AcadLWPolyline, oPLineTemp2 As AcadLWPolyline
    Dim retObj As Variant
    Dim arrIdNewLines(1), arrCoordinates

    If bCheckMain And Not pObject.Layer = "__Слой_Не_Печатается_1" Then GoTo good
    bCheckMain = True
    On Error Resume Next
    'Set oPLineTemp1 = pObject.Copy 'копирую объект события
    sID = CStr(pObject.ObjectID) ' ID для получения объектов к удалению
    arrCoordinates = pObject.Coordinates ' получаю координаты объекта что бы создать новую поли линию не привязанный к событию
    arrIDToDelete = oDicIDObjToDelete(sID) ' получаю id объектов к удалению
    Set oPLineTemp1 = ThisDrawing.ModelSpace.AddLightWeightPolyline(arrCoordinates)
    Set oPLineToDelete = ThisDrawing.ObjectIdToObject(arrIDToDelete(0))
    oPLineToDelete.Delete
    Set oPLineToDelete = ThisDrawing.ObjectIdToObject(arrIDToDelete(1))
    oPLineToDelete.Delete
    oPLineTemp1.Layer = LayerOfSupport


    retObj = oPLineTemp1.Offset(dDist)
    Set oPLineTemp2 = retObj(0)
    arrIdNewLines(0) = oPLineTemp2.ObjectID
    retObj = oPLineTemp1.Offset(-dDist)

    Set oPLineTemp2 = retObj(0)
    arrIdNewLines(1) = oPLineTemp2.ObjectID
    oDicIDObjToDelete(sID) = arrIdNewLines
    oPLineTemp1.Delete
    'Debug.Print pObject.ObjectID



    On Error GoTo 0

good:

bCheckMain = False
'Stop
End Sub
Vadim_EC вне форума  
Ответ
Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > VBA Autocad 2019 Events Ошибка в событии зависает (возможно рекурсия)

Размещение рекламы
Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Отредактировать LIPS Dimcurve для AutoCad 2019 Mira13 LISP 7 01.02.2019 16:12
AutoCAD комплект файлов - ошибка при создании Zets AutoCAD 10 28.03.2014 16:08
При установке AutoCAD 2013 (лицензия) появляется ошибка autodesk installer. Yang AutoCAD 12 01.10.2013 12:11
AutoCAD Civil 2014/AutoCAD Civil 2014 as AutoCAD Eng,Rus. Ошибка - прерывание команды при наведении курсора на вкладку листа. Do$ Баги и пожелания в Autodesk 4 16.08.2013 23:06
Ошибка 1308, что делать??? (Autocad 2007) yhukym AutoCAD 6 15.03.2010 17:53