Private Shared _doc As Document
Private Shared _ids As New AcadDb.ObjectIdCollection()
Private Shared _pts As New Point3dCollection()
<CommandMethod("AddMOVEREACTOR")> _
Public Shared Sub AddReactor()
Dim _doc As Document = Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument
AddHandler _doc.CommandWillStart, AddressOf doc_CommandWillStart
End Sub
<CommandMethod("DelMOVEREACTOR")> _
Public Shared Sub delReactor()
Dim _doc As Document = Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument
RemoveHandler _doc.CommandWillStart, AddressOf doc_CommandWillStart
End Sub
Private Shared Sub doc_CommandWillStart(sender As Object, e As CommandEventArgs)
If e.GlobalCommandName = "MOVE" Then
_ids.Clear()
_pts.Clear()
AddHandler _doc.Database.ObjectOpenedForModify, AddressOf _db_ObjectOpenedForModify
AddHandler _doc.CommandCancelled, AddressOf _doc_CommandEnded
AddHandler _doc.CommandEnded, AddressOf _doc_CommandEnded
AddHandler _doc.CommandFailed, AddressOf _doc_CommandEnded
End If
End Sub
Private Shared Sub removeEventHandlers()
RemoveHandler _doc.CommandCancelled, AddressOf _doc_CommandEnded
RemoveHandler _doc.CommandEnded, AddressOf _doc_CommandEnded
RemoveHandler _doc.CommandFailed, AddressOf _doc_CommandEnded
RemoveHandler _doc.Database.ObjectOpenedForModify, AddressOf _db_ObjectOpenedForModify
End Sub
Private Shared Sub _doc_CommandEnded(sender As Object, e As CommandEventArgs)
' Remove database reactor before restoring positions
removeEventHandlers()
rollbackLocations()
End Sub
Private Shared Sub _db_ObjectOpenedForModify(sender As Object, e As ObjectEventArgs)
Dim AcBlock As AcadDb.BlockReference = TryCast(e.DBObject, AcadDb.BlockReference)
If AcBlock IsNot Nothing Then
' In AutoCAD 2007, OpenedForModify is called only
' once by MOVE.
' In 2008, OpenedForModify is called multiple
' times by the MOVE command ... we are only
' interested in the first call, because
' in the second one, the object location
' has already been changed:
If Not _ids.Contains(AcBlock.ObjectId) Then
_ids.Add(AcBlock.ObjectId)
_pts.Add(AcBlock.Position)
End If
End If
End Sub
Private Shared Sub rollbackLocations()
Debug.Assert(_ids.Count = _pts.Count, "Expected same number of ids and locations")
Dim t As Transaction = _doc.Database.TransactionManager.StartTransaction()
Dim AlgCmd As New Algemeen
Dim MyEd As Editor = Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument.Editor
Using t
Dim i As Integer = 0
For Each id As ObjectId In _ids
Dim AcBlock As AcadDb.BlockReference = TryCast(t.GetObject(id, OpenMode.ForWrite), AcadDb.BlockReference)
Dim OldInspnt As Point3d = _pts(System.Math.Max(System.Threading.Interlocked.Increment(i), i - 1))
' Calculate the horizontal distance between the points...
Dim Dist As Double = AlgCmd.DistanceBetween(New Point3d(OldInspnt.X, OldInspnt.Y, 0), New Point3d(AcBlock.Position.X, AcBlock.Position.Y, 0))
' Calculate the horizontal Angle betweeen the points...
Dim pt1 As Point2d = New Point2d(OldInspnt.X, OldInspnt.Y)
Dim pt2 As Point2d = New Point2d(AcBlock.Position.X, AcBlock.Position.Y)
Dim Angle As Double = pt1.GetVectorTo(pt2).Angle
Dim MyAccBlockHandle As String = AcBlock.Handle.ToString
' Kijk of er een Block is met een refentie naar het object...
Dim BlockIDs As AcadDb.ObjectIdCollection = AlgCmd.SelectAllBlockReferences()
'' Get the current document and database, and start a transaction
Dim acDoc As Document = Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument
Dim acCurDb As Database = acDoc.Database
Using acTrans As Transaction = acCurDb.TransactionManager.StartTransaction()
'' Open the Block table record for read
For Each ObjID As ObjectId In BlockIDs
Dim MyBlock As AcadDb.BlockReference = acTrans.GetObject(ObjID, OpenMode.ForWrite)
If MyBlock.Name.StartsWith("KST-") Then
Dim attCol As AttributeCollection = MyBlock.AttributeCollection
For Each attId As ObjectId In attCol
Dim attRef As AttributeReference = DirectCast(t.GetObject(attId, OpenMode.ForRead), AttributeReference)
If attRef.Tag = "REF-KST" Then
' Zet de string om in een list...
Dim AttList() As String = AlgCmd.StrToList(attRef.TextString, ";")
For Each StrItem As String In AttList
' Block Found... Calculate new position...
Dim NewBlkPosition As Point3d = AlgCmd.PolarPoints(MyBlock.Position, Angle, Dist)
MyBlock.Position = NewBlkPosition
End If
Next
End If
Next
End If
Next
acTrans.Commit()
End Using
Next
t.Commit()
End Using
End Sub
