照着例子做了一个块的拖动：）

一个样

2. Imports System Imports Autodesk.AutoCAD.DatabaseServices Imports Autodesk.AutoCAD.Runtime Imports Autodesk.AutoCAD.Geometry Imports Autodesk.AutoCAD.ApplicationServices Imports System.Reflection Imports System.IO Imports System.Collections Imports System.Runtime.InteropServices Imports System.Diagnostics Imports Autodesk.AutoCAD.EditorInput Imports Autodesk.AutoCAD.GraphicsInterface Namespace
3.        TlsCad
4.           Public
5.        Class
6.        BlockRefJig
7.               Inherits EntityJig         Private mPosition As Point3d, mAnglePnt As Point3d         Private mNormal As Vector3d         Private mAngle As Double         Private mPromptCounter As Integer         Private m_dims As DynamicDimensionDataCollection                 Public
8.        Sub
9.        New(ByVal vec As Vector3d, ByVal id As ObjectId)             MyBase.New(New BlockReference(New Point3d(0, 0, 0), id))             mPosition = New Point3d(0, 0, 0)             mNormal = vec             mAngle = 0                         m_dims = New DynamicDimensionDataCollection()             Dim dim1 As Dimension = New AlignedDimension()             dim1.SetDatabaseDefaults()             m_dims.Add(New DynamicDimensionData(dim1, True, True))                         Dim dim2 As Dimension = New AlignedDimension()             dim2.SetDatabaseDefaults()                             m_dims.Add(New DynamicDimensionData(dim2, True, True))         End
10.        Sub
11.                       Protected
12.        Overloads
13.        Overrides
14.        Function Sampler(ByVal prompts As JigPrompts) As SamplerStatus             Dim jigOpts As
15.        New JigPromptOptions()             jigOpts.UserInputControls = (UserInputControls.Accept3dCoordinates Or UserInputControls.NoZeroResponseAccepted Or UserInputControls.NoNegativeResponseAccepted)                         If mPromptCounter = 0 Then
16.                       jigOpts.Message = "" & Chr(10) & "Input InsertPoint:"                 Dim dres As PromptPointResult = prompts.AcquirePoint(jigOpts)                                 Dim positionTemp As Point3d = dres.Value                 If positionTemp <> mPosition Then
17.                           mPosition = positionTemp                 Else
18.                           Return SamplerStatus.NoChange                 End
19.        If
20.                                       If dres.Status = PromptStatus.Cancel Then
21.                           Return SamplerStatus.Cancel                 Else
22.                           Return SamplerStatus.OK                                                         End
23.        If
24.       ElseIf mPromptCounter = 1 Then
25.                       jigOpts.BasePoint = mPosition                 jigOpts.UseBasePoint = True
26.                       jigOpts.Message = "" & Chr(10) & "Input Angle:"                 Dim angleTemp As Double = -1                 Dim res As PromptPointResult = prompts.AcquirePoint(jigOpts)                 mAnglePnt = res.Value                                 angleTemp = mAnglePnt.GetVectorTo(mPosition).AngleOnPlane(New Plane(Application.DocumentManager.MdiActiveDocument.Database.Ucsorg, Application.DocumentManager.MdiActiveDocument.Database.Ucsxdir, Application.DocumentManager.MdiActiveDocument.Database.Ucsydir))                                 If angleTemp <> mAngle Then
27.                           mAngle = angleTemp                 Else
28.                           Return SamplerStatus.NoChange                 End
29.        If
30.                                       If res.Status = PromptStatus.Cancel Then
31.                           Return SamplerStatus.Cancel                 Else
32.                           Return SamplerStatus.OK                                     End
33.        If
34.                   Else
35.                       Return SamplerStatus.NoChange             End
36.        If
37.                                       End
38.        Function
39.                       Protected
40.        Overloads
41.        Overrides
42.        Function Update() As Boolean                         Try
43.                       DirectCast(Entity, BlockReference).Position = mPosition                 DirectCast(Entity, BlockReference).Rotation = mAngle                                     UpdateDimensions()             Catch generatedExceptionName As System.Exception                 Return
44.        False
45.                   End
46.        Try
47.                               Return
48.        True
49.                           End
50.        Function
51.                       Protected
52.        Overloads
53.        Overrides
54.        Function GetDynamicDimensionData(ByVal dimScale As Double) As DynamicDimensionDataCollection             Return m_dims         End
55.        Function
56.               Protected
57.        Overloads
58.        Overrides
59.        Sub OnDimensionValueChanged(ByVal e As Autodesk.AutoCAD.DatabaseServices.DynamicDimensionChangedEventArgs)                     End
60.        Sub
61.               Private
62.        Sub UpdateDimensions()             Dim blkref As BlockReference = DirectCast(Entity, BlockReference)             If mPromptCounter = 0 Then
63.                       Dim dim1 As AlignedDimension = DirectCast(m_dims(0).Dimension, AlignedDimension)                 dim1.XLine1Point = blkref.Position                 dim1.DimLinePoint = blkref.Position             Else
64.                       Dim myellipse As Ellipse = DirectCast(Entity, Ellipse)                 Dim dim2 As AlignedDimension = DirectCast(m_dims(1).Dimension, AlignedDimension)                 dim2.XLine1Point = blkref.Position                 dim2.XLine2Point = mAnglePnt                 dim2.DimLinePoint = blkref.Position             End
65.        If
66.                           End
67.        Sub
68.               Public
69.        Sub setPromptCounter(ByVal i As Integer)             mPromptCounter = i         End
70.        Sub
71.               Public
72.        Function GetEntity() As Entity             Return Entity         End
73.        Function
74.               <CommandMethod("tjig")> _         Public
75.        Shared
76.        Sub DoIt()             Dim x As Vector3d = Application.DocumentManager.MdiActiveDocument.Database.Ucsxdir             Dim y As Vector3d = Application.DocumentManager.MdiActiveDocument.Database.Ucsydir             Dim NormalVec As Vector3d = x.CrossProduct(y)                         Using tm As
77.        New TlsTM(True)                                 Dim pbt As BlockTable = DirectCast(tm.AutoCadTM.GetObject(tm.Database.BlockTableId, OpenMode.ForRead, True), BlockTable)                 Dim jig As
78.        New BlockRefJig(NormalVec, pbt("1"))                 jig.setPromptCounter(0)                 Application.DocumentManager.MdiActiveDocument.Editor.Drag(jig)                 jig.setPromptCounter(1)                 Application.DocumentManager.MdiActiveDocument.Editor.Drag(jig)                                 tm.OpenBlockTableRecord(BlockTableRecord.ModelSpace)                 tm.Add(jig.GetEntity())             End
79.        Using
80.                                       End
81.        Sub
82.           End
83.        Class
84.               Public
85.        Class
86.        TlsTM
87.               Implements IDisposable         Private db As Database         Private tm As AutoCadTM         Private ta As Transaction         Private bt As BlockTable         Private btr As BlockTableRecord         Private IsStarted As Boolean = False
88.                       Public
89.        Sub
90.        New(ByVal Starting As Boolean)             If Starting Then
91.                       db = HostApplicationServices.WorkingDatabase                 tm = db.TransactionManager                 ta = tm.StartTransaction()             End
92.        If
93.                   IsStarted = Starting         End
94.        Sub
95.               Public
96.        ReadOnly
97.        Property Editor() As Editor             Get
98.                       Return Application.DocumentManager.MdiActiveDocument.Editor             End
99.        Get
100.               End
101.        Property
102.                       Public
103.        ReadOnly
104.        Property Database() As Database             Get
105.                       Return db             End
106.        Get
107.               End
108.        Property
109.                       Public
110.        ReadOnly
111.        Property AutoCadTM() As AutoCadTM             Get
112.                       Return tm             End
113.        Get
114.               End
115.        Property
116.                       Public
117.        ReadOnly
118.        Property Transaction() As Transaction             Get
119.                       Return ta             End
120.        Get
121.               End
122.        Property
123.                       Public
124.        ReadOnly
125.        Property BlockTable() As BlockTable             Get
126.                       Return bt             End
127.        Get
128.               End
129.        Property
130.                       Public
131.        ReadOnly
132.        Property BlockTableRecord() As BlockTableRecord             Get
133.                       Return btr             End
134.        Get
135.               End
136.        Property
137.               #Region "Add Entity"                 Public
138.        Function Add(ByVal entity As Entity) As ObjectId             Dim id As ObjectId = btr.AppendEntity(entity)             tm.AddNewlyCreatedDBObject(entity, True)             Return id         End
139.        Function
140.                       Public
141.        Function Add(ByVal objs As DBObjectCollection) As ObjectIdCollection             Dim ids As
142.        New ObjectIdCollection()             For
143.        Each obj As DBObject In objs                 ids.Add(Me.Add(DirectCast(obj, Entity)))             Next
144.                   Return ids         End
145.        Function
146.                       Public
147.        Function Add(ByVal objs As DBObject()) As ObjectIdCollection             Dim ids As
148.        New ObjectIdCollection()             For
149.        Each obj As DBObject In objs                 ids.Add(Me.Add(DirectCast(obj, Entity)))             Next
150.                   Return ids         End
151.        Function
152.                       #End Region                 #Region "Remove Entity"                 Public
153.        Function Remove(ByVal id As ObjectId) As Boolean             Dim obj As DBObject             Try
154.                       obj = tm.GetObject(id, OpenMode.ForWrite)                 obj.[Erase](True)             Catch
155.                       Return
156.        False
157.                   End
158.        Try
159.                   Return
160.        True
161.               End
162.        Function
163.                       Public
164.        Function Remove(ByVal ids As ObjectIdCollection) As Boolean             For
165.        Each id As ObjectId In ids                 Try
166.                           Dim obj As DBObject                     obj = tm.GetObject(id, OpenMode.ForWrite)                     obj.[Erase](True)                 Catch
167.                           Return
168.        False
169.                       End
170.        Try
171.                   Next
172.                   Return
173.        True
174.               End
175.        Function
176.                       Public
177.        Function Remove(ByVal ids As ObjectId()) As Boolean             For
178.        Each id As ObjectId In ids                 Try
179.                           Dim obj As DBObject                     obj = tm.GetObject(id, OpenMode.ForWrite)                     obj.[Erase](True)                 Catch
180.                           Return
181.        False
182.                       End
183.        Try
184.                   Next
185.                   Return
186.        True
187.               End
188.        Function
189.                       #End Region                 #Region "Trans"                 Public
190.        Sub OpenBlockTableRecord(ByVal str As String)             bt = DirectCast(tm.GetObject(db.BlockTableId, OpenMode.ForRead, False), BlockTable)             btr = DirectCast(tm.GetObject(bt(str), OpenMode.ForWrite, False), BlockTableRecord)         End
191.        Sub
192.                       Public
193.        Function GetObject(ByVal id As ObjectId, ByVal mode As OpenMode) As Entity             Return
194.        DirectCast(tm.GetObject(id, mode, True), Entity)         End
195.        Function
196.                       Private
197.        Sub Dispose() Implements IDisposable.Dispose             If IsStarted Then
198.                       ta.Commit()             End
199.        If
200.                   ta.Dispose()         End
201.        Sub
202.                       #End Region                 Public
203.        Sub RegApp(ByVal AppName As String)             Dim tbl As RegAppTable = DirectCast(tm.GetObject(db.RegAppTableId, OpenMode.ForWrite, False), RegAppTable)             If
204.        Not tbl.Has(AppName) Then
205.                       Dim app As
206.        New RegAppTableRecord()                 app.Name = AppName                 tbl.Add(app)                 tm.AddNewlyCreatedDBObject(app, True)             End
207.        If
208.               End
209.        Sub
210.           End
211.        Class
212.       End
213.        Namespace
214.       

