[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, чтобы понять о чём речь.

[trir]

giprsk - попробуй заменить на LongPtr
TechNick походу я и использовал предыдущую строчку, из-за этой ошибки. Если будет время - сяду и посмотрю. Но по хорошему надо переводить но dotNET, но ...

[giprsk]

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

Спасибо большое за поддержку, но пока не знаю как справиться:

заменить 32-разрядные версии своих компонентов на их 64-битные аналоги, или, если таковых не существует, переделать свой проект, либо, найдя обходные пути, использовать OCX/TypeLibrary от другого поставщика

Функция позволяет выводить в наименование окна Автокада Имя текущего Профиля и показывать заданный Вами значок иконки на панели задач. Удобно, если Вы работаете с несколькими Приложениями для Автокада, сопоставленные с Профилями.
Во вложении Макрос ProfileIcon.dvb для работы с произвольной пользовательской Иконкой С:\ACAD_OLD.ico. В ACAD 2013 работало... Может у кого-нибудь из знатоков VBA будет желание отладить функцию?

[giprsk]

Сообщение от trir giprsk - попробуй заменить на LongPtr

Тупо заменил везде Long на LongPtr - заработало!!!
Спасибище Вам огромное! Ребята, у кого функции не запредельного объёма, можете попробовать. Желаю успеха.

Код:

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

Option Explicit

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

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

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

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

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

Public Function SetWindowIcon(hWnd As LongPtr, IconPath As String) As Boolean
  Dim hIcon As LongPtr
  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 LongPtr
  ProfStr = ThisDrawing.GetVariable("CPROFILE")
  AcadHndl = SVR_GetACADHandle(ThisDrawing.hWnd)
  SetWindowText AcadHndl, ProfStr
  SetWindowIcon AcadHndl, "C:\ACAD_OLD.ico"

  
ErrChIcon:
End Sub

[freese]

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

такая же беда

[TechNick]

Сообщение от trir giprsk - попробуй заменить на LongPtr TechNick походу я и использовал предыдущую строчку, из-за этой ошибки. Если будет время - сяду и посмотрю. Но по хорошему надо переводить но dotNET, но ...

Благодарю. Пока поставлю акад 2009 для формирования листов