2011年2月26日土曜日

.NET - 異なる値で連続オフセットするプログラムを作ってみました(AutoCAD 2011)


先日異なる値で連続オフセットする(AutoCAD 2011)で書きましたが、異なる値で連続オフセットするプログラムを作ってみました。

GetOffsetCurves メソッドでオフセットできるみたいだったので、結構簡単に作れるのかなと思って始めたんですた、なかなか難しかったです。


最初につまずいたのは、AutoCAD の OFFSET コマンドみたいにオフセットする側をクリックして指定できたら便利だと思ったんですが、どうやってやればいいのやら???

そのためのメソッドとかなにかあるのかなと思ったんですが、見つけられませんでした。
いろいろググッても見たんですが、それでも何も見つけられなくて…

ほとんど諦めかけてたんですが、ひょっとして 「元のオブジェクト と クリックした点の最短距離」 と 「オフセットしたオブジェクト と リックした点の最短距離」 を比較すればいのかなって思ってやってみたらできました。

もっといい方法があるのかどうかは分かりませんが、とりあえずできたのでよしとしましょう。


GetClosestPointTo メソッドで、クリックした点から一番近いオブジェクト上の点を求めて、DistanceTo メソッドで距離を求めました。

で、連続オフセットする最初の一回目だけ、 「元のオブジェクト と クリックした点の最短距離」 と 「オフセットしたオブジェクト と リックした点の最短距離」 を比較して、前者より後者の方が大きかったときはオフセットする方向を反対にしました。


それと、UCS を変更するとうまくいかないことがあるみたいだったので、UCS を WCS に変換するっていう手順も追加しました。


コードはこんな感じです。
' ---------------------------------------------
Imports System
Imports Autodesk.AutoCAD.Runtime
Imports Autodesk.AutoCAD.ApplicationServices
Imports Autodesk.AutoCAD.DatabaseServices
Imports Autodesk.AutoCAD.Geometry
Imports Autodesk.AutoCAD.EditorInput
Imports AVDO_Offset.DemandLoading.RegistryUpdate

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