Imports System Imports Autodesk.AutoCAD.DatabaseServices Imports Autodesk.AutoCAD.Runtime Imports Autodesk.AutoCAD.Geometry Imports Autodesk.AutoCAD.ApplicationServices Imports System.Reflection Imports System.IO Imports System.Collections Imports System.Runtime.InteropServices Imports System.Diagnostics Imports Autodesk.AutoCAD.EditorInput Imports Autodesk.AutoCAD.GraphicsInterface Namespace        TlsCad           Public        Class        BlockRefJig               Inherits EntityJig         Private mPosition As Point3d, mAnglePnt As Point3d         Private mNormal As Vector3d         Private mAngle As Double         Private mPromptCounter As Integer         Private m_dims As DynamicDimensionDataCollection                 Public        Sub        New(ByVal vec As Vector3d, ByVal id As ObjectId)             MyBase.New(New BlockReference(New Point3d(0, 0, 0), id))             mPosition = New Point3d(0, 0, 0)             mNormal = vec             mAngle = 0                         m_dims = New DynamicDimensionDataCollection()             Dim dim1 As Dimension = New AlignedDimension()             dim1.SetDatabaseDefaults()             m_dims.Add(New DynamicDimensionData(dim1, True, True))                         Dim dim2 As Dimension = New AlignedDimension()             dim2.SetDatabaseDefaults()                             m_dims.Add(New DynamicDimensionData(dim2, True, True))         End        Sub                       Protected        Overloads        Overrides        Function Sampler(ByVal prompts As JigPrompts) As SamplerStatus             Dim jigOpts As        New JigPromptOptions()             jigOpts.UserInputControls = (UserInputControls.Accept3dCoordinates Or UserInputControls.NoZeroResponseAccepted Or UserInputControls.NoNegativeResponseAccepted)                         If mPromptCounter = 0 Then                       jigOpts.Message = "" & Chr(10) & "Input InsertPoint:"                 Dim dres As PromptPointResult = prompts.AcquirePoint(jigOpts)                                 Dim positionTemp As Point3d = dres.Value                 If positionTemp <> mPosition Then                           mPosition = positionTemp                 Else                           Return SamplerStatus.NoChange                 End        If                                       If dres.Status = PromptStatus.Cancel Then                           Return SamplerStatus.Cancel                 Else                           Return SamplerStatus.OK                                                         End        If       ElseIf mPromptCounter = 1 Then                       jigOpts.BasePoint = mPosition                 jigOpts.UseBasePoint = True                       jigOpts.Message = "" & Chr(10) & "Input Angle:"                 Dim angleTemp As Double = -1                 Dim res As PromptPointResult = prompts.AcquirePoint(jigOpts)                 mAnglePnt = res.Value                                 angleTemp = mAnglePnt.GetVectorTo(mPosition).AngleOnPlane(New Plane(Application.DocumentManager.MdiActiveDocument.Database.Ucsorg, Application.DocumentManager.MdiActiveDocument.Database.Ucsxdir, Application.DocumentManager.MdiActiveDocument.Database.Ucsydir))                                 If angleTemp <> mAngle Then                           mAngle = angleTemp                 Else                           Return SamplerStatus.NoChange                 End        If                                       If res.Status = PromptStatus.Cancel Then                           Return SamplerStatus.Cancel                 Else                           Return SamplerStatus.OK                                     End        If                   Else                       Return SamplerStatus.NoChange             End        If                                       End        Function                       Protected        Overloads        Overrides        Function Update() As Boolean                         Try                       DirectCast(Entity, BlockReference).Position = mPosition                 DirectCast(Entity, BlockReference).Rotation = mAngle                                     UpdateDimensions()             Catch generatedExceptionName As System.Exception                 Return        False                   End        Try                               Return        True                           End        Function                       Protected        Overloads        Overrides        Function GetDynamicDimensionData(ByVal dimScale As Double) As DynamicDimensionDataCollection             Return m_dims         End        Function               Protected        Overloads        Overrides        Sub OnDimensionValueChanged(ByVal e As Autodesk.AutoCAD.DatabaseServices.DynamicDimensionChangedEventArgs)                     End        Sub               Private        Sub UpdateDimensions()             Dim blkref As BlockReference = DirectCast(Entity, BlockReference)             If mPromptCounter = 0 Then                       Dim dim1 As AlignedDimension = DirectCast(m_dims(0).Dimension, AlignedDimension)                 dim1.XLine1Point = blkref.Position                 dim1.DimLinePoint = blkref.Position             Else                       Dim myellipse As Ellipse = DirectCast(Entity, Ellipse)                 Dim dim2 As AlignedDimension = DirectCast(m_dims(1).Dimension, AlignedDimension)                 dim2.XLine1Point = blkref.Position                 dim2.XLine2Point = mAnglePnt                 dim2.DimLinePoint = blkref.Position             End        If                           End        Sub               Public        Sub setPromptCounter(ByVal i As Integer)             mPromptCounter = i         End        Sub               Public        Function GetEntity() As Entity             Return Entity         End        Function               <CommandMethod("tjig")> _         Public        Shared        Sub DoIt()             Dim x As Vector3d = Application.DocumentManager.MdiActiveDocument.Database.Ucsxdir             Dim y As Vector3d = Application.DocumentManager.MdiActiveDocument.Database.Ucsydir             Dim NormalVec As Vector3d = x.CrossProduct(y)                         Using tm As        New TlsTM(True)                                 Dim pbt As BlockTable = DirectCast(tm.AutoCadTM.GetObject(tm.Database.BlockTableId, OpenMode.ForRead, True), BlockTable)                 Dim jig As        New BlockRefJig(NormalVec, pbt("1"))                 jig.setPromptCounter(0)                 Application.DocumentManager.MdiActiveDocument.Editor.Drag(jig)                 jig.setPromptCounter(1)                 Application.DocumentManager.MdiActiveDocument.Editor.Drag(jig)                                 tm.OpenBlockTableRecord(BlockTableRecord.ModelSpace)                 tm.Add(jig.GetEntity())             End        Using                                       End        Sub           End        Class               Public        Class        TlsTM               Implements IDisposable         Private db As Database         Private tm As AutoCadTM         Private ta As Transaction         Private bt As BlockTable         Private btr As BlockTableRecord         Private IsStarted As Boolean = False                       Public        Sub        New(ByVal Starting As Boolean)             If Starting Then                       db = HostApplicationServices.WorkingDatabase                 tm = db.TransactionManager                 ta = tm.StartTransaction()             End        If                   IsStarted = Starting         End        Sub               Public        ReadOnly        Property Editor() As Editor             Get                       Return Application.DocumentManager.MdiActiveDocument.Editor             End        Get               End        Property                       Public        ReadOnly        Property Database() As Database             Get                       Return db             End        Get               End        Property                       Public        ReadOnly        Property AutoCadTM() As AutoCadTM             Get                       Return tm             End        Get               End        Property                       Public        ReadOnly        Property Transaction() As Transaction             Get                       Return ta             End        Get               End        Property                       Public        ReadOnly        Property BlockTable() As BlockTable             Get                       Return bt             End        Get               End        Property                       Public        ReadOnly        Property BlockTableRecord() As BlockTableRecord             Get                       Return btr             End        Get               End        Property               #Region "Add Entity"                 Public        Function Add(ByVal entity As Entity) As ObjectId             Dim id As ObjectId = btr.AppendEntity(entity)             tm.AddNewlyCreatedDBObject(entity, True)             Return id         End        Function                       Public        Function Add(ByVal objs As DBObjectCollection) As ObjectIdCollection             Dim ids As        New ObjectIdCollection()             For        Each obj As DBObject In objs                 ids.Add(Me.Add(DirectCast(obj, Entity)))             Next                   Return ids         End        Function                       Public        Function Add(ByVal objs As DBObject()) As ObjectIdCollection             Dim ids As        New ObjectIdCollection()             For        Each obj As DBObject In objs                 ids.Add(Me.Add(DirectCast(obj, Entity)))             Next                   Return ids         End        Function                       #End Region                 #Region "Remove Entity"                 Public        Function Remove(ByVal id As ObjectId) As Boolean             Dim obj As DBObject             Try                       obj = tm.GetObject(id, OpenMode.ForWrite)                 obj.[Erase](True)             Catch                       Return        False                   End        Try                   Return        True               End        Function                       Public        Function Remove(ByVal ids As ObjectIdCollection) As Boolean             For        Each id As ObjectId In ids                 Try                           Dim obj As DBObject                     obj = tm.GetObject(id, OpenMode.ForWrite)                     obj.[Erase](True)                 Catch                           Return        False                       End        Try                   Next                   Return        True               End        Function                       Public        Function Remove(ByVal ids As ObjectId()) As Boolean             For        Each id As ObjectId In ids                 Try                           Dim obj As DBObject                     obj = tm.GetObject(id, OpenMode.ForWrite)                     obj.[Erase](True)                 Catch                           Return        False                       End        Try                   Next                   Return        True               End        Function                       #End Region                 #Region "Trans"                 Public        Sub OpenBlockTableRecord(ByVal str As String)             bt = DirectCast(tm.GetObject(db.BlockTableId, OpenMode.ForRead, False), BlockTable)             btr = DirectCast(tm.GetObject(bt(str), OpenMode.ForWrite, False), BlockTableRecord)         End        Sub                       Public        Function GetObject(ByVal id As ObjectId, ByVal mode As OpenMode) As Entity             Return        DirectCast(tm.GetObject(id, mode, True), Entity)         End        Function                       Private        Sub Dispose() Implements IDisposable.Dispose             If IsStarted Then                       ta.Commit()             End        If                   ta.Dispose()         End        Sub                       #End Region                 Public        Sub RegApp(ByVal AppName As String)             Dim tbl As RegAppTable = DirectCast(tm.GetObject(db.RegAppTableId, OpenMode.ForWrite, False), RegAppTable)             If        Not tbl.Has(AppName) Then                       Dim app As        New RegAppTableRecord()                 app.Name = AppName                 tbl.Add(app)                 tm.AddNewlyCreatedDBObject(app, True)             End        If               End        Sub           End        Class       End        Namespace       

