[CAHTEXHuK]

Дело такое... захотелось мне редактировать единичные объекты на заблокированных слоях. Для начала простенько. Перемещать, удалять. Казалось бы все просто пишу для какого-либо ивента проверку, на блокированном ли слое объект и делаю то что хочется... Ивентом выбрал двойной щелчок. и все вроде получилось... после дабл клика по объекту на заблокированном слое... запрос на действие... и все работает... но недолго я радовался... как только открываю любой другой чертеж, точнее после того, как чертежей становится несколько... перестает распознаваться Keyword .... может проблема в чем-то другом, но я был неприятно удивлен... кода ни символа не изменилось, а работать перестал...

Код:

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

ThisDrawing.Utility.InitializeUserInput 1, "Переместить Удалить" 
        Select Case ThisDrawing.Utility.GetKeyword("Действие [Переместить/Удалить]:")

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

[Александр Ривилис]

Версия AutoCAD? Вообще-то с русскими ключевыми словами в AutoCAD всегда не всё слава Богу.

[CAHTEXHuK]

2008 автокад Локализованный СП1 ... пробовал английские ключевые... ничего не меняется... я даже понять не понял, что изменилось... дома сейчас пробую, все как надо... просто на работе нет доступа в интернет... надо разобраться заочно, или найти другие пути ...

и раз уж тему начал... можно ли ? и насколько сложно реализовать отображение перемещаемого объекта программно, ... как при стандартном "Переместить" ... ?

[Александр Ривилис]

Сообщение от CAHTEXHuK пробовал английские ключевые... ничего не меняется... я

Если эта же проблема с английскими ключевыми словами, то вероятно нужно искать ошибку в своем коде. Ну или как минимум его вылодить здесь. Может кто-нибудь (не я, т.к. на VBA не пишу) подскажет.

Сообщение от CAHTEXHuK можно ли ? и насколько сложно реализовать отображение перемещаемого объекта программно, ... как при стандартном "Переместить" ... ?

Думаю, что на VBA очень проблематично.

[CAHTEXHuK]

Сообщение от Александр Ривилис Думаю, что на VBA очень проблематично.

может вы уже делали что-нить подобное другими средствами ?

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

Код:

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

Option Explicit

Private Sub AcadDocument_BeginDoubleClick(ByVal PickPoint As Variant)
Dim block As AcadBlockReference
Dim i As Byte
Dim dynm As Long 'текущее значение динамического ввода

On Error GoTo err


'===========================================
'=Редактирование заблокированных объектов===
'===========================================
Dim lockedentities As Long
Dim ent As AcadEntity
Dim selset As AcadSelectionSet
Dim entLayer As String
Dim action As String
Dim pnt1 As Variant, pnt2 As Variant
Dim KWlist As String

Set ent = PickfirstSelectionSet(0)
Set selset = PickfirstSelectionSet
entLayer = ent.layer
If PickfirstSelectionSet.Count >= 1 Then
    For i = 0 To PickfirstSelectionSet.Count - 1
        If ThisDrawing.Layers(PickfirstSelectionSet(i).layer).Lock = True Then
            lockedentities = lockedentities + 1
        End If
    Next i

    If lockedentities = PickfirstSelectionSet.Count Then
        dynm = CLng(ThisDrawing.GetVariable("DYNMODE"))
        ThisDrawing.SetVariable "DYNMODE", 3            'включение динамичеческого ввода для отображения подсказки возле курсора
        ThisDrawing.Utility.InitializeUserInput 1, "Переместить Удалить"
        Select Case ThisDrawing.Utility.GetKeyword("Действие [Переместить/Удалить]:")
            Case "Переместить"
                ThisDrawing.Layers(entLayer).Lock = False
                pnt1 = ThisDrawing.Utility.GetPoint
                pnt2 = ThisDrawing.Utility.GetPoint(pnt1)
                ent.Move pnt1, pnt2
                ThisDrawing.Layers(entLayer).Lock = True
            Case "Удалить"
                ThisDrawing.Layers(entLayer).Lock = False
                ent.Delete
                ThisDrawing.Layers(entLayer).Lock = True
        End Select
    End If
End If
ThisDrawing.SetVariable "DYNMODE", dynm     'Динамический ввод как был
Exit Sub
err:
ThisDrawing.SetVariable "DYNMODE", dynm     'Динамический ввод как был
Exit Sub
End Sub

[Александр Ривилис]

Сообщение от CAHTEXHuK может вы уже делали что-нить подобное другими средствами ?

Да. На ObjectARX.