Namespace AVDO_Offset

    Public Class MyCommands
        <CommandMethod("AVDO_Offset", "AVDO_Offset", CommandFlags.Modal + CommandFlags.UsePickSet)> _
        Public Sub AVDO_Offset()
            Dim doc As Document = Application.DocumentManager.MdiActiveDocument
            Dim db As Database = doc.Database
            Dim ed As Editor = doc.Editor

            ' オフセットのために選択したオブジェクトのオブジェクトID
            Dim selEntID As ObjectId

            ' PickFirst 選択セットを取得
            Dim psr As PromptSelectionResult = ed.SelectImplied()

            If psr.Status = PromptStatus.OK Then
                If psr.Value.Count > 1 Then
                    ' 複数のオブジェクトが PickFirst 選択セットに含まれているときは、ひとつのオブジェクトを選択しなおす
                    selEntID = ed.GetEntity("オブジェクトを選択").ObjectId
                Else
                    ' ひとつだけのオブジェクトが PickFirst 選択セットに含まれているときは、そのオブジェクトIDを使用
                    selEntID = psr.Value.GetObjectIds(0)
                End If
            Else
                ' PickFirst 選択セットを取得できなかったときオブジェクトをオブジェクトを選択する
                selEntID = ed.GetEntity(vbCrLf & "オブジェクトを選択").ObjectId
            End If

            ' 何も選択されていなかったら、コマンドを終了する
            If selEntID.IsValid = False Then
                Return
            End If


            Using trans As Transaction = db.TransactionManager.StartTransaction
                Dim ent As Entity = trans.GetObject(selEntID, OpenMode.ForRead)

                ' 選択されたオブジェクトが、オフセットの対象でない場合はコマンドを終了する
                If (TypeOf ent Is Line) _
                        Or (TypeOf ent Is Arc) _
                        Or (TypeOf ent Is Circle) _
                        Or (TypeOf ent Is Ellipse) _
                        Or (TypeOf ent Is Polyline) _
                        Or (TypeOf ent Is Polyline2d) _
                        Or (TypeOf ent Is Spline) _
                        Or (TypeOf ent Is Xline) Then
                Else
                    ed.WriteMessage(vbCrLf & "このオブジェクトはオフセットできません。")
                    Return
                End If
            End Using
          

            ' オフセットする方向を指定
            Dim ppo As PromptPointOptions = New PromptPointOptions(vbCrLf & "オフセットする側の点を指定")
            Dim ppr As PromptPointResult

            ppr = ed.GetPoint(ppo)

            If ppr.Status <> PromptStatus.OK Then
                Return
            End If

            ' オフセットする距離
            Dim dist As Double = 0

            ' オフセットする距離の追加分
            Dim distAdd As Double = 0

            ' オフセットしている回数
            Dim cnt As Integer = 0

            ' オフセットする側
            Dim ofstDirection As Boolean = True

            While True
                Using trans As Transaction = db.TransactionManager.StartTransaction
                    Try
                        Dim bt As BlockTable = trans.GetObject(db.BlockTableId, OpenMode.ForRead)
                        Dim btRec As BlockTableRecord

                        Dim cSpace As BlockTableRecord = trans.GetObject(db.CurrentSpaceId, OpenMode.ForRead)
                        If cSpace.Name = "*Model_Space" Then
                            btRec = trans.GetObject(bt(BlockTableRecord.ModelSpace), OpenMode.ForWrite)
                        Else
                            btRec = trans.GetObject(bt(BlockTableRecord.PaperSpace), OpenMode.ForWrite)
                        End If

                        ' 選択したオブジェクトに対して実行
                        Dim ent As Entity = trans.GetObject(selEntID, OpenMode.ForRead)

                        'オフセットされたオブジェクトコレクション
                        Dim dbObjColl As DBObjectCollection = Nothing

                        ' オフセットする距離を入力させる
                        Dim pdo As PromptDistanceOptions
                        If cnt = 0 Then
                            pdo = New PromptDistanceOptions(vbCrLf & "距離を指定してください")
                        Else
                            pdo = New PromptDistanceOptions(vbCrLf & "距離を指定してください<" & distAdd & ">")
                        End If
                        pdo.AllowNone = True
                        pdo.AllowNegative = False
                        pdo.Keywords.Add("eXit", "eXit", "終了(X)")

                        Dim pdr As PromptDoubleResult

                        pdr = ed.GetDistance(pdo)

                        If pdr.Status <> PromptStatus.None Then
                            distAdd = pdr.Value
                        End If

                        ' [終了(X)] オプションが選択されたときは、コマンドを終了
                        If pdr.StringResult = "eXit" Then
                            Return
                        End If

                        If cnt = 0 Then
                            If pdr.Status <> PromptStatus.OK Then
                                Return
                            End If
                        Else
                            If (pdr.Status <> PromptStatus.OK) And (pdr.Status <> PromptStatus.None) Then
                                Return
                            End If
                        End If


                        dist = dist + distAdd

                        ' それぞれのオブジェクトに対するオブジェクトコレクションを作成
                        Dim ofstent As Curve = ent

                        ' GetOffsetCurves で使うオフセット値
                        Dim ofstDist As Double
                        If ofstDirection = True Then
                            ofstDist = dist
                        Else
                            ofstDist = 0 - dist
                        End If

                        ' オフセットしたオブジェクトを作成
                        Try
                            dbObjColl = ofstent.GetOffsetCurves(ofstDist)
                        Catch ex As Autodesk.AutoCAD.Runtime.Exception
                            ed.WriteMessage(vbCrLf & "このオブジェクトはオフセットできません。")
                            Return
                        End Try

                        ' UCS を WCS に変換
                        Dim vpTblRec As ViewportTableRecord = trans.GetObject(doc.Editor.ActiveViewportId, OpenMode.ForWrite)

                        Dim newMatrix As Matrix3d = New Matrix3d()
                        newMatrix = Matrix3d.AlignCoordinateSystem(Point3d.Origin, _
                                                     Vector3d.XAxis, _
                                                     Vector3d.YAxis, _
                                                     Vector3d.ZAxis, _
                                                     vpTblRec.Ucs.Origin, _
                                                     vpTblRec.Ucs.Xaxis, _
                                                     vpTblRec.Ucs.Yaxis, _
                                                     vpTblRec.Ucs.Zaxis)

                        Dim pprWCS As Point3d = ppr.Value.TransformBy(newMatrix)


                        ' オフセットする側が正しいか確認し、間違っていれば反対にする
                        Dim distOrg As Double = ofstent.GetClosestPointTo(pprWCS, True).DistanceTo(pprWCS)  ' 元のオブジェクトと指定した点の距離
                        Dim distOfst As Double = distPtoObjColl(pprWCS, dbObjColl)  ' オフセットしたオブジェクトと指定した点の距離

                        ' 最初のオフセットのときに、オフセットする側が正しいか確認
                        If (cnt = 0) And (distOrg < distOfst) Then
                            dbObjColl.Dispose()
                            Try
                                dbObjColl = ofstent.GetOffsetCurves(-dist)
                            Catch ex As Autodesk.AutoCAD.Runtime.Exception
                                ed.WriteMessage(vbCrLf & "このオブジェクトはオフセットできません。")
                                Return
                            End Try
                            ofstDirection = False
                        End If

                        cnt += 1

                        ' オフセットされたオブジェクトを追加
                        If dbObjColl <> Nothing Then
                            For Each acEnt As Entity In dbObjColl
                                btRec.AppendEntity(acEnt)
                                trans.AddNewlyCreatedDBObject(acEnt, True)
                            Next
                        End If

                        trans.Commit()

                    Catch ex As Autodesk.AutoCAD.Runtime.Exception
                        MsgBox(ex.Message)

                    End Try
                End Using
            End While
        End Sub

        ' ある点と、オブジェクトコレクションにあるオブジェクトの最短距離を求める関数
        Public Function distPtoObjColl(ByVal pt As Point3d, ByVal dbObjColl As DBObjectCollection) As Double
            Dim dist As Double = 10 ^ 100

            For Each acEnt As Curve In dbObjColl
                Dim pt2 As Point3d = acEnt.GetClosestPointTo(pt, True)
                Dim distTemp As Double = pt.DistanceTo(pt2)
                If distTemp < dist Then
                    dist = distTemp
                End If
            Next

            Return dist
        End Function
    End Class
End Namespace
' ---------------------------------------------

2011年2月3日木曜日

.NET でプロファイルを変更する(AutoCAD 2011)


プロファイルを変更するには[オプション]ダイアログの[プロファイル]タブで、変更したいプロファイルをダブルクリックするんですが、ちょっと面倒くさいなと思って .NET でコマンド作れないかいろいろググリながらやってみました。

私の場合は以下の 2D 用と 3D 用のプロファイルがあります。
ACAD Video 2D
ACAD Video 3D

それを入れ替えるコマンドを作ってみました。
2D 用のプロファイルにするコマンド : AVDO_2D
3D 用のプロファイルにするコマンド : AVDO_3D
コードはこんな感じです。
--------------------------------------------------
Imports System
Imports Autodesk.AutoCAD.Runtime
Imports Autodesk.AutoCAD.ApplicationServices
Imports Autodesk.AutoCAD.DatabaseServices
Imports Autodesk.AutoCAD.Geometry
Imports Autodesk.AutoCAD.EditorInput
Imports Autodesk.AutoCAD.Interop

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

Namespace AVDO_ChWsProfile

    Public Class MyCommands

        Const p2d As String = "ACAD Video 2D"      ' 2D 用のプロファイルの名前
        Const p3d As String = "ACAD Video 3D"      ' 3D 用のプロファイルの名前

        <CommandMethod("AVDO_ChWsProfile", "AVDO_2D", "AVDO_2D", CommandFlags.Modal)> _
        Public Sub AVDO_2D()
            Dim ap As AcadPreferences = Application.Preferences

            If ap.Profiles.ActiveProfile = p2d Then
                MsgBox("プロファイルは既に " & p2d & " になっています。")
                Return
            End If

            If ChProperty(p2d) Then
                ap.Profiles.ActiveProfile = p2d
            Else
                MsgBox(p2d & " というプロファイルがありません。")
            End If

        End Sub

        <CommandMethod("AVDO_ChWsProfile", "AVDO_3D", "AVDO_3D", CommandFlags.Modal)> _
        Public Sub AVDO_3D()
            Dim ap As AcadPreferences = Application.Preferences

            If ap.Profiles.ActiveProfile = p3d Then
                MsgBox("プロファイルは既に " & p3d & " になっています。")
                Return
            End If

            If ChProperty(p3d) Then
                ap.Profiles.ActiveProfile = p3d
            Else
                MsgBox(p3d & " というプロファイルがありません。")
            End If
        End Sub

        ' 指定したプロファイルが存在するかどうかを確認する関数
        Public Function ChProperty(ByVal pName As String)
            Dim ap As AcadPreferences = Application.Preferences

            ' 存在するプロパティの取得
            Dim Profiles As Object = Nothing
            ap.Profiles.GetAllProfileNames(Profiles)

            For Each pr In Profiles
                ' もし、指定したプロファイルが存在すれば、True を返す
                If pr.ToString = pName Then
                    Return True
                End If
            Next

            Return False
        End Function
    End Class
