Hi, I Would like to create a drawing from vb.net, and when it is drawn, i would like to move it to the place the user wants it to be in the drawing using a ghost-image on the mouse cursus
... i cannot get it to work, my head explodes..(rather new at .net, used to vba)
this is what i have at this point:
I have a drawing, in this examples just 2 rectangles, which are drawn by vb.net, and put in an arraylist.
this arraylist has to be dragged to another location in the drawing by the user.
I want to get an objectcollection in a selectionset (or if anyone has a better idea??)
kind regards Wouter de Haan
----
Public Class Drag
Dim OriPunt AsPoint3d = Point3d.Origin
<Autodesk.AutoCAD.Runtime.CommandMethod("MD")> PublicSub MoveDrawing()
'--- draw 2 rectangles and add them to a arraylist
Dim GroepBoven AsNewArrayList
GroepBoven.Add(Cad_Teken.Rechthoek(10, 10, 100, 100)) '(result is an object)
GroepBoven.Add(Cad_Teken.Rechthoek(20, 50, 150, 150))
ModelspaceAdd(GroepBoven)
EndSub
Sub DragSelection(ByVal Collectie AsObjectIdCollection)
???
Dim ss As SelectionSet = SelectionSet.FromObjectIds(Collectie)
ForEach id As ObjectId InCollectie
ss.add = SelectionSet.FromObjectIds(id)
Next
????
DragSelection(ss)
EndSub
Sub DragSelection(ByVal Objektid() AsObjectId)
' just drag one object (works)
Dim ss AsSelectionSet = SelectionSet.FromObjectIds(Objektid)
DragSelection(ss)
EndSub
Sub DragSelection(ByVal Selectieset AsSelectionSet)
Dim doc AsDocument = Application.DocumentManager.MdiActiveDocument
Dim db AsDatabase = doc.Database
Dim ed AsEditor = doc.Editor
Using tr AsTransaction = db.TransactionManager.StartTransaction
'---set de selectieset
ed.SetImpliedSelection(Selectieset)
'---bepaal bounding box en daarmee linkeronderhoek van selectie: NOG NIET GEDAAN
OriPunt = NewPoint3d(100, 100, 100)
'---Ask new location
Dim ppr As PromptPointResult = ed.Drag(Selectieset, vbLf & "Selecteer nieuwe locatie: ", New DragCallback(AddressOfMyDragCallback))
If (ppr.Status = PromptStatus.OK) Then
'--- Bepaal de translatiematrix
Dim mat AsMatrix3d = Matrix3d.Displacement(OriPunt.GetVectorTo(ppr.Value))
Dim currentSpace As BlockTableRecord = DirectCast(tr.GetObject(db.CurrentSpaceId, OpenMode.ForWrite), BlockTableRecord)
'--- Verplaats alle onderdelen in de selectieset
ForEach selectedObj As SelectedObject InSelectieset
Dim selectedEntity As Entity = DirectCast(tr.GetObject(selectedObj.ObjectId, OpenMode.ForWrite), Entity)
selectedEntity.TransformBy(mat)
Next'--- Bevestig de transactie
tr.Commit()
EndIf
EndUsing
EndSub
PrivateFunction MyDragCallback(ByVal pt As Point3d, ByRef mat As Matrix3d) AsSamplerStatus
If (OriPunt = pt) Then'--- Als er geen wijziging is gemaakt, dit meldenReturnSamplerStatus.NoChange
Else'---Anders de transformatiematrix maken voor de verplaatsing
mat = Matrix3d.Displacement(OriPunt.GetVectorTo(pt))
EndIf
ReturnSamplerStatus.OK
End Function
End Class
I just rewrote some parts of your code,
see if this will be working on your end
Imports Autodesk.AutoCAD.Runtime Imports Autodesk.AutoCAD.ApplicationServices Imports Autodesk.AutoCAD.DatabaseServices Imports Autodesk.AutoCAD.Geometry Imports Autodesk.AutoCAD.EditorInput Imports Autodesk.AutoCAD.ApplicationServices.Application <Assembly: CommandClass(GetType(Global.MyProject.Drag))> '<-- change address here Public Class Drag Dim OriPunt As Point3d = Point3d.Origin <Autodesk.AutoCAD.Runtime.CommandMethod("MD")> _ Public Sub MoveDrawing() '--- draw 2 rectangles and add them to a arraylist Dim GroepBoven() As ObjectId = New ObjectId(1) {} Dim id As ObjectId = CreateRectangle(New Point3d(0, 10, 0), New Point3d(100, 100, 0)) GroepBoven(0) = id id = CreateRectangle(New Point3d(10, 10, 0), New Point3d(200, 200, 0)) GroepBoven(1) = id Dim Selectieset As SelectionSet = SelectionSet.FromObjectIds(GroepBoven) DragSelection(Selectieset) End Sub Sub DragSelection(ByVal Selectieset As SelectionSet) Dim doc As Document = Application.DocumentManager.MdiActiveDocument Dim db As Database = doc.Database Dim ed As Editor = doc.Editor Using tr As Transaction = db.TransactionManager.StartTransaction '---set de selectieset ed.SetImpliedSelection(Selectieset) '---bepaal bounding box en daarmee linkeronderhoek van selectie: NOG NIET GEDAAN OriPunt = New Point3d(100, 100, 0) ''<--- point changed '---Ask new location Dim ppr As PromptPointResult = ed.Drag(Selectieset, vbLf & "Selecteer nieuwe locatie: ", New DragCallback(AddressOf MyDragCallback)) If (ppr.Status = PromptStatus.OK) Then '--- Bepaal de translatiematrix Dim mat As Matrix3d = Matrix3d.Displacement(OriPunt.GetVectorTo(ppr.Value)) Dim currentSpace As BlockTableRecord = DirectCast(tr.GetObject(db.CurrentSpaceId, OpenMode.ForWrite), BlockTableRecord) '--- Verplaats alle onderdelen in de selectieset For Each selectedObj As SelectedObject In Selectieset Dim selectedEntity As Entity = DirectCast(tr.GetObject(selectedObj.ObjectId, OpenMode.ForWrite), Entity) selectedEntity.TransformBy(mat) Next '--- Bevestig de transactie tr.Commit() End If End Using End Sub Private Function MyDragCallback(ByVal pt As Point3d, ByRef mat As Matrix3d) As SamplerStatus If (OriPunt = pt) Then '--- Als er geen wijziging is gemaakt, dit meldenReturnSamplerStatus.NoChange Else '---Anders de transformatiematrix maken voor de verplaatsing mat = Matrix3d.Displacement(OriPunt.GetVectorTo(pt)) End If Return SamplerStatus.OK End Function Public Function CreateRectangle(ByVal pt1 As Point3d, ByRef pt2 As Point3d) As ObjectId Dim doc As Document = Application.DocumentManager.MdiActiveDocument Dim db As Database = doc.Database Dim ed As Editor = doc.Editor Dim pline As New Polyline(4) Dim id As ObjectId = ObjectId.Null Using tr As Transaction = db.TransactionManager.StartTransaction Dim pts As New Point2dCollection() Dim p1 As Point2d = pt1.Convert2d(New Plane(Point3d.Origin, Vector3d.ZAxis)) Dim p2 As Point2d = pt2.Convert2d(New Plane(Point3d.Origin, Vector3d.ZAxis)) pts.Add(p1) pts.Add(New Point2d(p2.X, p1.Y)) pts.Add(p2) pts.Add(New Point2d(p1.X, p2.Y)) Dim i As Integer = 0 For Each pt In pts pline.AddVertexAt(i, pts(i), 0, 0, 0) i += 1 Next pline.Closed = True Dim btr As BlockTableRecord = tr.GetObject(db.CurrentSpaceId, OpenMode.ForWrite) id = btr.AppendEntity(pline) tr.AddNewlyCreatedDBObject(pline, True) tr.Commit() End Using Return id End Function End Class
~'J'~