---

Kann mir jemand helfen. Ich finde einfach meinen Fehler nicht.
Die Blockreferenz wird korrekt mit den Werten erzeugt aber nicht dem aktuellen Arbeitsbereich hinzugefügt. Es kommt keine Fehlermeldung, das blöde Ding ist einfach nicht da.

Die Parameter sehen bspw. folgerndermaßen aus "7710", new Point3D(10,10,10,),1,1,1 und eine Collection eben

Code:

---

        ' Funktion um eine Blockreferenz von der ausgewählten Blockdefinition anzulegen
        '  - Legt eine Blockreferenz in der angegebenen Skalierung an der übergebenen Position an und trägt die Attribute ein
        '  - Gibt NOTHING zurück wenn erfolgreich, ansonsten die aufgetretene Exception
        Public Function createBlockReference(ByVal name As String, ByVal position As Point3d, ByVal scaleX As Double, ByVal scaleY As Double, ByVal scaleZ As Double, ByVal attributes As Dictionary(Of String, String)) As Exception

            ' Überprüfen ob eine Blockdefinition mit dem übergebenem Namen existiert
            If Not (checkBlockExistence(name)) Then
                ' Beenden der Funktion
                Return New Exception(ErrorStatus.CreateFailed, "Blockdefiniton für den Block '" & name & "' nicht in der Zeichnung vorhanden")
            End If

            ' Anlegen eines Transaktionsobjektes um auf die Zeichnungsdatenbank zugreifen zu können
            Dim trans As Transaction = Application.DocumentManager.MdiActiveDocument.Database.TransactionManager.StartTransaction
            Try
                ' Öffnen des aktuellen Arbeitsbereiches - Schreibrechte
                Dim currentWorkspace As BlockTableRecord = trans.GetObject(Application.DocumentManager.MdiActiveDocument.Database.CurrentSpaceId, OpenMode.ForWrite)
                ' Öffnen der Zeichnungsdatenbank - Leserechte
                Dim blockTable As BlockTable = Application.DocumentManager.MdiActiveDocument.Database.BlockTableId.GetObject(OpenMode.ForRead)
                ' Öffnen der Blockdefintion - Leserechte
                Dim blockDef As BlockTableRecord = trans.GetObject(blockTable(name), OpenMode.ForRead)

                ' Anlegen der neuen Blockreferenz
                Dim blockRef As New BlockReference(position, blockTable(name))
                blockRef.ScaleFactors = New Scale3d(scaleX, scaleY, scaleZ)
                currentWorkspace.AppendEntity(blockRef)
                trans.AddNewlyCreatedDBObject(blockRef, True)

                ' Übertragen der Attribute aus der Blockdefinition
                Dim attributeCol As AttributeCollection = blockRef.AttributeCollection
                For Each attributeID In blockDef
                    ' Öffnen des Elementes aus der Blockdefinition
                    Dim entity As Entity = attributeID.GetObject(OpenMode.ForRead)
                    ' Wenn es eine AttributDefinition ist
                    If (TypeOf entity Is AttributeDefinition) Then
                        Dim attributeDef As AttributeDefinition = entity
                        Dim attributeRef As New AttributeReference
                        attributeRef.SetAttributeFromBlock(attributeDef, blockRef.BlockTransform)
                        ' Prüfen ob in den übergebenen Attributen das aktuelle vorhanden ist
                        If (attributes.ContainsKey(attributeRef.Tag)) Then
                            attributeRef.TextString = attributes.Item(attributeRef.Tag)
                        End If
                        blockRef.AttributeCollection.AppendAttribute(attributeRef)
                        trans.AddNewlyCreatedDBObject(attributeRef, True)
                    End If
                Next

                trans.Commit()

                ' Beenden der Funktion
                Return Nothing

            ' Abfangen eines evtl. auftretenden Fehlers
            Catch ex As Exception
                Return ex

            ' Schließen der Transaktion mit der Datenbank
            Finally
                trans.Dispose()
            End Try

        End Function

---

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

---

Hi,

[EDIT] QUATSCH geschrieben, ich hab's zurückgenommen und teste neu [/EDIT]

Darf ich noch ein paar Äußerungen treffen:
Wenn Du Option Strict aktivieren würdest, würden Typkonflikte sofort auffallen. Das bedeutet natürlich, dass Du öfter  tryCast  oder  cType  verwenden musst, aber dann tauchen weniger Probleme im Ablauf auf.

