[TechNick]

Добрый день. Одним бывшем сотрудником была написана на добровольных началах программа на VBA для Autocad 2009. После установки в организации Autocad 2014 программа работать перестала.
Суть в следующем. Пользуемся одним программным комплексом под Autocad который умеет в том числе вставлять стандартные форматки листов со штампом в модель. Форматки вставляются блоками, которые имеют имя типа f12 для 297х420, f24 для 594х841 и т.д. Далее пользуемся сабжевой VBA программой, которая может запускаться двумя кнопками. При нажатии на первую программа находит в модели все блоки с форматами листов и выводит в окне их список из которого пользователь выбирает нужные и после нажатия ОК программа создаёт по размерам блоков листы с вписанными видовыми экранами. При нажатии на вторую программа просит тыкнуть мышкой в нужный блок в модели и создаёт по его размерам лист с видовым экраном. Параметры листа настраиваются VBA программой под DWF принтер с именем MyDWF.
После установки программы на Autocad 2014 при попытке запуска по первой кнопке создаётся лист по размеру блока, а дальше вываливается ошибка в строке:
Set pviewportObj = ThisDrawing.ActiveLayout.Block.Item(1) 'Пытаемся получит видовой экран
При запуске программы второй кнопкой ошибок не получаем, но точно так же создаётся только лист и на этом всё останавливается.
Помогите пожалуйста исправить.
Прикладываю архив с необходимыми файлами, а так же dwg файл с созданными форматками в Autocad 2009, чтобы понять о чём речь.

[maratovich]

Сообщение от TechNick программа создаёт по размерам блоков листы с вписанными видовыми экранами.

В чужом коде ковырятся - неблагодарное занятие.
Может легче сразу печатать из модели ? Зачем листы то создавать ?

[trir]

Ах, моё родное!

[gomer]

Сообщение от trir Ах, моё родное

ога!, попался быдлокодер!

[trir]

Ничего ты не понимаешь в колбасных обрезках! Это шедевр!

Замени на:

Код:

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

    Dim center(0 To 2) As Double
    center(0) = 3: center(1) = 3: center(2) = 0
    Set pviewportObj = ThisDrawing.PaperSpace.AddPViewport(center, 1, 1)

Может заработает...
Нету под рукой 2014, кстати а какая разрядность?

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

Может, дело в настройках AutoCAD? Например, в галочке "создавать новый ВЭ при создании листа"?

[trir]

Сообщение от Кулик Алексей aka kpblc Может, дело в настройках AutoCAD? Например, в галочке "создавать новый ВЭ при создании листа"?

Очень может быть!

[TechNick]

Сообщение от trir Ах, моё родное!

Вах, даже не надеялся что найду тут. Пользуем твою прогу всей конторой и жить без неё не можем. Огромная признательность за труды.
Разрядность x64. Завтра попробую поменять галочку. Спасибо!

[Дима_]

Сообщение от TechNick Пользуем твою прогу всей конторой и жить без неё не можем.

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

[trir]

Код был написан по просьбе на корпоративном форуме, просто ради практики в VBA (как раз тогда интенсивно изучал), в результате им пользуются в филиале в Нижнем Новгороде, а филиале в Екатеринбурге (где он был написан) - о нём никто не знает

TechNick может организуешь письмо в Екб-филиал типа "спасибо за помощь" - что бы там начальство прониклось just for lulz

[TechNick]

Сообщение от trir TechNick может организуешь письмо в Екб-филиал типа "спасибо за помощь" - что бы там начальство прониклось just for lulz

Было предложение. Заглохло
Руководство не впечатлилось. Зато все сотрудники только и просят поставить им кнопочки в случае переустановки

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

Сообщение от Кулик Алексей aka kpblc Может, дело в настройках AutoCAD? Например, в галочке "создавать новый ВЭ при создании листа"?

Галочка стояла. Хоть ставь галочку, хоть убирай всё равно эта ошибка возникает

[trir]

тогда моё предложение из поста №5

[TechNick]

Сообщение от trir Ничего ты не понимаешь в колбасных обрезках! Это шедевр! Замени на: Код: [Выделить все] Dim center(0 To 2) As Double center(0) = 3: center(1) = 3: center(2) = 0 Set pviewportObj = ThisDrawing.PaperSpace.AddPViewport(center, 1, 1) Может заработает... Нету под рукой 2014, кстати а какая разрядность?

