2011年1月31日月曜日

CUIx ファイルを使わずにリボンにボタンを追加する(AutoCAD 2011)


いろいろググッてみたりして、リボンにボタンを追加できないかやってみました。


通常の操作では、CUI[ユーザ インタフェースをカスタマイズ] コマンドを実行して、CUIx ファイルをカスタマイズすると思うんですが、今回は CUIx ファイルを使わずに .NET でボタンの設定ができないかやってみました。


試してみたコードはこんな感じです。


' ------------------------------------------------------------
Imports System
Imports System.Windows
Imports System.Windows.Media
Imports System.Windows.Media.Imaging
Imports Autodesk.AutoCAD.Runtime
Imports Autodesk.AutoCAD.ApplicationServices
Imports Autodesk.AutoCAD.DatabaseServices
Imports Autodesk.AutoCAD.Geometry
Imports Autodesk.AutoCAD.EditorInput
Imports Autodesk.Windows
Imports Autodesk.AutoCAD.Ribbon.RibbonServices

' This line is not mandatory, but improves loading performances
<Assembly: CommandClass(GetType(AVDO_RibbonSample.MyCommands))>

Namespace AVDO_RibbonSample

    Public Class MyCommands

        <CommandMethod("AVDO_RibbonSample", "AVDO_RibbonSample", "AVDO_RibbonSample", CommandFlags.Modal)> _
        Public Sub AVDO_RibbonSample()
            Dim ribCtrl As RibbonControl = RibbonPaletteSet.RibbonControl

            ' リボンにタブを追加
            Dim ribTab As New RibbonTab
            ribTab.Title = "テスト"
            ribTab.Id = "ID_TEST"       ' ID を設定しないと、AutoCAD を終了するときにエラーが発生してしまう。
            ribCtrl.Tabs.Add(ribTab)

            ' パネルを作成
            Dim ribSourcePanel As New Autodesk.Windows.RibbonPanelSource
            ribSourcePanel.Title = "テスト パネル"
            Dim ribPanel As New RibbonPanel
            ribPanel.Source = ribSourcePanel
            ribTab.Panels.Add(ribPanel)

            ' ボタン1を作成
            Dim ribButton1 As New RibbonButton

            Dim bi1 As New BitmapImage()
            bi1.BeginInit()
            bi1.UriSource = New Uri("c:/temp/acadvideo16.jpg", UriKind.RelativeOrAbsolute)
            bi1.EndInit()
            ribButton1.Image = bi1

            ribButton1.Text = "テスト 線分"
            ribButton1.ShowText = True
            ribButton1.Description = "テスト用のボタンのひとつ目です"
            ribButton1.CommandParameter = Chr(27) & Chr(27) & "_LINE "
            ribButton1.CommandHandler = New AdskCommandHandler

            ' ボタン2を作成
            Dim ribButton2 As New RibbonButton

            Dim bi2 As New BitmapImage()
            bi2.BeginInit()
            bi2.UriSource = New Uri("c:/temp/acadvideo32.jpg", UriKind.RelativeOrAbsolute)
            bi2.EndInit()
            ribButton2.LargeImage = bi2
            ribButton2.Size = RibbonItemSize.Large

            ribButton2.Text = "テスト 円"
            ribButton2.ShowText = True
            ribButton2.Description = "テスト用のボタンのふたつ目です"
            ribButton2.CommandParameter = Chr(27) & Chr(27) & "_CIRCLE "
            ribButton2.CommandHandler = New AdskCommandHandler

            ' ボタンを追加
            ribSourcePanel.Items.Add(ribButton1)
            ribSourcePanel.Items.Add(New RibbonRowBreak())
            ribSourcePanel.Items.Add(ribButton2)

        End Sub

        Public Class AdskCommandHandler
            Implements System.Windows.Input.ICommand

            Public Function CanExecute(ByVal parameter As Object) As Boolean Implements System.Windows.Input.ICommand.CanExecute
                Return True
            End Function

            Public Event CanExecuteChanged(ByVal sender As Object, ByVal e As System.EventArgs) Implements System.Windows.Input.ICommand.CanExecuteChanged

            Public Sub Execute(ByVal parameter As Object) Implements System.Windows.Input.ICommand.Execute
                'is from a Ribbon Button?
                Dim ribBtn As RibbonButton = TryCast(parameter, RibbonButton)
                If ribBtn IsNot Nothing Then
                    Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument.SendStringToExecute(DirectCast(ribBtn.CommandParameter, [String]), True, False, True)
                End If

                'is from s Ribbon Textbox?
                Dim ribTxt As RibbonTextBox = TryCast(parameter, RibbonTextBox)
                If ribTxt IsNot Nothing Then
                    MsgBox(ribTxt.TextValue)
                End If
            End Sub
        End Class

    End Class