转换成vb.net

shirazbj

05年就写出来了。强呀。
学学，转换成个vb.net express 2010的。在2012下试试。

2.         Public Class BlockRefJig
   
3.             Inherits EntityJig
   
4.             Private mPosition As Point3d, mAnglePnt As Point3d
   
5.             Private mNormal As Vector3d
   
6.             Private mAngle As Double
   
7.             Private mPromptCounter As Integer
   
8.             Private m_dims As DynamicDimensionDataCollection
   
9.             Public Sub New(ByVal vec As Vector3d, ByVal id As ObjectId)
   
10.                 MyBase.New(New BlockReference(New Point3d(0, 0, 0), id))
    
11.                 mPosition = New Point3d(0, 0, 0)
    
12.                 mNormal = vec
    
13.                 mAngle = 0
    
14.                 m_dims = New DynamicDimensionDataCollection()
    
15.                 Dim dim1 As Dimension = New AlignedDimension()
    
16.                 dim1.SetDatabaseDefaults()
    
17.                 m_dims.Add(New DynamicDimensionData(dim1, True, True))
    
18.                 Dim dim2 As Dimension = New AlignedDimension()
    
19.                 dim2.SetDatabaseDefaults()
    
20.                 m_dims.Add(New DynamicDimensionData(dim2, True, True))
    