Gib mal dort, wo Du Deine Bemerkungen eingegeben hast (1 Zeile über dem Funktionsheader) folgendes ein
'''
(tasächlich, 3 mal einfache Hochkomma) ==> da kommst Du in den internen Modus der Dokumention, diese Form der Headerbeschreibung wird Dir dann auch angezeigt, wenn Du die Funktion aufrufen willst und gerade den Funktionsnamen in eine Programmzeile schreibst. Du siehst diese Info dann wie einen Tooltip.

Statt:
Return New Exception(ErrorStatus.CreateFailed, "...")
probier mal
Throw New Exception(....
Damit landest Du im übergeordneten Code gleich in der Fehlerbehandlung und musst nicht den Returnwert dafür mißbrauchen.

Ist, was mir jetzt mal beim Lesen aufgefallen ist, hoffe es hilft Dir.

- alfred -

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

---

Hi,

nochmals sorry für meine erste Version (vor der Korrektur), ich predige den ganzen Tag den Unterschied zwischen BlockReference und Blockdefinition vor und dann mach ich selbst Unsinn.

Ich habe:
- die Funktion  checkBlockExistence(name)  ausgebaut, denn ich habe sie nicht
- eine verkürzte Version basierend auf Deinen Code nachgebaut (verkürzt bedeutet hier mal Kommentare raus, Attributsübergabe/die Dictionary raus) und dann ein Objekt tAcadObject angelegt, um nicht jedesmal durch den ganzen Applicationservices.Application.... durchzumüssen (kostet auch Zeit).

Damit bin ich auch folgenden Code gekommen:

Code:

---

   Public Shared Function CADde_BlockRefInsert(ByVal name As String, ByVal position As Geometry.Point3d, ByVal scaleX As Double, ByVal scaleY As Double, ByVal scaleZ As Double) As Exception
      Dim tAcadDoc As ApplicationServices.Document = Nothing
      Dim trans As Transaction = Nothing
      Try
         tAcadDoc = Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument
         trans = tAcadDoc.TransactionManager.StartTransaction
         Dim currentWorkspace As BlockTableRecord = CType(trans.GetObject(tAcadDoc.Database.CurrentSpaceId, OpenMode.ForWrite), DatabaseServices.BlockTableRecord)
         Dim blockTable As BlockTable = CType(tAcadDoc.Database.BlockTableId.GetObject(OpenMode.ForRead), BlockTable)
         Dim blockDef As BlockTableRecord = CType(trans.GetObject(blockTable(name), OpenMode.ForRead), BlockTableRecord)

         Dim blockRef As BlockReference = New BlockReference(position, blockTable(name))
         blockRef.ScaleFactors = New Geometry.Scale3d(scaleX, scaleY, scaleZ)
         currentWorkspace.AppendEntity(blockRef)
         trans.AddNewlyCreatedDBObject(blockRef, True)

         Dim attributeCol As AttributeCollection = blockRef.AttributeCollection
         For Each attributeID As ObjectId In blockDef
            Dim entity As DBObject = attributeID.GetObject(OpenMode.ForRead)
            If (TypeOf entity Is AttributeDefinition) Then
               Dim attributeDef As AttributeDefinition = CType(entity, DatabaseServices.AttributeDefinition)
               Dim attributeRef As AttributeReference = New AttributeReference
               attributeRef.SetAttributeFromBlock(attributeDef, blockRef.BlockTransform)
               attributeRef.TextString = attributeRef.Tag   'das hab ich jetzt mal der Einfachheit geändert
               blockRef.AttributeCollection.AppendAttribute(attributeRef)
               trans.AddNewlyCreatedDBObject(attributeRef, True)
            End If
         Next

         trans.Commit()
         Return Nothing
      Catch ex As Exception
         Return ex
      Finally
         trans.Dispose()
      End Try
   End Function

---

...und der läuft bei mir.

Und nachdem ich jetzt schon fleißig am umschreiben war, folgende Gefahrenpunkte:
trans.GetObject(blockTable(name), OpenMode.ForRead)
==> da kannst Du das Problem haben, hast Du in Deiner Zeichnung mal _PURGE durchgeführt oder eine Blockdefinition gelöscht, kann es Dir mit diesem Code passieren, dass Du mit  blocktable(name)  eine ObjectID eines Blocktablerecords bekommst, die als 'gelöscht' markiert ist ==> und damit geht auch kein Einfügen mehr.

Kein DocumentLock:
Wenn Du einen Befehl startest, und dessen Funktionsattribute das Sperren des Documents vorgeben, dann OK. Rufst Du aber Deine Proc z.B. von einem Formular auf oder von einer ToolPalette, also anders als durch einen definierten Befehl, dann schwirrt Dir AutoCAD ab, weil das locken des Documents dann notwendig ist.

Ansonsten funktioniert dieser Code bei mir, also wird mal durchsteppen notwendig sein und bei jeder Zeile beobachten, wie die Variablen gesetzt werden.

Viel Erfolg, - alfred -

PS: doch noch was, auch wenn ich's nicht erklären kann  , aber es mich schon mehrmals gewürfelt hat:
Dim X as New Collection
ist nicht gleich wie
Dim X as Collection = New Collection

Bei der ersten Variante hat der GarbageCollector ein Problem mit der Bereinigung, daher immer den längeren zweiten Syntax wählen.

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

---

Ich hab meinen Fehler gefunden. Ich hatte noch eine andere Transaktion offen und die nach dem Einfügen des Blockes erst geschlossen. Vielleicht hat er die eine Transaktion mit dem Einfügen der Blockreferenz einfach überschrieben.
Auf jedenfall ist der Block jetzt da mit einem Mix aus unseren beiden Quellcodes die aber ja eigentlich gar nicht so verschieden waren.

Zu deinen Anmerkungen:
Vielleicht solltest du ein Buch über AutoCAD-Programmierung schreiben, mein Buch"VB.NET Programing for AutoCAD Customization" ist eher nicht so toll. Hier lern ich doch mehr

- Option Strict hab ich aus, option Explicit ist an. Wenn doch mal ein Fehler beim nicht expliciten Typcasting mit CType auftritt fang ich den ja mit dem try...catch ab

- Wie würdest du das Problem mit dem trans.GetObject(blockTable(name)) und dem _purge lösen? Ich hab ja vorher einen Funktionsaufruf der Prüft ob der Name der Blockdefinition in der Zeichnung vorhanden ist. Müsste ich dort vorher auch isErased prüfen?

- Meine Funktionen werden von einer anderen Methode aus aufgerufen die per definiertem Befehl über die Kommandozeile, Toolbar oder Menu aufgerufen werden.

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

---

Hi,

>> Müsste ich dort vorher auch isErased prüfen?

Yes, und eigentlich bei allen SymbolTableRecords, also z.B. Blockdefinitionen, Layer, Bemassungsstile, Textstile, ....

>> Wie würdest du das Problem mit dem trans.GetObject(blockTable(name))

Ich hab bei mir eine Funktion, die mir eine ObjectID des SymbolTableRecords retourniert (z.B. einen BlockTableRecord der wie bei Dir über Name abgefragt wird).

In dieser Routine schau ich, wie Du nach:
1) mit xxx.Has ==> ob es einen solchen Namen überhaupt gibt
2) mit xxx.Item(Name) ==> für diesen, ob die ObjectID (xxx.isValid) andalso (NOT xxx.isErased) ergibt
2a) wenn voriges nicht gelöscht ist, dann retourniere ich diese ID
2b) wenn doch gelöscht, dann musst Du durch die ganze Table durchscannen, per Name vergleichen und solange scannen, bis entweder die Table keinen weiteren Eintrag mehr hat oder ein TableRecord mit dem gesuchten Namen gefunden wird, dessen Prüfung (Punkt 2) positiv ausfällt.

>> Option Strict hab ich aus, option Explicit ist an.
>> Wenn doch mal ein Fehler beim nicht expliciten Typcasting mit
>> CType auftritt fang ich den ja mit dem try...catch ab

Ja schon, der Code muss aber dann mit LateBinding arbeiten und das ist von Haus aus langsamer.
Dazu kommt, dass Du ev. sogar einen gültigen Wert zurückbekommst (wenn Du mit TransAction ein Objekt holst), aber nach dem Catch erwartest, dass das Objekt eine Linie ist, aber ein Kreis zurückkam. Auf dieses lass ich mich nie (in Worten NIE) ein und bilde mir zumindest ein, gut damit zu fahren.

- alfred -

PS: Vielleicht solltest du ein Buch über AutoCAD-Programmierung schreiben

Ich denk schon drüber nach, die zu erwartende Auflage ist aber noch das Problem. 

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

---

2.jpg

Ok, werde meine Einwände zu Herzen nehmen, zumindest das mit isErased

Ein Buch würd ich wahrscheinlich sofort nehmen

Aber leider ist meine Blockreferenz doch nicht da, obwohl ich in komplett deinen Quellcode verwende. Einmal waren Attribute da, weiß aber nicht warum

Das hier ist der Code der die Funktion aufruft. Vorher wurden nur Daten gesammelt. Keine Transaktion offen oder sonst irgendwas. Ach ja VermPoint ist ein Punkt der auch noch Daten beinhalten kann, der kann seine Position als Point3D zurückgeben sowie seine Attribute

Code:

---

        ' Funktion um die Höhe eines Punktes auf eine Polylinie zu übertragen
        '  - Fügt am Lotfusspunkt des übergebenen Punktes zur Polylinie eine Blockreferenz ein
        '  - Gibt TRUE zurück wenn erfolgreich, ansonsten FALSE
        Private Function blockHeightCarryOver(ByVal polylineID As ObjectId, ByVal point As VermPoint) As Boolean

            Dim editor As Editor = Application.DocumentManager.MdiActiveDocument.Editor

            ' Anlegen eines Transaktionsobjektes um auf die Zeichnungsdatenbank zugreifen zu können
            Dim trans As Transaction = Application.DocumentManager.MdiActiveDocument.Database.TransactionManager.StartTransaction

            Dim pointOnCurve As Point3d = Nothing
            Try
                ' Holen des Curve-Objektes - Leserechte
                Dim curve As Curve = CType(trans.GetObject(polylineID, OpenMode.ForRead), Curve)

                ' Abfragen des dichtesten Punktes der Blockreferenz zum Curve-Objekt
                pointOnCurve = curve.GetClosestPointTo(point.getVermPointAsPoint3D, True)

            ' Abfangen eines evtl. aufgetretenen Fehlers
            Catch ex As Exception
                editor.WriteMessage(ControlChars.CrLf & "Fehler beim beim Berechnen des Lotfußpunktes" & ControlChars.CrLf & ex.Message & ControlChars.CrLf & "Funktion: blockHeightCarryOver(ByVal polylineID As ObjectId, ByVal point As VermPoint) As Boolean")
                ' Beenden der Funktion
                Return False

            ' Schließen der Transaktion mit der Datenbank
            Finally
                trans.Dispose()
            End Try

            ' Aufruf der Funktion um eine neue Blockreferenz anzulegen
            Dim exception As Exception = LaOs_AutoCAD_Werkzeuge.Functions.createBlockReference(BLOCKNAME, pointOnCurve, 1, 1, 1, point.getAttributesAsDictionary(False))
            If Not IsNothing(exception) Then
                editor.WriteMessage(ControlChars.CrLf & "Fehler beim beim Erstellen der Blockreferenz" & ControlChars.CrLf & exception.Message & ControlChars.CrLf & "Funktion: createBlockReference(ByVal name As String, ByVal position As Point3d, ByVal scaleX As Double, ByVal scaleY As Double, ByVal scaleZ As Double, ByVal attributes As Dictionary(Of String, String)) As Exception")
                ' Beenden der Funktion
                Return False
            Else
              ' Funktion wurde erfolgreich ausgeführt
                Return True
            End If

        End Function

---

Überwachung der blockRef im Anhang

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

---

Hi,

alles hab ich jetzt nicht angesehen, offensichtliches seh ich nicht, brauch ein bisschen.

- alfred -

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

---

Hi,

vielleicht sehe ich es nur nicht, wenn Deine Blockdefinition nur aus Attributsdefinitionen besteht, dann würde mir im Code fehlen (zumindest sehe ich es nicht), wo die Dictionary-Einträge für die Blockwerte gesetzt werden.

Damit kann es sein, dass Dein Block plaziert wird, alle Attribute leer sind und deswegen (wenn die Blockdefinition eben keine Geometrie hat) nur nicht sichtbar ist. Probier mal mit Schnellauswahl, ob die Blockreferenz nicht doch erzeugt wurde.

- alfred -

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

---

Zeichnung1.rar

Ich häng meine Testzeichnugn auch mal an. In Blockname steht 4440, sprich der einzige Block in der Zeichnung.

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

---

Hi,

ok, der in der Zeichnung definiert Block kann sich also nicht verstecken, hat Geometrie drin und damit muss dieser auch sichtbar sein, wenn keine Attributswerte ausgefüllt sind.

Die Funktion  blockHeightCarryOver  wird von irgendwo aufgerufen, ist da eine Transaction aktiv? Verschachtelte Transactions könnten auch noch ein Punkt sein, da kannst Du in den untergeordneten commiten, was Du willst, wird die oberste Transaction nicht mit .commit bestätigt, ist das Ergebnis fraglich.

Im Code kann ich leider nichts offensichtliches feststellen. 

Siehe PM

- alfred -

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

---

Keine Transkation ansonsten aktiv. Hier mal das komplette Modul das über das Menu per Befehl aufgerufen wird

Code:

---

Option Explicit On

' ###################################################################################################
' #                                                                                                #
' #  Methoden um anhand einer Messungslinie orthogonale Punkte zu konstruieren                    #
' #  Der Benutzer kann auswählen ob die orthogonalen Punkte die anhand von Abszisse und Ordinate  #
' #  eingegeben werden durch Punkte, Kreise oder Linienverbindungen dargestellt werden sollen      #
' #                                                                                                #
' #  Funktionen                                                                                    #
' #    - createIntersectionWithPolyline()                                                          #
' #                                                                                                #
' #    - setLastPunktNr() As Exception                                                            #
' #                                                                                                #
' #  Stand: 02.03.2009                                                                            #
' ###################################################################################################

Imports Autodesk.AutoCAD.ApplicationServices
Imports Autodesk.AutoCAD.DatabaseServices
Imports Autodesk.AutoCAD.EditorInput
Imports Autodesk.AutoCAD.Geometry
Imports Autodesk.AutoCAD.Runtime

' Verringern der Ladezeit beim Kompilieren
<Assembly: CommandClass(GetType(LaOs_AutoCAD_Werkzeuge.SmallTools.createIntersectionWithPolyline))>

Namespace LaOs_AutoCAD_Werkzeuge.SmallTools
    Module createIntersectionWithPolyline

        ' Konstante für den Blocknamen der für die konstruierten Punkte verwendet wird
        Private Const BLOCKNAME As String = "4440"

        ' Variable für die nächste freie Punktnummer
        Dim lastPunktNR As Long = Nothing

        ' Variable ob Höhen bzw. welche Höhen exportiert werden sollen - Vorgabe: exportHeightModes.BlockattributHoehen
        Dim heightMode As exportHeightModes = exportHeightModes.BlockattributHoehen

        ' Aufruf der Methode über 'createIntersectionWithPolyline' möglich
        ' Methode um die Höhen von Blöcken auf eine Polylinie zu übertragen
        '  - Prüfen ob die Blockdefinition für die konstruierten Punkte existiert
        '  - Bestimmen der letzten verwendeten Punktnummer
        '  - Auswahl der Polylinie und des Höhenmoduses
        '  - Endlosschleife zur Auswahl der Blöcke für die Schnittberechnung
        <CommandMethod("createIntersectionWithPolyline")> _
        Public Sub createIntersectionWithPolyline()

            Dim editor As Editor = Application.DocumentManager.MdiActiveDocument.Editor

            '---------------------------------------------------------------
            ' Prüfen ob die Blockdefinition für die konstruierten Punkte existiert
            '---------------------------------------------------------------

            If Not (LaOs_AutoCAD_Werkzeuge.Functions.checkBlockExistence(BLOCKNAME)) Then
                editor.WriteMessage(ControlChars.CrLf & "Keine Blockdefinition für den Block '" & BLOCKNAME & "' gefunden" & ControlChars.CrLf & "Bitte legen Sie ihn vor dem Neustart des Programmes an")
                ' Beenden der Methode
                Exit Sub
            End If

            '---------------------------------------------------------------
            ' Bestimmen der letzten verwendeten Punktnummer
            '---------------------------------------------------------------

            Dim exception As Exception = setLastPunktNr()
            ' Fehler beim Bestimmen der letzten verwendeten Punktnummer
            If Not IsNothing(exception) Then
                editor.WriteMessage(ControlChars.CrLf & "Fehler beim Bestimmen der letzten verwendeten Punktnummer" & ControlChars.CrLf & exception.Message & ControlChars.CrLf & "Funktion: setLastPunktNr() As Exception")
                ' Beenden der Methode
                Exit Sub
            ' Wenn keine Punktnummer im Bereich bis 91000 mehr frei ist
            ElseIf (lastPunktNR = 90999) Then
                editor.WriteMessage(ControlChars.CrLf & "Keine freie Punktnummer mehr verfügbar" & ControlChars.CrLf & "Alle Punktnummern im Bereich 90001 bis 90999 bereits vergeben")
                ' Beenden der Methode
                Exit Sub
            End If

            '---------------------------------------------------------------
            ' Auswahl der Polylinie
            '---------------------------------------------------------------

            ' Polylinien auch auf gesperrten Layern
            Dim getPolylineOptions As New PromptEntityOptions(ControlChars.CrLf & "Bitte die Polylinie auswählen: ")
            getPolylineOptions.SetRejectMessage(ControlChars.CrLf & "Es sind nur Polylinien erlaubt")
            ' Alle 3 Typen von unterstützten Polylinien
            getPolylineOptions.AddAllowedClass(GetType(Polyline), False)
            getPolylineOptions.AddAllowedClass(GetType(Polyline2d), False)
            getPolylineOptions.AddAllowedClass(GetType(Polyline3d), False)
            getPolylineOptions.AllowObjectOnLockedLayer = True

            ' Auswahl der Polylinie durch den Benutzer
            Dim getPolylineResult As PromptEntityResult = editor.GetEntity(getPolylineOptions)

            ' Abbruch der Methode durch den Benutzer
            If (getPolylineResult.Status = PromptStatus.Cancel) Then
                ' Beenden der Methode
                Exit Sub
            ' Ungültige Eingabe des Benutzers
            ElseIf Not (getPolylineResult.Status = PromptStatus.OK) Then
                editor.WriteMessage(ControlChars.CrLf & "Keine gültige Polyline ausgewählt")
                ' Beenden der Methode
                Exit Sub
            End If

            '---------------------------------------------------------------
            ' Abfrage des Höhenmodus
            '---------------------------------------------------------------

            ' Schlüsselwörter (ObjektHoehen, BlockattributHoehen) und leere Eingabe
            Dim getHeightModeOptions As New PromptKeywordOptions(ControlChars.CrLf & "Welche Höhen sollen verwendet werden: <" & [Enum].GetName(GetType(exportHeightModes), heightMode) & ">")
            getHeightModeOptions.AllowNone = True
            ' Objekthoehen und Blockattributhoehen
            getHeightModeOptions.Keywords.Add([Enum].GetName(GetType(exportHeightModes), exportHeightModes.ObjektHoehen))
            getHeightModeOptions.Keywords.Add([Enum].GetName(GetType(exportHeightModes), exportHeightModes.BlockattributHoehen))

          ' Auswahl des Höhenmodus durch den Benutzer
            Dim getHeightModeResult As PromptResult = editor.GetKeywords(getHeightModeOptions)

            ' Abbruch der Methode durch den Benutzer
            If (getHeightModeResult.Status = PromptStatus.Cancel) Then
                ' Beenden der Methode
                Exit Sub
            ' Nichts ausgewählt -> Behalten des alten Wertes
            ElseIf (getHeightModeResult.Status = PromptStatus.None) Then
                ' Nothing
            ' Falsche Eingabe vom Benutzer
            ElseIf Not (getHeightModeResult.Status = PromptStatus.OK) Then
                editor.WriteMessage(ControlChars.CrLf & "Sie haben kein gültiges Schlüsselwort eingegeben.")
                ' Beenden der Methode
                Exit Sub
            ' Eingabe eines Keywords
            Else
                ' Speichern des ausgewählten Moduses
                For Each i In [Enum].GetValues(GetType(exportHeightModes))
                    If ([Enum].GetName(GetType(exportHeightModes), i) = getHeightModeResult.StringResult) Then
                        heightMode = i
                        ' Abbruch der Schleife
                        Exit For
                    End If
                Next
            End If

            ' Warnung keine Punktkoordinaten von Hand einzugeben falls nicht im WCS
            If (System.Convert.ToInt16(Application.GetSystemVariable("WORLDUCS")) <> 1) Then
                MsgBox("Sie befinden Sich nicht im Weltkoordinatensystem" & ControlChars.CrLf & ControlChars.CrLf & "Punktkoordinaten die durch die Tastatur eingegeben werden führen höchstwahrscheinlich zu falschen Ergebnissen", MsgBoxStyle.Information, "Tastaturpunkteingaben führen zu falschen Ergebnissen")
            End If

            '---------------------------------------------------------------
            ' Endlosschleife
            '---------------------------------------------------------------

            While True
                ' Wenn keine Punktnummer im Bereich bis 91000 mehr frei ist
                If (lastPunktNR = 69999) Then
                    editor.WriteMessage(ControlChars.CrLf & "Keine freie Punktnummer mehr verfügbar" & ControlChars.CrLf & "Alle Punktnummern im Bereich 60001 bis 60999 bereits vergeben")
                    ' Beenden der Methode
                    Exit Sub
                End If

                '---------------------------------------------------------------
                ' Endlosschleife für die Auswahl des ersten Blockes
                '---------------------------------------------------------------

                ' Variablen für den ersten Block
                Dim positionFirstBlock As Point3d = Nothing
                Dim firstBlock As VermPoint = Nothing

                ' Bis ein gültiger erster Block ausgewählt wurde
                While True

                    ' Nur Punkte
                    Dim getFirstPointOptions As New PromptPointOptions(ControlChars.CrLf & "Bitte den Einfügepunkt des ersten Blockes auswählen: ")

                    ' Auswahl des ersten Punktes durch den Benutzer
                    Dim getFirstPointResult As PromptPointResult = editor.GetPoint(getFirstPointOptions)

                    ' Abbruch der Methode durch den Benutzer
                    If (getFirstPointResult.Status = PromptStatus.Cancel) Then
                        ' Beenden der Methode
                        Exit Sub
                    ' Falsche Eingabe vom Benutzer
                    ElseIf Not (getFirstPointResult.Status = PromptStatus.OK) Then
                        editor.WriteMessage(ControlChars.CrLf & "Sie haben keinen gültigen Einfügepunkt ausgewählt.")
                        ' Beenden der Methode
                        Exit Sub
                  ' Gültiger Punkt
                    Else
                        '---------------------------------------------------------------
                        ' Überprüfen ob ein Block an der ausgewählten Stelle liegt
                        '---------------------------------------------------------------

                        Dim blockIDs As New ObjectIdCollection
                        exception = LaOs_AutoCAD_Werkzeuge.Functions.getBlockReferencesOnPoint(getFirstPointResult.Value.TransformBy(editor.CurrentUserCoordinateSystem), 0.001, blockIDs)
                        ' Fehler beim Bestimmen des Blockes an der ausgewählten Stelle
                        If Not IsNothing(exception) Then
                            editor.WriteMessage(ControlChars.CrLf & "Fehler beim beim Bestimmen des Blockes am ausgewählten Punkt" & ControlChars.CrLf & exception.Message & ControlChars.CrLf & "Funktion: getBlockReferencesOnPoint(ByVal point As Point3d, ByVal tolerance As Double, ByRef blockIDs As ObjectIdCollection) As Exception")
                            ' Beenden der Methode
                            Exit Sub
                        ' Kein Block an der ausgewählten Stelle gefunden
                        ElseIf (blockIDs.Count = 0) Then
                            editor.WriteMessage(ControlChars.CrLf & "Es konnte kein Block am ausgewählten Punkt gefunden werden")
                            ' Neustarten der Schleife
                            Continue While
                        ' Mehrere Blöcke an der ausgewählten Stelle gefunden
                        ElseIf (blockIDs.Count > 1) Then
                            editor.WriteMessage(ControlChars.CrLf & "Es wurden mehrere Blöcke an der ausgewählten gefunden. Auswahl nicht eindeutig")
                            ' Neustarten der Schleife
                            Continue While
                        ' Nur ein Block an der Stelle gefunden
                        Else
                            '---------------------------------------------------------------
                            ' Bestimmen der Attribute der Blockreferenz
                            '---------------------------------------------------------------

                            Dim blockAttributes As New Dictionary(Of String, String)
                            Try
                                blockAttributes = LaOs_AutoCAD_Werkzeuge.Functions.getBlockReferenceAttributes(blockIDs(0), positionFirstBlock)
                            Catch ex As Exception
                                editor.WriteMessage(ControlChars.CrLf & "Fehler beim beim Auslesen der Blockattribute" & ControlChars.CrLf & exception.Message & ControlChars.CrLf & "Funktion: getBlockReferenceAttributes(ByVal blockID As ObjectId, ByRef blockAttributes As Dictionary(Of String, String), ByRef position As Point3d) As Exception")
                                ' Beenden der Methode
                                Exit Sub
                            End Try

                            ' Erstellen des Vermessungpunktes
                            firstBlock = New VermPoint(positionFirstBlock.X, positionFirstBlock.Y, positionFirstBlock.Z)
                            ' Füllen der retlichen Werte mit den Blockattributen
                            If (blockAttributes.ContainsKey("PNR")) Then
                                firstBlock.PunktNr = blockAttributes.Item("PNR")
                            End If
                            If (blockAttributes.ContainsKey("VMA")) Then
                                firstBlock.VMA = blockAttributes.Item("VMA")
                            End If
                            If (heightMode = exportHeightModes.BlockattributHoehen) Then
                                If (blockAttributes.ContainsKey("HOEHE") AndAlso IsNumeric(blockAttributes.Item("HOEHE"))) Then
                                    firstBlock.Hoehe = blockAttributes.Item("HOEHE")
                                End If
                            Else
                                firstBlock.Hoehe = 0
                            End If

                            ' Verlassen der inneren Endlosschleife
                            Exit While
                        End If
                    End If
                End While

                '---------------------------------------------------------------
                ' Endlosschleife für die Auswahl des zweiten Blockes
                '---------------------------------------------------------------

                ' Bis ein gültiger zweiter Block oder ein Schlüsselwort ausgewählt wurde
                While True
                    ' Nur Punkte und Keywords: AufLinieÜbertragen
                    Dim getSecondPointOptions As New PromptPointOptions(ControlChars.CrLf & "Bitte den Einfügepunkt des zweiten Blockes auswählen oder: ")
                    getSecondPointOptions.Keywords.Add("AufLinieÜbertragen")
                    getSecondPointOptions.AllowNone = True

                    ' Auswahl des zweiten Punktes durch den Benutzer
                    Dim getSecondPointResult As PromptPointResult = editor.GetPoint(getSecondPointOptions)

                    ' Abbruch der Methode durch den Benutzer
                    If (getSecondPointResult.Status = PromptStatus.Cancel) Then
                        ' Beenden der Methode
                        Exit Sub
                    ' Schlüsselwort eingegeben
                    ElseIf (getSecondPointResult.Status = PromptStatus.Keyword Or getSecondPointResult.Status = PromptStatus.None) Then
                        ' Wenn der Block nur auf die Linie übertragen werden soll
                        If (getSecondPointResult.StringResult = "AufLinieÜbertragen" Or IsNothing(getSecondPointResult.StringResult)) Then
                            ' Aufruf der Funktion um die Höhe auf die Polylinie zu übertragen
                            If Not (blockHeightCarryOver(getPolylineResult.ObjectId, firstBlock)) Then

                            End If
                        End If
                    ' Falsche Eingabe vom Benutzer
                    ElseIf Not (getSecondPointResult.Status = PromptStatus.OK) Then
                        editor.WriteMessage(ControlChars.CrLf & "Sie haben keinen gültigen Einfügepunkt ausgewählt.")
                        ' Beenden der Methode
                        Exit Sub
                  ' Gültiger Punkt
                    Else
                    End If
                End While

            ' Äußere Endlosschleife
            End While

        End Sub

        ' Funktion um die Höhe eines Punktes auf eine Polylinie zu übertragen
        '  - Fügt am Lotfusspunkt des übergebenen Punktes zur Polylinie eine Blockreferenz ein
        '  - Gibt TRUE zurück wenn erfolgreich, ansonsten FALSE
        Private Function blockHeightCarryOver(ByVal polylineID As ObjectId, ByVal point As VermPoint) As Boolean

            Dim editor As Editor = Application.DocumentManager.MdiActiveDocument.Editor

            ' Anlegen eines Transaktionsobjektes um auf die Zeichnungsdatenbank zugreifen zu können
            Dim trans As Transaction = Application.DocumentManager.MdiActiveDocument.Database.TransactionManager.StartTransaction

            Dim pointOnCurve As Point3d = Nothing
            Try
                ' Holen des Curve-Objektes - Leserechte
                Dim curve As Curve = CType(trans.GetObject(polylineID, OpenMode.ForRead), Curve)

                ' Abfragen des dichtesten Punktes der Blockreferenz zum Curve-Objekt
                pointOnCurve = curve.GetClosestPointTo(point.getVermPointAsPoint3D, True)

            ' Abfangen eines evtl. aufgetretenen Fehlers
            Catch ex As Exception
                editor.WriteMessage(ControlChars.CrLf & "Fehler beim beim Berechnen des Lotfußpunktes" & ControlChars.CrLf & ex.Message & ControlChars.CrLf & "Funktion: blockHeightCarryOver(ByVal polylineID As ObjectId, ByVal point As VermPoint) As Boolean")
                ' Beenden der Funktion
                Return False

            ' Schließen der Transaktion mit der Datenbank
            Finally
                trans.Dispose()
            End Try

            ' Aufruf der Funktion um eine neue Blockreferenz anzulegen
            Dim exception As Exception = LaOs_AutoCAD_Werkzeuge.Functions.createBlockReference(BLOCKNAME, pointOnCurve, 1, 1, 1, point.getAttributesAsDictionary(False))
            If Not IsNothing(exception) Then
                editor.WriteMessage(ControlChars.CrLf & "Fehler beim beim Erstellen der Blockreferenz" & ControlChars.CrLf & exception.Message & ControlChars.CrLf & "Funktion: createBlockReference(ByVal name As String, ByVal position As Point3d, ByVal scaleX As Double, ByVal scaleY As Double, ByVal scaleZ As Double, ByVal attributes As Dictionary(Of String, String)) As Exception")
                ' Beenden der Funktion
                Return False
            Else
              ' Funktion wurde erfolgreich ausgeführt
                Return True
            End If

        End Function

        ' Funktion um die letzte verwendete Punktnummer im Bereich 90001 bis 90999 zu finden
        '  - Durchlaufen aller Blöcke und Überprüfen ob die darin gespeicherte Punktnummer relevant ist und ggf. ersetzten der aktuell höchsten verwendeten Punktnummer
        '  - Gibt NOTHING zurück wenn erfolgreich ansonsten die aufgetretene Exception
        Private Function setLastPunktNr() As Exception

            ' Vorbelegen auf die letzte verwendete 90000er-Punktnummer
            lastPunktNR = 90000

            ' Anlegen eines Transaktionsobjektes um auf die Zeichnungsdatenbank zugreifen zu können
            Dim trans As Transaction = Application.DocumentManager.MdiActiveDocument.Database.TransactionManager.StartTransaction
            Try
                ' Holen des aktuellen Arbeitsbereiches - Leserechte
                Dim currentWorkspace As BlockTableRecord = trans.GetObject(Application.DocumentManager.MdiActiveDocument.Database.CurrentSpaceId, OpenMode.ForRead)

                ' Durchlaufen aller Objekte des aktuellen Arbeitsbereiches
                For Each obj As ObjectId In currentWorkspace
                    ' Prüfen ob es sich um eine Blockreferenz handelt
                    If (obj.ObjectClass.DxfName = "INSERT") Then
                        ' Holen des Elementes aus der Datenbank - Leserechte
                        Dim blockRef As BlockReference = trans.GetObject(obj, OpenMode.ForRead)

                        ' Solange noch Attribute in der Collection vorhanden sind
                        For i As Long = 0 To blockRef.AttributeCollection.Count - 1
                            ' Öffnen der BlockAttributReferenz - Leserechte
                            Dim attributeReference As AttributeReference = blockRef.AttributeCollection(i).GetObject(OpenMode.ForRead)
                            ' Wenn das aktuelle Attribut das "PNR"-Attribut ist
                            If (attributeReference.Tag.ToUpper = "PNR") Then
                                ' Wenn darin eine Zahl gespeichert ist die größer als die aktuell letzte Punktnummer aber auch kleiner als 91000 ist
                                If (IsNumeric(attributeReference.TextString) AndAlso CLng(attributeReference.TextString) > lastPunktNR AndAlso CLng(attributeReference.TextString) < 91000) Then
                                    ' -> Speichern
                                    lastPunktNR = attributeReference.TextString
                                End If
                            End If
                        Next
                    End If
                Next

                ' Beenden der Funktion
                Return Nothing

            ' Abfangen eines evtl. auftretenden Fehlers
            Catch ex As Exception
                Return ex

            ' Schließen der Transaktion mit der Datenbank
            Finally
                trans.Dispose()
            End Try

        End Function

    End Module
End Namespace

---

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

---

Hi,

ich muss leider einen Teil auslassen, die ganzen LaOs_AutoCAD_Werkzeuge... hab ich nicht.

Was dann mal überbleibt wäre (mit Option Strict eingeschaltet)

Dim blockAttributes As New Dictionary(Of String, String)
  ...meldet der SyntaxCheck:
            "Autodesk.AutoCAD.Runtime.Dictionary" hat keine Typparameter
            und kann daher keine Typargumente haben

korrigiert auf:
Dim blockAttributes As New Collections.Generic.Dictionary(Of String, String)

Das wäre aber auch schon das einzige, was mir im Editor aufgefallen ist und ich prüfen konnte. Die Klassendefinition VermPoint, einige Funktionen in der LaOs...Lib etc machen es halt unmöglich, es anzustarten.

Und ich nehme auch nicht an, dass es Dir helfen würde, wenn ich es schreibe, denn dann werden Deine Lib's nicht genutzt und es geht Dir (nehme ich auch an) um das WIESO.

Was kannst Du weiter tun:

a) was sagt Dein AutoCAD, wenn Du nach Durchlauf dieser Funktion mal _AUDIT machst
b) einen BreakPoint setzen bei trans.Commit in der Function 'createBlockReference', bleibt der Code da überhaupt stehen, kommt er dort hin?

Sorry, ich bin ziemlich am Ende mit dem theoretischen Durchlesen.

- alfred -

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

---

Beim Block ist die Beschriftungseigenschaft gesetzt, kann das irgenwas damit zu tun haben? Weil mit dem Setzen der Maßstäbe wollte ich mich eigentlich erst beschäftigen wenn der Block erscheint.

Die Screenshots der Überwachung wurden ausgenommen als der Breakpoint bei return nothing sass, also direkt nach dem commit-Befehl. Das mit dem audit prüf ich morgen mal

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

---

Hi,

>> Beim Block ist die Beschriftungseigenschaft gesetzt, kann das irgenwas damit zu tun haben?

Nach Deiner Aussage von zuvor hast Du meinen Code ohne Fehler durchlaufen lassen können. Wenn Du dabei den gleichen Block verwendet hast, dann hat es imho damit nix zu tun.

Wie wohl ich Dir jedenfalls recht gebe, dass darauf zu achten ist, denn beim manuellen Einfügen wird man ja auch beim ersten mal nach dem Maßstab gefragt. Mal mit ANNOAUTOSCALE probieren oder einen Block ohne Beschriftungseigenschaften mit dem gleich Code probieren.

- alfred -

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

---

Ich glaube mein AutoCAD 2009 hat ne Macke. Ich hab einen Block ohne Beschriftungseigenschaften erstellt und wollte diesen jetzt verschieben, hat aber leider auch nicht geklappt. Einmal war jedoch per Strg+A der Einfügepunkt und die Einfügepunkte der Attribute zu sehen, mehr aber eben nur die Einfügepunkte, weder Grafik noch Attributwerte.

Zudem ist mir aufgefallen, dass wenn ich nach dem Einfügen in der Zeichnung per Mausrad das Ansichtsfenster ändere die alten Symbole für das Koordinatensystem nicht verschwinden und irgendwann AutoCAD dann abstürzt

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

---

Hi,

>> Ich glaube mein AutoCAD 2009 hat ne Macke. Ich hab einen Block ohne
>> Beschriftungseigenschaften erstellt und wollte diesen jetzt verschieben

Hast Du das gemacht, ohne dass Deine App geladen war? Wenn dann AutoCAD seltsame Phänomene zeigt, dann kann ich vielleicht zu stimmen.
Aber sobald mal DocumentLocking oder TransActions meiner App aktiv waren/sind, dann hätt ich trotzdem zuerst hier gesucht, denn dass AutoCAD beim Erstellen von Blockdefinitionen oder beim Schieben von BlockReferenzen abschwirrt, ist zugegeben sehr unwahrscheinlich.

>> Zudem ist mir aufgefallen, dass wenn ich nach dem Einfügen ...
>> ... irgendwann AutoCAD dann abstürzt

Gilt gleiches wie oben, hier nur viel deutlicher. Wenn AutoCAD nach Dll-Funktionsaufrufen in der Weiterbearbeitung abschwirrt, dann wurden durch die App Elementmodifikationen oder -erstellungen nicht komplett abgeschlossen. Hier kann oft helfen, unmittelbar nach Funktionsaufrufen den Befehl _AUDIT starten, denn da greift AutoCAD jedes Element einzeln an und damit merkt man am schnellsten, ob die Zeichnung im stabilen Zustand hinterlassen wird.

Das waren jetzt mal die theoretischen Worte, die man als Aussenstehender leicht sagen kann.     Ich weiss leider nicht, wie ich Dir weiterhelfen kann, da ich den Code nicht laufen lassen kann und nur mit Drüberlesen ist's halt nicht mehr so einfach.

Sorry, - alfred -

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

---

Ich hab den Fehler gefunden. Juhuuuu. Es lag tatsächlich an der Beschriftung. Drei Zeilen und das Problem war gelöst, anscheinend kam er auch durcheinander weil keine Annotationmaßstäbe gesetzt war jetzt funktioniert das ohne Probleme.

Das hier waren die Übeltäter

Code:

---

        Dim ocm As ObjectContextManager = Application.DocumentManager.MdiActiveDocument.Database.ObjectContextManager
        Dim occ As ObjectContextCollection = ocm.GetContextCollection("ACDB_ANNOTATIONSCALES")
        blockRef.AddContext(occ.CurrentContext)

---

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

---

Hi,

danke für die Rückmeldung und den korrigierenden Code! 

- alfred -

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

---

Ich danke für deine Anregungen

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