.NET

Reply
Valued Contributor
wbdehaan
Posts: 64
Registered: ‎11-01-2001
Message 1 of 2 (435 Views)

Create Objects and then replace them with userinput

435 Views, 1 Replies
04-27-2012 12:55 AM

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

*Expert Elite*
Hallex
Posts: 1,569
Registered: ‎10-08-2008
Message 2 of 2 (411 Views)

Re: Create Objects and then replace them with userinput

04-29-2012 03:50 AM in reply to: wbdehaan

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

_____________________________________
C6309D9E0751D165D0934D0621DFF27919

You are not logged in.

Log into access your profile, ask and answer questions, share ideas and more. Haven't signed up yet? Register

Announcements
Are you familiar with the Autodesk Expert Elites? The Expert Elite program is made up of customers that help other customers by sharing knowledge and exemplifying an engaging style of collaboration. To learn more, please visit our Expert Elite website.

Need installation help?

Start with some of our most frequented solutions to get help installing your software.

Ask the Community