21.             End Sub
    
22. 
    
23.             Protected Overrides Function Sampler(ByVal prompts As JigPrompts) As SamplerStatus
    
24.                 'http://bbs.mjtd.com/forum.php?mod=viewthread&tid=39784&extra=page%3D1%26filter%3Dtypeid%26typeid%3D35&page=1
    
25. 
    
26.                 Dim jigOpts As New JigPromptPointOptions()
    
27.                 jigOpts.UserInputControls = (UserInputControls.Accept3dCoordinates Or UserInputControls.NoZeroResponseAccepted Or UserInputControls.NoNegativeResponseAccepted)
    
28. 
    
29.                 If mPromptCounter = 0 Then
    
30.                     jigOpts.Message = vbLf & "Input InsertPoint:"
    
31.                     Dim dres As PromptPointResult = prompts.AcquirePoint(jigOpts)
    
32. 
    
33.                     Dim positionTemp As Point3d = dres.Value
    
34.                     If positionTemp <> mPosition Then
    
35.                         mPosition = positionTemp
    
36.                     Else
    
37.                         Return SamplerStatus.NoChange
    
38.                     End If
    
39.                     If dres.Status = PromptStatus.Cancel Then
    
40.                         Return SamplerStatus.Cancel
    
41.                     Else
    
