這個例子我們去年在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)

Public Class MyGrip

Inherits GripData

Private mGripNum As Integer

Public Property Ordinal() As Integer

Get

Return mGripNum

End Get

Set(ByVal value As Integer)

mGripNum = value

End Set

End Property

'Call this to tell the grip to move itself

Public Sub Move(ByVal vec As Vector3d)

GripPoint = GripPoint + vec

End Sub

'Grip draws itself

Public Overrides Function ViewportDraw(ByVal worldDraw As Autodesk.AutoCAD.GraphicsInterface.ViewportDraw, ByVal entityId As Autodesk.AutoCAD.DatabaseServices.ObjectId, ByVal type As Autodesk.AutoCAD.DatabaseServices.GripData.DrawType, ByVal imageGripPoint As Autodesk.AutoCAD.Geometry.Point3d?, ByVal gripSizeInPixels As Integer) As Boolean

Dim unit As Point2d = worldDraw.Viewport.GetNumPixelsInUnitSquare(GripPoint)

worldDraw.Geometry.Circle(GripPoint, 1.5 * gripSizeInPixels / unit.X, worldDraw.Viewport.ViewDirection)

Return True

End Function

End Class

'Array to hold our 3 grips

Dim mGripData(2) As GripData

Public Overrides Sub GetGripPoints(ByVal entity As Autodesk.AutoCAD.DatabaseServices.Entity, ByVal grips As Autodesk.AutoCAD.DatabaseServices.GripDataCollection, ByVal curViewUnitSize As Double, ByVal gripSize As Integer, ByVal curViewDir As Autodesk.AutoCAD.Geometry.Vector3d, ByVal bitFlags As Autodesk.AutoCAD.DatabaseServices.GetGripPointsFlags)

Dim rb As ResultBuffer = HelperClass.GetSingleton.GetXRecordData(entity)

'We assume entity is a line

Dim myLine As Line = entity

'Set grip positions to represent temperatures (we're using Celsius)

'min temperature

Dim temp As Integer = rb.AsArray(1).Value

Dim pos As Double = myLine.StartParam + (temp / 100) * (myLine.EndParam - myLine.StartParam)

Dim pt As Point3d = myLine.GetPointAtParameter(pos)

Dim grip As New MyGrip

grip.Ordinal = 0

grip.GripPoint = pt

mGripData(0) = grip

'max temperature

temp = rb.AsArray(2).Value

pos = myLine.StartParam + (temp / 100) * (myLine.EndParam - myLine.StartParam)

pt = myLine.GetPointAtParameter(pos)

grip = New MyGrip

grip.Ordinal = 1

grip.GripPoint = pt

mGripData(1) = grip

'current temperature

temp = rb.AsArray(3).Value

pos = myLine.StartParam + (temp / 100) * (myLine.EndParam - myLine.StartParam)

pt = myLine.GetPointAtParameter(pos)

grip = New MyGrip

grip.Ordinal = 2

grip.GripPoint = pt

mGripData(2) = grip

'Add our grips to the list

For Each g As MyGrip In mGripData

grips.Add(g)

Next

'Get the standard line grip points as well

MyBase.GetGripPoints(entity, grips, curViewUnitSize, gripSize, curViewDir, bitFlags)

End Sub

Public Overrides Sub MoveGripPointsAt(ByVal entity As Autodesk.AutoCAD.DatabaseServices.Entity, ByVal grips As Autodesk.AutoCAD.DatabaseServices.GripDataCollection, ByVal offset As Autodesk.AutoCAD.Geometry.Vector3d, ByVal bitFlags As Autodesk.AutoCAD.DatabaseServices.MoveGripPointsFlags)

'We only takeaction when we get this call on a database resident entity

'Dragging operation makes shallow clone of line, and setting clomeMeForDragging to false is generally a bad idea.

'(If you do set clone me for dragging to false, then don't call bae class overriden methods).

If entity.Id.IsValid Then

'Cast to a Line so we can access properties

Dim myLine As Line = entity

Dim lineDir As Vector3d = (myLine.EndPoint - myLine.StartPoint)

lineDir = lineDir.GetNormal 'Direction of Line

Dim offsetDist As Double = lineDir.DotProduct(offset) 'Component of mouse translation along like

'Iterate through list of all grips being moved

For Each g As GripData In grips

If TypeOf g Is MyGrip Then

Dim grip As MyGrip = g 'Cast to our grip type

'Make sure offset never takes grip beyond either end of line

If offsetDist >= 0 Then

If offsetDist > (myLine.EndPoint - grip.GripPoint).Length Then

offsetDist = (myLine.EndPoint - grip.GripPoint).Length

End If

Else

If -offsetDist > (myLine.StartPoint - grip.GripPoint).Length Then

offsetDist = -(myLine.StartPoint - grip.GripPoint).Length

End If

End If

lineDir = lineDir * offsetDist

'retrieve stored data and edit the changed value

Dim rb As ResultBuffer = HelperClass.GetSingleton.GetXRecordData(entity)

Dim val1 As String = rb.AsArray(0).Value

Dim intVal(2) As Integer

intVal(0) = rb.AsArray(1).Value 'min

intVal(1) = rb.AsArray(2).Value 'max

intVal(2) = rb.AsArray(3).Value 'current

'Tell grip to move itself long the line

grip.Move(lineDir)

'Calculate new temperature from grip position along the line

Dim newParam As Double = myLine.GetParameterAtPoint(grip.GripPoint)

Dim newTemp As Integer = 100 * (newParam - myLine.StartParam) / (myLine.EndParam - myLine.StartParam)

'Don't let min temp value rise above max temp

'And don't let max temp go below min temp

If grip.Ordinal = 0 Then

If newTemp < intVal(1) Then

intVal(0) = newTemp

Else

intVal(0) = intVal(1) - 1

End If

ElseIf grip.Ordinal = 1 Then

If newTemp > intVal(0) Then

intVal(1) = newTemp

Else

intVal(1) = intVal(0) + 1

End If

Else

intVal(2) = newTemp

End If

'Create new resbuf with new data and put back in Xrecord

Dim newRb As ResultBuffer = New ResultBuffer(New TypedValue(DxfCode.Text, val1), _

New TypedValue(DxfCode.Int32, intVal(0)), _

New TypedValue(DxfCode.Int32, intVal(1)), _

New TypedValue(DxfCode.Int32, intVal(2)))

HelperClass.GetSingleton.SetXRecordData(myLine, newRb)

End If

Next

End If

'Remove our grips from the list befroe calling base class function

'(Doesn't seem to like my grips)

For i As Integer = grips.Count - 1 To 0 Step -1

If TypeOf grips(i) Is MyGrip Then

grips.Remove(grips(i))

End If

Next

相關推薦