End Namespace
' ------------------------------------------------------------

AVDO_RibbonSample コマンドを実行すると、リボンに[テスト]が追加されて、その中に[テスト パネル]ができて、[テスト 線分]と[テスト 円]というボタンが追加されました。

※ c:/temp フォルダに、16X16 のイメージファイル acadvideo16.jpg と 32x32 のイメージファイル acadvideo32.jpg を置いています。

2011年1月7日金曜日

.NET - DLL ファイルを一度だけ手動でロードし、次回から自動的にロードされるようにする便利な方法(AutoCAD 2011)


今までいくつかこのブログで .NET で作成したツール(.DLL ファイル)を掲載してました。


それを使う時って、毎回 NETLOAD コマンドでロードするか、acad.lsp を編集して自動的にロードするようにしなきゃいけないですよね。


で、それって面倒ですよね。


以前の .NET - DLL ファイルを自動的にロードする(AutoCAD 2011) の中で、レジストリにデマンドロードの設定を追加すると、DLL ファイルを自動的にロードできるってことを紹介しました。


今日は、もっと便利な方法を Web で見つけたので、それを紹介したいと思います。


それは、一度だけ NETLOAD コマンドでロードすれば、レジストリに勝手に自動的にロードされる設定が追加さるっていう便利な方法です。


Creating demand-loading entries automatically for your AutoCAD application using .NET に書いてあったんですが、C# のコードだったので、以下のように VB のコードにしてみました。


'----------------------------------------------------------
Imports System
Imports System.Collections.Generic
Imports System.Reflection
Imports System.Resources
Imports Microsoft.Win32
Imports Autodesk.AutoCAD.DatabaseServices
Imports Autodesk.AutoCAD.Runtime