42.                         Return SamplerStatus.OK
    
43. 
    
44. 
    
45.                     End If
    
46.                 ElseIf mPromptCounter = 1 Then
    
47.                     jigOpts.BasePoint = mPosition
    
48.                     jigOpts.UseBasePoint = True
    
49.                     jigOpts.Message = vbLf & "Input Angle:"
    
50.                     Dim angleTemp As Double = -1
    
51.                     Dim res As PromptPointResult = prompts.AcquirePoint(jigOpts)
    
52.                     mAnglePnt = res.Value * Math.PI / 180.0
    
53. 
    
54. 
    
55.                     angleTemp = mAnglePnt.GetVectorTo(mPosition).AngleOnPlane(New Plane(Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument.Database.Ucsorg, Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument.Database.Ucsxdir, Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument.Database.Ucsydir))
    
56.                     If angleTemp <> mAngle Then
    
57.                         mAngle = angleTemp
    
58.                     Else
    
59.                         Return SamplerStatus.NoChange
    
60.                     End If
    
61. 
    
62.                     If res.Status = PromptStatus.Cancel Then
    
63.                         Return SamplerStatus.Cancel
    
64.                     Else
    
65.                         Return SamplerStatus.OK
    
66. 
    
67.                     End If
    
68.                 Else
    
69.                     Return SamplerStatus.NoChange
    
70.                 End If
    
71. 
    
72. 
    
73.             End Function
    
74. 
    
75.             Protected Overrides Function Update() As Boolean
    
76. 
    
77.                 Try
    
78.                     DirectCast(Entity, BlockReference).Position = mPosition
    
79.                     DirectCast(Entity, BlockReference).Rotation = mAngle
    
80. 
    
81.                     UpdateDimensions()
    
82.                 Catch generatedExceptionName As System.Exception
    
83.                     Return False
    
84.                 End Try
    
85. 
    
86.                 Return True
    
87.             End Function
    
88.             Protected Overrides Function GetDynamicDimensionData(ByVal dimScale As Double) As DynamicDimensionDataCollection
    
89.                 Return m_dims
    
90.             End Function
    
91.             Protected Overrides Sub OnDimensionValueChanged(ByVal e As Autodesk.AutoCAD.DatabaseServices.DynamicDimensionChangedEventArgs)
    
92. 
    
93.             End Sub
    
94.             Private Sub UpdateDimensions()
    
95.                 Dim blkref As BlockReference = DirectCast(Entity, BlockReference)
    
96.                 If mPromptCounter = 0 Then
    
97.                     Dim dim1 As AlignedDimension = DirectCast(m_dims(0).Dimension, AlignedDimension)
    
98.                     dim1.XLine1Point = blkref.Position
    
99.                     dim1.DimLinePoint = blkref.Position
    
100.                 Else
     
101.                     Dim myellipse As Ellipse = DirectCast(Entity, Ellipse)
     
102.                     Dim dim2 As AlignedDimension = DirectCast(m_dims(1).Dimension, AlignedDimension)
     
103.                     dim2.XLine1Point = blkref.Position
     
104.                     dim2.XLine2Point = mAnglePnt
     
105.                     dim2.DimLinePoint = blkref.Position
     
106.                 End If
     
107.             End Sub
     
108.             Public Sub setPromptCounter(ByVal i As Integer)
     
109.                 mPromptCounter = i
     
110.             End Sub
     
111.             Public Function GetEntity() As Entity
     
112.                 Return Entity
     
113.             End Function
     
114. 
     
115.             <CommandMethod("tjig")> _
     
116.             Public Shared Sub tjigDoIt()
     
117.                 Dim x As Vector3d = Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument.Database.Ucsxdir
     
118.                 Dim y As Vector3d = Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument.Database.Ucsydir
     
119.                 Dim NormalVec As Vector3d = x.CrossProduct(y)
     
120. 
     
121.                 Using tm As New TlsTM(True)
     
122. 
     
123.                     Dim pbt As BlockTable = DirectCast(tm.AutoCadTM.GetObject(tm.Database.BlockTableId, OpenMode.ForRead, True), BlockTable)
     
124.                     Dim jig As New BlockRefJig(NormalVec, pbt("1"))
     
125.                     jig.setPromptCounter(0)
     
126.                     Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument.Editor.Drag(jig)
     
127.                     jig.setPromptCounter(1)
     
128.                     Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument.Editor.Drag(jig)
     
129.                     tm.OpenBlockTableRecord(BlockTableRecord.ModelSpace)
     
130.                     tm.Add(jig.GetEntity())
     
131.                 End Using
     
132. 
     
133.             End Sub
     
134. 
     
135.         End Class
     
136. 
     
137.         Public Class TlsTM
     