Теперь ругается на Dim center(0 To 2) As Double говорит Compile error: Duplicate declaration in current scope

[giprsk]

Сообщение от trir Нету под рукой 2014, кстати а какая разрядность?

Перестала исполняться функция dvb при переходе с 32bit на ACAD2014 64bit Win7. Насколько я понимаю проблема в считывании команд из библиотеки user32 Windows.
Библиотека "user32.dll"для 32bit находится в папке C:\Windows\System32 , а для 64bit в C:\Windows\SysWOW64.
Подскажите, пожалуйста, что надо сделать, чтобы функция dvb заработала?

[trir]

Замени:
Set pviewportObj = ThisDrawing.ActiveLayout.Block.Item(1)
На:
Set pviewportObj = ThisDrawing.PaperSpace.AddPViewport(center, 1, 1)

giprsk почитай

[TechNick]

Сообщение от trir Замени: Set pviewportObj = ThisDrawing.ActiveLayout.Block.Item(1) На: Set pviewportObj = ThisDrawing.PaperSpace.AddPViewport(center, 1, 1)

Заменить только это или и то что в #5?
В любом случае ругается на Dim pviewportObj As IAcadPViewport2 'Новый видовой экран
говорит Compile error: User-defined type not defined.

[TechNick]

Кстати под Autocad 2012 x64 ругается вот так.
Помогает закоментировать эту и следующую строку, но штамп видовой экран не обходит

[kikoko]

Off Topic !
Идея : для x64 -> ObjectID32 (так как LayoutId x86 -> LayoutId32 x64 ; ObjectIdToObject x86 -> ObjectIDToObject32 x64 и т.д)

[giprsk]

Сообщение от trir giprsk почитай

Спасибо большое за подсказку. Добавил PtrSafe и дело пошло. Однако функция всё равно не работает. Может не понимает, что такое hWnd? К сожалению, не умею отлаживать VBA

Код:

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

Option Explicit

Private Declare PtrSafe Function LoadImage Lib "user32" Alias "LoadImageA" _
       (ByVal hInst As Long, ByVal lpsz As String, ByVal un1 As Long, _
        ByVal n1 As Long, ByVal n2 As Long, ByVal un2 As Long) As Long

Private Declare PtrSafe Function SendMessage Lib "user32" Alias "SendMessageA" _
       (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, _
        LParam As Any) As Long

Private Declare PtrSafe Function SetWindowText Lib "user32" Alias "SetWindowTextA" _
       (ByVal hWnd As Long, ByVal lpString As String) As Long

Public Declare PtrSafe Function GetParentU Lib "user32" Alias "GetParent" _
       (ByVal hWnd As Long) As Long

Private Function SVR_GetACADHandle(ByVal dwg_handle As Long) As Long
  Dim hwndtmp As Long
  hwndtmp = GetParentU(dwg_handle)
  If hwndtmp > 0 Then
    SVR_GetACADHandle = GetParentU(hwndtmp)
  End If
End Function

Public Function SetWindowIcon(hWnd As Long, IconPath As String) As Boolean
  Dim hIcon As Long
  hIcon = LoadImage(0&, IconPath, 1, 0, 0, &H10)
  If hIcon <> 0 Then
    Call SendMessage(hWnd, &H80, 0, ByVal hIcon)
    SetWindowIcon = True
  End If
End Function

''Устанавливает пользовательскую строку, соответствующую названию текущего профиля, и значок в заглавие окна Автокада

Sub ChangeProfileIcon()

  On Local Error GoTo ErrChIcon

  Dim ProfStr As String
  Dim AcadHndl As Long
  ProfStr = ThisDrawing.GetVariable("CPROFILE")
  AcadHndl = SVR_GetACADHandle(ThisDrawing.hWnd)
  SetWindowText AcadHndl, ProfStr
  SetWindowIcon AcadHndl, "C:\ACAD_NEW.ico"

  
ErrChIcon:
End Sub

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

Советую прочитать (дополнительно) http://adn-cis.org/vbamacro-compatib...ad2014x64.html
P.S. В коде не копался