---

Guten Tag,
Möchte ACad-Elemente relativ auf ein bestsimmtes Maß in vb.net verschieben. In VBA habe ich das über einen Dialog (Formular)
die x, y, z, - Verschiebung erledigt. Leider komme ich mit vb.net nicht zum Ziel.
Kann mir jemand helfen.
Besten Dank im Voraus
DrCNC

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hi,

>> Leider komme ich mit vb.net nicht zum Ziel.

Ein klein wenig mehr Input wäre vorteilhaft. Ich kann so jetzt nicht erkennen, ob Du ein Problem mit dem Formular hast, oder ein Problem mit dem Schieben, oder ein Problem, das Objekt zu selektieren, ....?

Zeig bitte beim nächsten mal den Code, den Du hast und markiere die Zeile oder den Bereich, der nicht funktioniert. Erkläre dabei auch, wieso es nicht funkt, z.B. weil Du Fehlermeldungen bekommst (dann auch 'welche') oder was Dir fehlt.

Nun mal, was ich schnell zusammengeschrieben hab, hoffe es hilft schon:

Code:

---

<Autodesk.AutoCAD.Runtime.CommandMethod("CADde_TransformBySample", Autodesk.AutoCAD.Runtime.CommandFlags.Session)> _
Public Shared Sub CADde_TransformBySample()
  Dim tAcadDoc As ApplicationServices.Document = ApplicationServices.Application.DocumentManager.MdiActiveDocument
  Dim tAcadDocLock As ApplicationServices.DocumentLock = Nothing
  Dim tTrAct As DatabaseServices.Transaction = Nothing
  Try
    Dim tMoveVec As Geometry.Vector3d = New Geometry.Vector3d(1, 1, 0)    'da setzt Du Deine relativen Koordinaten ein

    'zuerst Objekt selektieren
    Dim tSelRes As EditorInput.PromptSelectionResult = tAcadDoc.Editor.GetSelection()
    If (tSelRes.Status = EditorInput.PromptStatus.OK) AndAlso (tSelRes.Value.Count > 0) Then
      'dann sollten wir ein oder mehrere Elemente haben
      Dim tTransMat As Geometry.Matrix3d = Geometry.Matrix3d.Displacement(tMoveVec)
      tAcadDocLock = tAcadDoc.LockDocument
      tTrAct = tAcadDoc.TransactionManager.StartTransaction

      For Each tObjID As DatabaseServices.ObjectId In tSelRes.Value.GetObjectIds
        Dim tDbEnt As DatabaseServices.Entity = CType(tTrAct.GetObject(tObjID, DatabaseServices.OpenMode.ForWrite), DatabaseServices.Entity)
        tDbEnt.TransformBy(tTransMat)
      Next

      tTrAct.Commit()

    Else
      Call MsgBox("Keine Objekt(e) gewählt", vbOKOnly)
    End If

  Catch ex As Exception
    Call MsgBox("Fehler aufgetreten: " & vbNewLine & ex.Message, MsgBoxStyle.Critical)
  Finally
    If tTrAct IsNot Nothing Then tTrAct.Dispose() : tTrAct = Nothing
    If tAcadDocLock IsNot Nothing Then tAcadDocLock.Dispose() : tAcadDocLock = Nothing
  End Try
End Sub

---

- alfred -

------------------
www.hollaus.at

---