138.             Implements IDisposable
     
139.             Private db As Database
     
140.             Private tm As DatabaseServices.TransactionManager
     
141.             Private ta As Transaction
     
142.             Private bt As BlockTable
     
143.             Private btr As BlockTableRecord
     
144.             Private IsStarted As Boolean = False
     
145.             Public Sub New(ByVal Starting As Boolean)
     
146.                 If Starting Then
     
147.                     Dim oDWG As Document = Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument
     
148. 
     
149.                     ' Get the database in the active drawing
     
150.                     db = oDWG.Database
     
151. 
     
152.                     ' Open a transaction so we can modify the drawing
     
153.                     tm = db.TransactionManager
     
154. 
     
155.                     'db = HostApplicationServices.WorkingDatabase
     
156.                     'tm = db.TransactionManager
     
157.                     ta = tm.StartTransaction()
     
158.                 End If
     
159.                 IsStarted = Starting
     
160.             End Sub
     
161. 
     
162.             Public ReadOnly Property Editor() As Editor
     
163.                 Get
     
164.                     Return Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument.Editor
     
165.                 End Get
     
166.             End Property
     
167.             Public ReadOnly Property Database() As Database
     
168.                 Get
     
169.                     Return db
     
170.                 End Get
     
171.             End Property
     
172.             Public ReadOnly Property AutoCadTM() As DatabaseServices.TransactionManager
     
173.                 Get
     
174.                     Return tm
     
175.                 End Get
     
176.             End Property
     
177.             Public ReadOnly Property Transaction() As Transaction
     
178.                 Get
     
179.                     Return ta
     
180.                 End Get
     
181.             End Property
     
182.             Public ReadOnly Property BlockTable() As BlockTable
     
183.                 Get
     
184.                     Return bt
     
185.                 End Get
     
186.             End Property
     
187.             Public ReadOnly Property BlockTableRecord() As BlockTableRecord
     
188.                 Get
     
189.                     Return btr
     
190.                 End Get
     
191.             End Property
     
192. 
     
193. #Region "Add Entity"
     
194.             Public Function Add(ByVal entity As Entity) As ObjectId
     
195.                 Dim id As ObjectId = btr.AppendEntity(entity)
     
196.                 tm.AddNewlyCreatedDBObject(entity, True)
     
197.                 Return id
     
198.             End Function
     
199.             Public Function Add(ByVal objs As DBObjectCollection) As ObjectIdCollection
     
200.                 Dim ids As New ObjectIdCollection()
     
201.                 For Each obj As DBObject In objs
     
202.                     ids.Add(Me.Add(DirectCast(obj, Entity)))
     
203.                 Next
     
204.                 Return ids
     
205.             End Function
     
206.             Public Function Add(ByVal objs As DBObject()) As ObjectIdCollection
     
207.                 Dim ids As New ObjectIdCollection()
     
208.                 For Each obj As DBObject In objs
     
209.                     ids.Add(Me.Add(DirectCast(obj, Entity)))
     
210.                 Next
     
211.                 Return ids
     
212.             End Function
     
213. #End Region
     
214. 
     
215. #Region "Remove Entity"
     
216.             Public Function Remove(ByVal id As ObjectId) As Boolean
     
217.                 Dim obj As DBObject
     
218.                 Try
     
219.                     obj = tm.GetObject(id, OpenMode.ForWrite)
     
220.                     obj.[Erase](True)
     
221.                 Catch
     
222.                     Return False
     
223.                 End Try
     
224.                 Return True
     
225.             End Function
     
226.             Public Function Remove(ByVal ids As ObjectIdCollection) As Boolean
     
227.                 For Each id As ObjectId In ids
     
228.                     Try
     
229.                         Dim obj As DBObject
     
230.                         obj = tm.GetObject(id, OpenMode.ForWrite)
     
231.                         obj.[Erase](True)
     
232.                     Catch
     
233.                         Return False
     
234.                     End Try
     
235.                 Next
     
236.                 Return True
     
237.             End Function
     
238.             Public Function Remove(ByVal ids As ObjectId()) As Boolean
     
239.                 For Each id As ObjectId In ids
     
240.                     Try
     
241.                         Dim obj As DBObject
     
242.                         obj = tm.GetObject(id, OpenMode.ForWrite)
     
243.                         obj.[Erase](True)
     
244.                     Catch
     
245.                         Return False
     
246.                     End Try
     
247.                 Next
     
248.                 Return True
     
249.             End Function
     
250. #End Region
     
251. 
     
252. #Region "Trans"
     
253.             Public Sub OpenBlockTableRecord(ByVal str As String)
     
254.                 bt = DirectCast(tm.GetObject(db.BlockTableId, OpenMode.ForRead, False), BlockTable)
     
255.                 btr = DirectCast(tm.GetObject(bt(str), OpenMode.ForWrite, False), BlockTableRecord)
     
256.             End Sub
     
257.             Public Function GetObject(ByVal id As ObjectId, ByVal mode As OpenMode) As Entity
     
258.                 Return DirectCast(tm.GetObject(id, mode, True), Entity)
     
259.             End Function
     
260.             Private Sub IDisposable_Dispose() Implements IDisposable.Dispose
     
261.                 If IsStarted Then
     
262.                     ta.Commit()
     
263.                 End If
     
264.                 ta.Dispose()
     
265.             End Sub
     
266. #End Region
     
267. 
     
268.             Public Sub RegApp(ByVal AppName As String)
     
269.                 Dim tbl As RegAppTable = DirectCast(tm.GetObject(db.RegAppTableId, OpenMode.ForWrite, False), RegAppTable)
     
270.                 If Not tbl.Has(AppName) Then
     
271.                     Dim app As New RegAppTableRecord()
     
272.                     app.Name = AppName
     
273.                     tbl.Add(app)
     
274.                     tm.AddNewlyCreatedDBObject(app, True)
     
275.                 End If
     