End Namespace
-------------------------------------------------

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() を実行すると、削除されます。

2010年12月28日火曜日

.NET - 2 つの図面のシステム変数の違いを見つける(AutoCAD 2011)


『なんでか他の図面では問題ないんだけど、この図面だけ動きがおかしいんだよね』 なんてときには、図面に保存されているシステム変数の値が原因ってことがあります。
そんな時には、問題ない図面とシステム変数を比較してみるのがいいと思います。

ということで、簡単に比較できるようなツールを .NET の勉強も兼ねて作ってみました。


以前、2つの図面のシステム変数の比較(AutoCAD 2011) で、『.NET の ReadDwgFile メソッドを使用して、2つの図面のシステム変数の比較ができるかもと言ったのですが、チャレンジしてみたのですが、できませんでした。』って言ってたんですが、できました。

システム変数を取得するには Application.GetSystemVariable メソッドを使うしかないと思ってたんですが、Database Properties にシステム変数があるってことに気が付きました。

Database Properties にあるシステム変数をひとつずつ比較してみたので、結構時間がかかりましたが何とかできました。

ただ、システム変数 SKPOLY に関しては、ちゃんと判断できないみたいです。
というのは、SKPOLY には 0、1、2 のどれかの値が設定されるんですが、Database Properties では、True か False しか判断できないのです。
なので、0 は False で判断できるんですが、1 と 2 は両方とも True になっちゃうので、どちかわからないです。

しょうがないので、今回のプログラムでは、True のときは、『1 or 2』 って表示されるようにしました。


DLL ファイルは ここ にあります。

使い方とかは、動画を作ったので見てみてください。

2010年12月20日月曜日

.NET - 寸法図形の寸法スタイルを変更する(AutoCAD 2011)


昨日は、現在の寸法スタイルを変更する方法でしたね。
今日は、既に描かれている寸法図形を他の寸法スタイルに変更する方法を試してみたので、それを紹介したいと思います。

例えば、選択した寸法図形の寸法スタイルを「ACAD Video」という寸法スタイルの変えたいときは、こんな感じでできました。

