---

Hallo an Alle,

eine Frage an die Profis. Gibt es eine unkomplizierte Methode einen Solid in den Hintergrund zu schieben. Die Hilfe ist mir dabei keine große Hilfe. Unten ist der Programmtext, wie ich ihn mit Hilfe der Hilfe bisher zusammen gestrickt habe. Aber jetzt komme ich nicht mehr weiter. Vielen dank im Vorraus.

Gruß, Theo

Public Sub Dreieck()
Dim mySolid As AcadSolid
    P0 = ThisDrawing.Utility.GetPoint(, "Erster Punkt:")
    P1 = ThisDrawing.Utility.GetPoint(, "Zweiter Punkt:")
    P2 = ThisDrawing.Utility.GetPoint(, "Dritter Punkt:")
    Set Mylayout = ThisDrawing.ActiveLayout.Block
    Set mySolid = Mylayout.AddSolid(P0, P1, P2, P2)
Dim eDictionary As Object
Set eDictionary = ThisDrawing.ModelSpace.GetExtensionDictionary
Dim sentityObj As Object
Set sentityObj = eDictionary.GetObject("ACAD_SORTENTS")
Set sentityObj = eDictionary.AddObject("ACAD_SORTENTS", "AcDbSortentsTable")
Ab hier geht leider nichts mehr
    sentityObj.MoveToBottom mySolid

End Sub

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

---

Hi,

der zweite Code in >>>diesem<<< Beitrag wär was für Dich?

Wenn nicht, bitte melden.

In Deinem Code bzgl. Ext.Dict.: nicht so unvorsichtig drüberfahren, sondern zuerst prüfen, ob es schon existiert oder nicht ==> DANN ERST handeln. Tust Du das nicht (einfach mit ADD drüber) dann gibt's zwei Möglichkeiten:

- Sofort ein Error
- Später mit '_audit' eine Menge gefundener Fehler

HTH, - alfred -

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

---

Hallo Alfred,

ich dachte es gibt eine einfachere Lösung. Egal, so geht es auch.
Ich bin mir zwar nicht sicher warum, aber der unten stehende Code funktioniert.

Danke, Theo

Public Sub Dreieck()
Dim mySolid As AcadSolid

    P0 = ThisDrawing.Utility.GetPoint(, "Erster Punkt:")
    P1 = ThisDrawing.Utility.GetPoint(, "Zweiter Punkt:")
    P2 = ThisDrawing.Utility.GetPoint(, "Dritter Punkt:")
    Set Mylayout = ThisDrawing.ActiveLayout.Block
    Set mySolid = Mylayout.AddSolid(P0, P1, P2, P2)

    NachUnten mySolid

End Sub

Public Sub NachUnten(Objekt As AcadObject)
Dim arr(0) As AcadObject
Dim eDictionary As Object
Dim sentityObj As Object

    Set eDictionary = ThisDrawing.ModelSpace.GetExtensionDictionary
    Set eDictionary = Mylayout.GetExtensionDictionary
        On Error Resume Next
        Set sentityObj = eDictionary.GetObject("ACAD_SORTENTS")
        If Err.Number <> 0 Then
            If sentityObj Is Nothing Then
                Set sentityObj = eDictionary.AddObject("ACAD_SORTENTS", "AcDbSortentsTable")
            End If
            Err.Clear
        End If
        On Error GoTo 0
    Set arr(0) = ThisDrawing.ObjectIdToObject(Objekt.ObjectID)
    sentityObj.MoveToBottom arr
End Sub

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