Namespace DemandLoading
    Public Class RegistryUpdate
        Public Shared Sub RegisterForDemandLoading()
            ' Get the assembly, its name and location

            Dim assem As Assembly = Assembly.GetExecutingAssembly()
            Dim name As String = assem.GetName().Name
            Dim path As String = assem.Location

            ' We'll collect information on the commands
            ' (we could have used a map or a more complex
            ' container for the global and localized names
            ' - the assumption is we will have an equal
            ' number of each with possibly fewer groups)

            Dim globCmds As New List(Of String)()
            Dim locCmds As New List(Of String)()
            Dim groups As New List(Of String)()

            ' Iterate through the modules in the assembly

            Dim mods As [Module]() = assem.GetModules(True)
            For Each [mod] As [Module] In mods
                ' Within each module, iterate through the types

                Dim types As Type() = [mod].GetTypes()
                For Each type As Type In types
                    ' We may need to get a type's resources

                    Dim rm As New ResourceManager(type.FullName, assem)
                    rm.IgnoreCase = True

                    ' Get each method on a type

                    Dim meths As MethodInfo() = type.GetMethods()
                    For Each meth As MethodInfo In meths
                        ' Get the methods custom command attribute(s)

                        Dim attbs As Object() = meth.GetCustomAttributes(GetType(CommandMethodAttribute), True)
                        For Each attb As Object In attbs
                            Dim cma As CommandMethodAttribute = TryCast(attb, CommandMethodAttribute)
                            If cma IsNot Nothing Then
                                ' And we can finally harvest the information
                                ' about each command

                                Dim globName As String = cma.GlobalName
                                Dim locName As String = globName
                                Dim lid As String = cma.LocalizedNameId

                                ' If we have a localized command ID,
                                ' let's look it up in our resources

                                If lid IsNot Nothing Then
                                    ' Let's put a try-catch block around this
                                    ' Failure just means we use the global
                                    ' name twice (the default)

                                    Try
                                        locName = rm.GetString(lid)
                                    Catch
                                    End Try
                                End If

                                ' Add the information to our data structures

                                globCmds.Add(globName)
                                locCmds.Add(locName)

                                If cma.GroupName IsNot Nothing AndAlso Not groups.Contains(cma.GroupName) Then
                                    groups.Add(cma.GroupName)
                                End If
                            End If
                        Next
                    Next
                Next
            Next

            ' Let's register the application to load on demand (12)
            ' if it contains commands, otherwise we will have it
            ' load on AutoCAD startup (2)

            Dim flags As Integer = (If(globCmds.Count > 0, 12, 2))

            ' By default let's create the commands in HKCU
            ' (pass false if we want to create in HKLM)

            CreateDemandLoadingEntries(name, path, globCmds, locCmds, groups, flags, True)
        End Sub

        Public Shared Sub UnregisterForDemandLoading()
            RemoveDemandLoadingEntries(True)
        End Sub

        ' Helper functions

        Private Shared Sub CreateDemandLoadingEntries(ByVal name As String, ByVal path As String, ByVal globCmds As List(Of String), ByVal locCmds As List(Of String), ByVal groups As List(Of String), ByVal flags As Integer, _
         ByVal currentUser As Boolean)
            ' Choose a Registry hive based on the function input

            Dim hive As RegistryKey = (If(currentUser, Registry.CurrentUser, Registry.LocalMachine))

            ' Open the main AutoCAD (or vertical) and "Applications" keys

            Dim ack As RegistryKey = hive.OpenSubKey(HostApplicationServices.Current.RegistryProductRootKey, True)
            Using ack
                Dim appk As RegistryKey = ack.CreateSubKey("Applications")
                Using appk
                    ' Already registered? Just return

                    Dim subKeys As String() = appk.GetSubKeyNames()
                    For Each subKey As String In subKeys
                        If subKey.Equals(name) Then
                            Return
                        End If
                    Next

                    ' Create the our application's root key and its values

                    Dim rk As RegistryKey = appk.CreateSubKey(name)
                    Using rk
                        rk.SetValue("DESCRIPTION", name, RegistryValueKind.[String])
                        rk.SetValue("LOADCTRLS", flags, RegistryValueKind.DWord)
                        rk.SetValue("LOADER", path, RegistryValueKind.[String])
                        rk.SetValue("MANAGED", 1, RegistryValueKind.DWord)

                        ' Create a subkey if there are any commands...

                        If (globCmds.Count = locCmds.Count) AndAlso globCmds.Count > 0 Then
                            Dim ck As RegistryKey = rk.CreateSubKey("Commands")
                            Using ck
                                For i As Integer = 0 To globCmds.Count - 1
                                    ck.SetValue(globCmds(i), locCmds(i), RegistryValueKind.[String])
                                Next
                            End Using
                        End If

                        ' And the command groups, if there are any

                        If groups.Count > 0 Then
                            Dim gk As RegistryKey = rk.CreateSubKey("Groups")
                            Using gk
                                For Each grpName As String In groups
                                    gk.SetValue(grpName, grpName, RegistryValueKind.[String])
                                Next
                            End Using
                        End If
                    End Using
                End Using
            End Using
        End Sub

        Private Shared Sub RemoveDemandLoadingEntries(ByVal currentUser As Boolean)
            Try
                ' Choose a Registry hive based on the function input

                Dim hive As RegistryKey = (If(currentUser, Registry.CurrentUser, Registry.LocalMachine))

                ' Open the main AutoCAD (vertical) and "Applications" keys

                Dim ack As RegistryKey = hive.OpenSubKey(HostApplicationServices.Current.RegistryProductRootKey)
                Using ack
                    Dim appk As RegistryKey = ack.OpenSubKey("Applications", True)
                    Using appk
                        ' Delete the key with the same name as this assembly

                        appk.DeleteSubKeyTree(Assembly.GetExecutingAssembly().GetName().Name)
                    End Using
                End Using
            Catch
            End Try
        End Sub
    End Class
End Namespace
'----------------------------------------------------------

RegisterForDemandLoading() を実行すると、レジストリに必要な記述が追加されます。
なので、myPlugin.vb の Initialize() 中で、RegisterForDemandLoading() を実行するようにしとけば OK です。


このとき、既定値では HKCU に追加されます。
HKLM に追加したいときは、以下の部分を変更すればできます。

CreateDemandLoadingEntries(name, path, globCmds, locCmds, groups, flags, True)
                                                   ↓
CreateDemandLoadingEntries(name, path, globCmds, locCmds, groups, flags, False)

ただ、管理者権限で AutoCAD を起動していないと HKLM に追加できないので、既定値の HKCU に追加するのがいいんじゃないかと思います。


また、レジストリに追加された内容を削除したいときは、UnregisterForDemandLoading() を実行すると、削除されます。