'--------------------------------------------------------
<CommandMethod("test", "test4", CommandFlags.Modal + CommandFlags.UsePickSet)> _
Public Sub test4()

    Dim doc As Document = Application.DocumentManager.MdiActiveDocument
    Dim db As Database = doc.Database
    Dim ed As Editor = doc.Editor

    Using trans As Transaction = db.TransactionManager.StartTransaction
        Try
            ' PickFirst 選択セットを取得
            Dim psr As PromptSelectionResult = ed.SelectImplied()

            ' PickFirst 選択セットを取得できなかったときは、オブジェクトをオブジェクトを選択する
            If psr.Status <> PromptStatus.OK Then
                psr = ed.GetSelection()
            End If

            ' 何も選択されていなかったら、コマンドを終了する
            If psr.Status <> PromptStatus.OK Then
                Return
            End If

            ' ObjectIdCollection に選択したオブジェクトのオブジェクト ID を設定
            Dim objIdColl As New ObjectIdCollection(psr.Value.GetObjectIds())

            ' 選択したそれぞれのオブジェクトに対して実行
            For Each objId As ObjectId In objIdColl
                ' もし、寸法図形だったら、寸法スタイルを ACAD Vide に変更
                Dim ent As Entity = trans.GetObject(objId, OpenMode.ForRead)
                If TypeOf ent Is Dimension Then
                    Dim d1 As Dimension = ent

                    d1.UpgradeOpen()
                    d1.DimensionStyleName = "ACAD Video"
                End If
            Next

            trans.Commit()

        Catch ex As Autodesk.AutoCAD.Runtime.Exception
            Application.ShowAlertDialog(ex.Message)

        End Try
    End Using

End Sub
'--------------------------------------------------------

また、d1.DimensionStyleName = "ACAD Video" の代わりにこんな感じにしても OK でした。
'--------------------------------------------------------
Dim dimTbl As DimStyleTable = trans.GetObject(db.DimStyleTableId, OpenMode.ForRead)
Dim dimTblRec As DimStyleTableRecord = trans.GetObject(dimTbl("ACAD Video"), OpenMode.ForRead)

d1.DimensionStyle = dimTblRec.ObjectId
'--------------------------------------------------------

2010年12月19日日曜日

.NET - 現在の寸法スタイルを変更する/<優先スタイル> を破棄する(AutoCAD 2011)


今日は、.NET での寸法スタイルの変更についてです。

先日、<優先スタイル> を破棄したいといった質問をいただきました。

<優先スタイル> って知ってます?
例えば上の絵のように、現在の一部の設定(上の例では 「垂直方向の寸法値位置」(DIMTAD))が寸法スタイル(上の例では 「ACAD Video」)と違っているときに出てきます。

これをなくしたいってことなんですが、以下のようにやってもなくならないといった内容です。
db.Dimstyle = dimTblRec.ObjectId

※ db は Database、dimTblRec は DimStyleTableRecord
確かに、これを実行しても <優先スタイル> はなくなりませんでした。
なんででしょう???

いろいろ調べてみたんですが、<優先スタイル> ってどこにも覚えられていなみたいなんですよね。
どこかに覚えられていればそれを消せばいいかと思ってたんですが、それがどこにもなさそうなので、諦めかけてたんですが、やっと見つけました。

SetDimstyleData っていうのがあって、これを使うようです。
具体的にはこんな感じです。
'-----------------------------------------------------------------
Dim doc As Document = Application.DocumentManager.MdiActiveDocument
Dim db As Database = doc.Database

Using trans As Transaction = db.TransactionManager.StartTransaction
    Try
        Dim dimTbl As DimStyleTable = trans.GetObject(db.DimStyleTableId, OpenMode.ForRead)
        Dim dimTblRec As DimStyleTableRecord = trans.GetObject(dimTbl("ACAD Video"), OpenMode.ForRead)

        db.Dimstyle = dimTblRec.ObjectId
        db.SetDimstyleData(dimTblRec)

        trans.Commit()

    Catch ex As Autodesk.AutoCAD.Runtime.Exception
        Application.ShowAlertDialog(ex.Message)

    End Try
End Using
'-----------------------------------------------------------------

現在の寸法スタイルを変更するときもこれと同じで OK です。
(<優先スタイル> を破棄するときは、db.Dimstyle = dimTblRec.ObjectId がなくても OKです。)

なんで Dimstyle の設定だけではダメかというと、こういった理由になると思います。

DIM* といった寸法に関するシステム変数は、現在のデータベースに設定されています。
Dimstyle の設定を置き換えるように設定すると、現在の寸法スタイルは指定したものになりますが、他のシステム変数(例:DIMTAD など)は変わらずそのままです。
なので、<優先スタイル> も残ったままになります。

そのため、寸法スタイルの設定から、すべての DIM* というシステム変数を読み込む必要があります。
それをするのが SetDimstyleData ということです。