Imports System
Imports System.Windows.Media.Imaging
Imports Autodesk.Revit.DB
Imports Autodesk.Revit.UI
Imports Autodesk.Revit.ApplicationServices
Imports Autodesk.Revit.Attributes
Imports Autodesk.Revit.UI.Selection
Imports System.IO
Imports Autodesk.Revit.UI.Events
Imports adWin = Autodesk.Windows
Public Class Andrey_Revit_Ribbon_UI
Implements IExternalApplication
Private Const _dllExtension As String = ".dll"
Private Const _introLabName As String = "Andrey_Plugin"
Private Const _uiLabName As String = "Ribbon_Customization"
Private Const _imageFolderName As String = "Images"
Private _imageFolder As String
Private _introLabPath As String
Private Function FindFolderInParents(ByVal path As String, ByVal target As String) As String
Do
Dim s As String = System.IO.Path.Combine(path, target)
If Directory.Exists(s) Then
Return s
End If
path = System.IO.Path.GetDirectoryName(path)
Loop While (path IsNot Nothing)
Return Nothing
End Function
Function NewBitmapImage(ByVal imageName As String) As BitmapImage
Return New BitmapImage(New Uri(Path.Combine(Me._imageFolder, imageName)))
End Function
Public Function OnShutdown(ByVal app As UIControlledApplication) As Result _
Implements IExternalApplication.OnShutdown
Return Result.Succeeded
End Function
Public Function OnStartup(ByVal app As UIControlledApplication) As Result _
Implements IExternalApplication.OnStartup
Dim dir As String = Path.GetDirectoryName( _
System.Reflection.Assembly.GetExecutingAssembly.Location)
_introLabPath = Path.Combine(dir, _introLabName + _dllExtension)
If Not File.
Exists(_introLabPath
) Then TaskDialog.Show("UIRibbon", "Сборка для внешней команды не найдена: " + _introLabPath)
Return Result.Failed
End If
_imageFolder = FindFolderInParents(dir, _imageFolderName)
If _imageFolder Is Nothing Or Not Directory.Exists(_imageFolder) Then
TaskDialog.Show( _
"UIRibbon", _
String.Format( _
"Нет папки изображений '{0}' в требуемой директории '{1}.", _
_imageFolderName, dir))
Return Result.Failed
End If
AddRibbonSampler(app)
Return Result.Succeeded
End Function
Sub AddRibbonSampler(ByVal app As UIControlledApplication)
Dim myTabName As String = ""
FileOpen(1, My.Application.Info.DirectoryPath & "\Data\buttons_list.txt", OpenMode.Input)
Do While Not EOF(1)
Dim myStr As String = LineInput(1)
Select Case myStr
Case "<Tab>"
myTabName = LineInput(1)
End Select
Loop
FileClose(1)
app.CreateRibbonTab(IIf(myTabName = "", "Nameless Tab", myTabName))
Dim panel As RibbonPanel = app.CreateRibbonPanel(IIf(myTabName = "", "Nameless Tab", myTabName), "Приложения")
Dim myFile As String = My.Application.Info.DirectoryPath & "\Data\buttons_list.txt"
Try
If IO.
File.
Exists(myFile
) Then FileOpen(1, myFile, OpenMode.Input)
Do While Not EOF(1)
Dim myStr As String = LineInput(1)
Select Case Trim(myStr)
Case "<Button>"
Dim myButtonName As String = LineInput(1)
Dim myICO As String = LineInput(1)
Dim myApp As String = LineInput(1)
AddPushButtonByFile(panel, myButtonName, myApp, myICO)
End Select
Loop
FileClose(1)
End If
Catch ex As Exception
MsgBox("OK!")
End Try
End Sub
Sub AddPushButtonByFile(ByVal panel As RibbonPanel, ByVal Button_Name As String, ByVal App_Path As String, ByVal Image_Path As String)
Dim pushButton As New PushButtonData(Button_Name, Button_Name, _introLabPath, _introLabName + ".Andrey_App_Start")
pushButton.Text = Button_Name
pushButton.LongDescription = App_Path
pushButton.ToolTip = App_Path
Dim pushButtonAction As PushButton = panel.AddItem(pushButton)
pushButtonAction.LargeImage = NewBitmapImage(My.Application.Info.DirectoryPath & Image_Path)
pushButtonAction.ToolTip = App_Path
pushButtonAction.LongDescription = App_Path
'AddHandler adWin.ComponentManager.UIElementActivated, New EventHandler(AddressOf PBClick) - данная строка тоже работает!!!
' •••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••
AddHandler adWin.ComponentManager.UIElementActivated, AddressOf PBClick ' Именно эта строка отвечает за обработку события нажатия на кнопку
' •••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••
End Sub
Public Sub PBClick(ByVal sender As Object, ByVal e As adWin.UIElementActivatedEventArgs)
Try
If e.UiElement.IsFocused Then
If e.UiElement.IsMouseOver Then
Dim mTT As Autodesk.Windows.RibbonToolTip = e.Item.ToolTip
If IsProcessExist(mTT.Content.ToString) Then
Else
Process.Start(mTT.Content.ToString)
Threading.Thread.Sleep(1000)
End If
End If
End If
Catch ex As Exception
End Try
End Sub
Public Function IsProcessExist(ByVal SearchText As String) As Boolean
For Each mP As Process In Process.GetProcesses
If InStr(SearchText, mP.ProcessName) <> 0 Then
IsProcessExist = True
Exit Function
End If
Next
Return False
End Function
End Class