276.             End Sub
     
277. 
     
278.         End Class
     

        Public Class BlockRefJig<br />             Inherits EntityJig<br />             Private mPosition As Point3d, mAnglePnt As Point3d<br />             Private mNormal As Vector3d<br />             Private mAngle As Double<br />             Private mPromptCounter As Integer<br />             Private m_dims As DynamicDimensionDataCollection<br />             Public Sub New(ByVal vec As Vector3d, ByVal id As ObjectId)<br />                 MyBase.New(New BlockReference(New Point3d(0, 0, 0), id))<br />                 mPosition = New Point3d(0, 0, 0)<br />                 mNormal = vec<br />                 mAngle = 0<br />                 m_dims = New DynamicDimensionDataCollection()<br />                 Dim dim1 As Dimension = New AlignedDimension()<br />                 dim1.SetDatabaseDefaults()<br />                 m_dims.Add(New DynamicDimensionData(dim1, True, True))<br />                 Dim dim2 As Dimension = New AlignedDimension()<br />                 dim2.SetDatabaseDefaults()<br />                 m_dims.Add(New DynamicDimensionData(dim2, True, True))<br />             End Sub<br /> <br />             Protected Overrides Function Sampler(ByVal prompts As JigPrompts) As SamplerStatus<br />                 'http://bbs.mjtd.com/forum.php?mod=viewthread&tid=39784&extra=page%3D1%26filter%3Dtypeid%26typeid%3D35&page=1<br /> <br />                 Dim jigOpts As New JigPromptPointOptions()<br />                 jigOpts.UserInputControls = (UserInputControls.Accept3dCoordinates Or UserInputControls.NoZeroResponseAccepted Or UserInputControls.NoNegativeResponseAccepted)<br /> <br />                 If mPromptCounter = 0 Then<br />                     jigOpts.Message = vbLf & "Input InsertPoint:"<br />                     Dim dres As PromptPointResult = prompts.AcquirePoint(jigOpts)<br /> <br />                     Dim positionTemp As Point3d = dres.Value<br />                     If positionTemp <> mPosition Then<br />                         mPosition = positionTemp<br />                     Else<br />                         Return SamplerStatus.NoChange<br />                     End If<br />                     If dres.Status = PromptStatus.Cancel Then<br />                         Return SamplerStatus.Cancel<br />                     Else<br />                         Return SamplerStatus.OK<br /> <br /> <br />                     End If<br />                 ElseIf mPromptCounter = 1 Then<br />                     jigOpts.BasePoint = mPosition<br />                     jigOpts.UseBasePoint = True<br />                     jigOpts.Message = vbLf & "Input Angle:"<br />                     Dim angleTemp As Double = -1<br />                     Dim res As PromptPointResult = prompts.AcquirePoint(jigOpts)<br />                     mAnglePnt = res.Value * Math.PI / 180.0<br /> <br /> <br />                     angleTemp = mAnglePnt.GetVectorTo(mPosition).AngleOnPlane(New Plane(Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument.Database.Ucsorg, Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument.Database.Ucsxdir, Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument.Database.Ucsydir))<br />                     If angleTemp <> mAngle Then<br />                         mAngle = angleTemp<br />                     Else<br />                         Return SamplerStatus.NoChange<br />                     End If<br /> <br />                     If res.Status = PromptStatus.Cancel Then<br />                         Return SamplerStatus.Cancel<br />                     Else<br />                         Return SamplerStatus.OK<br /> <br />                     End If<br />                 Else<br />                     Return SamplerStatus.NoChange<br />                 End If<br /> <br /> <br />             End Function<br /> <br />             Protected Overrides Function Update() As Boolean<br /> <br />                 Try<br />                     DirectCast(Entity, BlockReference).Position = mPosition<br />                     DirectCast(Entity, BlockReference).Rotation = mAngle<br /> <br />                     UpdateDimensions()<br />                 Catch generatedExceptionName As System.Exception<br />                     Return False<br />                 End Try<br /> <br />                 Return True<br />             End Function<br />             Protected Overrides Function GetDynamicDimensionData(ByVal dimScale As Double) As DynamicDimensionDataCollection<br />                 Return m_dims<br />             End Function<br />             Protected Overrides Sub OnDimensionValueChanged(ByVal e As Autodesk.AutoCAD.DatabaseServices.DynamicDimensionChangedEventArgs)<br /> <br />             End Sub<br />             Private Sub UpdateDimensions()<br />                 Dim blkref As BlockReference = DirectCast(Entity, BlockReference)<br />                 If mPromptCounter = 0 Then<br />                     Dim dim1 As AlignedDimension = DirectCast(m_dims(0).Dimension, AlignedDimension)<br />                     dim1.XLine1Point = blkref.Position<br />                     dim1.DimLinePoint = blkref.Position<br />                 Else<br />                     Dim myellipse As Ellipse = DirectCast(Entity, Ellipse)<br />                     Dim dim2 As AlignedDimension = DirectCast(m_dims(1).Dimension, AlignedDimension)<br />                     dim2.XLine1Point = blkref.Position<br />                     dim2.XLine2Point = mAnglePnt<br />                     dim2.DimLinePoint = blkref.Position<br />                 End If<br />             End Sub<br />             Public Sub setPromptCounter(ByVal i As Integer)<br />                 mPromptCounter = i<br />             End Sub<br />             Public Function GetEntity() As Entity<br />                 Return Entity<br />             End Function<br /> <br />             <CommandMethod("tjig")> _<br />             Public Shared Sub tjigDoIt()<br />                 Dim x As Vector3d = Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument.Database.Ucsxdir<br />                 Dim y As Vector3d = Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument.Database.Ucsydir<br />                 Dim NormalVec As Vector3d = x.CrossProduct(y)<br /> <br />                 Using tm As New TlsTM(True)<br /> <br />                     Dim pbt As BlockTable = DirectCast(tm.AutoCadTM.GetObject(tm.Database.BlockTableId, OpenMode.ForRead, True), BlockTable)<br />                     Dim jig As New BlockRefJig(NormalVec, pbt("1"))<br />                     jig.setPromptCounter(0)<br />                     Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument.Editor.Drag(jig)<br />                     jig.setPromptCounter(1)<br />                     Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument.Editor.Drag(jig)<br />                     tm.OpenBlockTableRecord(BlockTableRecord.ModelSpace)<br />                     tm.Add(jig.GetEntity())<br />                 End Using<br /> <br />             End Sub<br /> <br />         End Class<br /> <br />         Public Class TlsTM<br />             Implements IDisposable<br />             Private db As Database<br />             Private tm As DatabaseServices.TransactionManager<br />             Private ta As Transaction<br />             Private bt As BlockTable<br />             Private btr As BlockTableRecord<br />             Private IsStarted As Boolean = False<br />             Public Sub New(ByVal Starting As Boolean)<br />                 If Starting Then<br />                     Dim oDWG As Document = Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument<br /> <br />                     ' Get the database in the active drawing<br />                     db = oDWG.Database<br /> <br />                     ' Open a transaction so we can modify the drawing<br />                     tm = db.TransactionManager<br /> <br />                     'db = HostApplicationServices.WorkingDatabase<br />                     'tm = db.TransactionManager<br />                     ta = tm.StartTransaction()<br />                 End If<br />                 IsStarted = Starting<br />             End Sub<br /> <br />             Public ReadOnly Property Editor() As Editor<br />                 Get<br />                     Return Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument.Editor<br />                 End Get<br />             End Property<br />             Public ReadOnly Property Database() As Database<br />                 Get<br />                     Return db<br />                 End Get<br />             End Property<br />             Public ReadOnly Property AutoCadTM() As DatabaseServices.TransactionManager<br />                 Get<br />                     Return tm<br />                 End Get<br />             End Property<br />             Public ReadOnly Property Transaction() As Transaction<br />                 Get<br />                     Return ta<br />                 End Get<br />             End Property<br />             Public ReadOnly Property BlockTable() As BlockTable<br />                 Get<br />                     Return bt<br />                 End Get<br />             End Property<br />             Public ReadOnly Property BlockTableRecord() As BlockTableRecord<br />                 Get<br />                     Return btr<br />                 End Get<br />             End Property<br /> <br /> #Region "Add Entity"<br />             Public Function Add(ByVal entity As Entity) As ObjectId<br />                 Dim id As ObjectId = btr.AppendEntity(entity)<br />                 tm.AddNewlyCreatedDBObject(entity, True)<br />                 Return id<br />             End Function<br />             Public Function Add(ByVal objs As DBObjectCollection) As ObjectIdCollection<br />                 Dim ids As New ObjectIdCollection()<br />                 For Each obj As DBObject In objs<br />                     ids.Add(Me.Add(DirectCast(obj, Entity)))<br />                 Next<br />                 Return ids<br />             End Function<br />             Public Function Add(ByVal objs As DBObject()) As ObjectIdCollection<br />                 Dim ids As New ObjectIdCollection()<br />                 For Each obj As DBObject In objs<br />                     ids.Add(Me.Add(DirectCast(obj, Entity)))<br />                 Next<br />                 Return ids<br />             End Function<br /> #End Region<br /> <br /> #Region "Remove Entity"<br />             Public Function Remove(ByVal id As ObjectId) As Boolean<br />                 Dim obj As DBObject<br />                 Try<br />                     obj = tm.GetObject(id, OpenMode.ForWrite)<br />                     obj.[Erase](True)<br />                 Catch<br />                     Return False<br />                 End Try<br />                 Return True<br />             End Function<br />             Public Function Remove(ByVal ids As ObjectIdCollection) As Boolean<br />                 For Each id As ObjectId In ids<br />                     Try<br />                         Dim obj As DBObject<br />                         obj = tm.GetObject(id, OpenMode.ForWrite)<br />                         obj.[Erase](True)<br />                     Catch<br />                         Return False<br />                     End Try<br />                 Next<br />                 Return True<br />             End Function<br />             Public Function Remove(ByVal ids As ObjectId()) As Boolean<br />                 For Each id As ObjectId In ids<br />                     Try<br />                         Dim obj As DBObject<br />                         obj = tm.GetObject(id, OpenMode.ForWrite)<br />                         obj.[Erase](True)<br />                     Catch<br />                         Return False<br />                     End Try<br />                 Next<br />                 Return True<br />             End Function<br /> #End Region<br /> <br /> #Region "Trans"<br />             Public Sub OpenBlockTableRecord(ByVal str As String)<br />                 bt = DirectCast(tm.GetObject(db.BlockTableId, OpenMode.ForRead, False), BlockTable)<br />                 btr = DirectCast(tm.GetObject(bt(str), OpenMode.ForWrite, False), BlockTableRecord)<br />             End Sub<br />             Public Function GetObject(ByVal id As ObjectId, ByVal mode As OpenMode) As Entity<br />                 Return DirectCast(tm.GetObject(id, mode, True), Entity)<br />             End Function<br />             Private Sub IDisposable_Dispose() Implements IDisposable.Dispose<br />                 If IsStarted Then<br />                     ta.Commit()<br />                 End If<br />                 ta.Dispose()<br />             End Sub<br /> #End Region<br /> <br />             Public Sub RegApp(ByVal AppName As String)<br />                 Dim tbl As RegAppTable = DirectCast(tm.GetObject(db.RegAppTableId, OpenMode.ForWrite, False), RegAppTable)<br />                 If Not tbl.Has(AppName) Then<br />                     Dim app As New RegAppTableRecord()<br />                     app.Name = AppName<br />                     tbl.Add(app)<br />                     tm.AddNewlyCreatedDBObject(app, True)<br />                 End If<br />             End Sub<br /> <br />         End Class<br />