教你如何用VB.NET编写AutoCAD中的变色的温度计

这个例子我们去年在DevDays培训中介绍AutoCAD 2010 API的时候演示过，现在我把关键的代码贴上来。AutoCAD.NET API不支持自定义实体，但是有个叫overrule的技术，对于想用.net来实现自定义实体的用户来说，这个例子是个入门教程。

#Region "HelperClass"

 

'Global helper class (singleton). Contains central definitions of some global constants, and a few helper functions

Public Class HelperClass

    Const mExtDictName As String = "SGP_MyDict" 'Defines Dictionary name for the Extension Dictionary demo

    Const mXRecName As String = "SGP_MyDATA" 'Defines Dictionary name for the Extension Dictionary demo

 

    Private Shared mMe As HelperClass

 

    'Name of our dictionary in extension dictionary

    Public ReadOnly Property DictionaryName()

        Get

            Return mExtDictName

        End Get

    End Property

 

    'Name of our XRecord

    Public ReadOnly Property XRecordName()

        Get

            Return mXRecName

        End Get

    End Property

 

    'Protected constructor - to enforce singleton behavior

    Protected Sub New()

 

    End Sub

 

    'static function to retrieve one and only instance of singleton

    Shared ReadOnly Property GetSingleton()

        Get

            If mMe Is Nothing Then

                mMe = New HelperClass

            End If

            Return mMe

        End Get

    End Property

 

    'Retrieve data (as resbuf) from or Xrecord.

    'Returns null object if there's a problem

    Public Function GetXRecordData(ByVal obj As DBObject) As ResultBuffer

 

        Dim xRec As Xrecord = Nothing

        Dim id As ObjectId = obj.ExtensionDictionary

 

        'Make sure we have an ext dict befoore proceeding

        If id.IsValid Then

 

            'Retrieve data using a transaction

            Dim db As Database = Application.DocumentManager.MdiActiveDocument.Database

            Using tr As Transaction = db.TransactionManager.StartTransaction

 

                Dim extDict As DBDictionary = tr.GetObject(id, Autodesk.AutoCAD.DatabaseServices.OpenMode.ForRead, False)

                If extDict.Contains(DictionaryName) Then

                    'We're assuming that if my dictionary exists, then so will the XRecord in it.

                    Dim dictId As ObjectId = extDict.GetAt(DictionaryName)

                    Dim myDict As DBDictionary = tr.GetObject(dictId, Autodesk.AutoCAD.DatabaseServices.OpenMode.ForRead, False)

                    xRec = tr.GetObject(myDict.GetAt(XRecordName), Autodesk.AutoCAD.DatabaseServices.OpenMode.ForRead, False)

                End If

            End Using

        End If

        If xRec Is Nothing Then

            Return Nothing

        Else

            Return xRec.Data

        End If

    End Function

 

 

    'Modifies data in our XRecord.

    '(creates ou rdictionary and XRecoird if it doesn't already exist)

    Public Sub SetXRecordData(ByVal obj As DBObject, ByVal myData As ResultBuffer)

 

        Dim db As Database = Application.DocumentManager.MdiActiveDocument.Database

        Using tr As Transaction = db.TransactionManager.StartTransaction

 

            Dim myDict As DBDictionary

            Dim xRec As Xrecord = Nothing

 

            Dim id As ObjectId = obj.ExtensionDictionary

 

            If id = ObjectId.Null Then

                obj.CreateExtensionDictionary()

                id = obj.ExtensionDictionary

            End If

 

 

            Dim extDict As DBDictionary = tr.GetObject(id, Autodesk.AutoCAD.DatabaseServices.OpenMode.ForWrite, False)

 

            If extDict.Contains(DictionaryName) Then

                Dim dictId As ObjectId = extDict.GetAt(DictionaryName)

                myDict = tr.GetObject(dictId, Autodesk.AutoCAD.DatabaseServices.OpenMode.ForWrite, False)

            Else

                myDict = New DBDictionary

                extDict.SetAt(DictionaryName, myDict)

                tr.AddNewlyCreatedDBObject(myDict, True)

            End If

 

 

            If myDict.Contains(XRecordName) Then

                xRec = tr.GetObject(myDict.GetAt(XRecordName), Autodesk.AutoCAD.DatabaseServices.OpenMode.ForWrite, False)

            Else

                xRec = New Xrecord

                myDict.SetAt(XRecordName, xRec)

                tr.AddNewlyCreatedDBObject(xRec, True)

            End If

 

            xRec.Data = myData

            tr.Commit()

        End Using

    End Sub

End Class

 

 

#End Region

 

 

 

#Region "Simple Grip Overrule"

 

 

'Grip overrule to add our custom grips to the line

Public Class MyGripOverrule

    Inherits GripOverrule

 

    'Our custom grip class

    '(Could have derived one class for each grip, but we'll use member dara (Ordinal property) to distinguis grips instead)