Create Objects and then replace them with userinput

[wbdehaan]

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

[Hallex]

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'~