Grüß dich Alfred,
Besten Dank für deine rasche Anwort, funktioniert perfekt.
Ich habe dazu noch eine Frage.
Wenn ich die Koordinaten über ein Formular eingebe, steht nach Abschluß der Aktion in der Befehlszeile von Autocad nicht Befehl:
Wenn ich die Funktion ohne Formular aufrufe, dann steht es richtig in der Befehlszeile (Befehl

Hier der Code (von Dir)
Mit Formular kann ich die Koordinaten setzen und auch gleich schieben, ohne Formular gleich schieben. (Beim 3D-Zeichnen kann ich aus dem Grundriss mit dem Befehl >>klicken u. ziehen<< die Elemente erstellen und dann auf eine beliebige Stelle verschieben - zur besseren Übersicht)

Code:

---

Private Sub OK_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles OK.Click
        'Dim xx, yy, zz As Double
        xx = SchiebenX.Text
        yy = SchiebenY.Text
        zz = SchiebenZ.Text
        Me.Hide()
        Dim tAcadDoc As ApplicationServices.Document = ApplicationServices.Application.DocumentManager.MdiActiveDocument
        Dim tAcadDocLock As ApplicationServices.DocumentLock = Nothing
        Dim tTrAct As DatabaseServices.Transaction = Nothing
        Try
            Dim tMoveVec As Geometry.Vector3d = New Geometry.Vector3d(xx, yy, zz)    'da setzt Du Deine relativen Koordinaten ein
            'zuerst Objekt selektieren
            Dim tSelRes As EditorInput.PromptSelectionResult = tAcadDoc.Editor.GetSelection()
            If (tSelRes.Status = EditorInput.PromptStatus.OK) AndAlso (tSelRes.Value.Count > 0) Then
                'dann sollten wir ein oder mehrere Elemente haben
                Dim tTransMat As Geometry.Matrix3d = Geometry.Matrix3d.Displacement(tMoveVec)
                tAcadDocLock = tAcadDoc.LockDocument
                tTrAct = tAcadDoc.TransactionManager.StartTransaction

                For Each tObjID As DatabaseServices.ObjectId In tSelRes.Value.GetObjectIds
                    Dim tDbEnt As DatabaseServices.Entity = CType(tTrAct.GetObject(tObjID, DatabaseServices.OpenMode.ForWrite), DatabaseServices.Entity)
                    tDbEnt.TransformBy(tTransMat)
                Next
                tTrAct.Commit()
            Else
                Call MsgBox("Keine Objekt(e) gewählt", vbOKOnly)
            End If
        Catch ex As Exception
            Call MsgBox("Fehler aufgetreten: " & vbNewLine & ex.Message, MsgBoxStyle.Critical)
        Finally
            If tTrAct IsNot Nothing Then tTrAct.Dispose() : tTrAct = Nothing
            If tAcadDocLock IsNot Nothing Then tAcadDocLock.Dispose() : tAcadDocLock = Nothing
        End Try
    End Sub

    <Autodesk.AutoCAD.Runtime.CommandMethod("sss", Autodesk.AutoCAD.Runtime.CommandFlags.Session)> _
    Public Shared Sub CADde_TransformBySample()
        Dim tAcadDoc As ApplicationServices.Document = ApplicationServices.Application.DocumentManager.MdiActiveDocument
        Dim tAcadDocLock As ApplicationServices.DocumentLock = Nothing
        Dim tTrAct As DatabaseServices.Transaction = Nothing
        Try
            Dim tMoveVec As Geometry.Vector3d = New Geometry.Vector3d(xx, yy, zz)    'da setzt Du Deine relativen Koordinaten ein
            'zuerst Objekt selektieren
            Dim tSelRes As EditorInput.PromptSelectionResult = tAcadDoc.Editor.GetSelection()
            If (tSelRes.Status = EditorInput.PromptStatus.OK) AndAlso (tSelRes.Value.Count > 0) Then
                'dann sollten wir ein oder mehrere Elemente haben
                Dim tTransMat As Geometry.Matrix3d = Geometry.Matrix3d.Displacement(tMoveVec)
                tAcadDocLock = tAcadDoc.LockDocument
                tTrAct = tAcadDoc.TransactionManager.StartTransaction

                For Each tObjID As DatabaseServices.ObjectId In tSelRes.Value.GetObjectIds
                    Dim tDbEnt As DatabaseServices.Entity = CType(tTrAct.GetObject(tObjID, DatabaseServices.OpenMode.ForWrite), DatabaseServices.Entity)
                    tDbEnt.TransformBy(tTransMat)
                Next

                tTrAct.Commit()

            Else
                Call MsgBox("Keine Objekt(e) gewählt", vbOKOnly)
            End If

        Catch ex As Exception
            Call MsgBox("Fehler aufgetreten: " & vbNewLine & ex.Message, MsgBoxStyle.Critical)
        Finally
            If tTrAct IsNot Nothing Then tTrAct.Dispose() : tTrAct = Nothing
            If tAcadDocLock IsNot Nothing Then tAcadDocLock.Dispose() : tAcadDocLock = Nothing
        End Try
    End Sub

---

Besten Dank noch einmal
Johann

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hi,

>> Wenn ich die Koordinaten über ein Formular eingebe, steht nach Abschluß der Aktion
>>     in der Befehlszeile von Autocad nicht Befehl:
>> Wenn ich die Funktion ohne Formular aufrufe, dann steht es richtig in der Befehlszeile (Befehl 

Aus dem Formular wird auch kein Befehl gestartet, denn Du arbeitest in diesem Fall 'hinten herum' direkt in die Datenbank.

Willst Du, dass der Anwender im Befehlszeilenbereich sieht, dass etwas ausgeführt wird, dann kannst Du das auf zwei Arten erreichen:

a) Du führst die Objektänderung nicht im Form-Code aus, sonders startest von Form aus mit SendCommand (bzw. Alternativen) Deinen selbst erstellten Befehl.

b) Du schickst über COM oder über Invoke einen Prompt an die Befehlszeile

HTH, - alfred -

------------------
www.hollaus.at

---

Grüß dich Alfred,
Besten Dank für deine Hilfe, funktioniert bestens mit dem Befehl

Code:

---

ThisDrawing.SendCommand("sss" & vbCr)

---

Johann

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP