---

Attribute sind in AutoCAD ein leidiges Thema.

Das Problem das ich hatte, waren Beschriftungsblöcke einer AutoCAD Applikation (Viega CAD bzw. Linear).

Diese Beschriftungsblöcke sind programmintern mit den entsprechenden Leitungen verknüpft. Die Leitungen (Heizung, Sanitär) werden von der Applikation dimensioniert und mit entsprechenden Funktionen beschriftet. Änder sich die Berechnung, können die vorhandenen Beschriftungblöcke automatisch aktualisiert werden.

So weit so gut... Nun zum Problem.
Der Beschriftungsblock sollte geändert werden.
Die Lage der Attribute, Texthöhe und Schriftart sollte geändert werden. Gesagt getan und dann Block mit den Attributen neu definiert und alte Definition überschrieben ...
Ergebnis: Keine Änderung bestehender Atrribute...

Ist ja auch logisch, weil die Attributsreferenzen nicht aktualisert werden. Aber es gibt ja einige Tools (z.B. Toolpack)
die Funktionen zum Neudefinieren von Blöcken mit Attributen bieten.

Problem war nun, dass die Applikation den Bezug zu den Beschrifterblöcken verloren hat, da die Blocke neu eingefügt wurden und die Attributswerte übertragen wurden.

Mein Ansatz war nun die direkte Manipulation bestehender Attributsreferenzen. Die Blöckreferenzen werden mit der neuen Blockdefinition verglichen und die bestehenden Attributsreferenzen werden laut den Einstellungen der neuen Attributsdefinitionen im neuen Block abgeändert.

Attribute die in der neuen Blockdefinition fehlen, werden in den bereits eingefügten Blöcken gelöscht.

Ablauf Block mit neuer Darstellung definieren und bestehende Definition überschreiben.

Anschliessend Funktion aufrufen und einen der bestehenden Blöcke in der Zeichnung klicken.

Einschränkung!!!
Es ist bisher noch nicht möglich neue Attribute hinzuzufügen.
Ansatz für so eine Funktion wäre das kopieren und Abändern einer bereits bestehenden AttributsReferenz in der BlockReferenz.

Anbei der Programmcode ...

Public Sub AttDefNeuLesen()

    Dim objBlockDef As AcadBlock
    Dim objBlockRef As AcadBlockReference
   
    Dim varAttrefs As Variant
    Dim objAttRef As AcadAttributeReference
    Dim objAttDef As AcadAttribute

    Dim objEntity As AcadEntity
    Dim objEntityBlockdef As AcadEntity
    Dim strBlockname As String
   
   
    Dim pt1 As Variant
    Dim ptBlockRef As Variant
    Dim ptAttDef As Variant
    Dim ptAttRef(2) As Double
   
    Dim AttDefGefunden As Boolean

    Dim i1 As Integer
   
    'Eine Blockreferenz wählen
    ThisDrawing.Utility.GetEntity objBlockRef, pt1, "Block wählen: "
   
    'Blocknamen auswerten
    strBlockname = objBlockRef.Name
   
    'Alle Objekte im Modellbereich durchlaufen
    For Each objEntity In ThisDrawing.ModelSpace
        If objEntity.ObjectName = "AcDbBlockReference" Then 'Prüfen, ob Element Block ist
            Set objBlockRef = objEntity 'Wenn Ja dann Blockref-Zeiger auf Element
           
            If UCase(objBlockRef.Name) = UCase(strBlockname) Then  'Prüfen, ob Blockrefenz mit gesuchtem übereinstimmt
       
                If objBlockRef.HasAttributes Then  'Wenn Ja dann prüfen, ob Block Attribute hat
                    varAttrefs = objBlockRef.GetAttributes  'Attribute des Blocks einlesen
                   
                    For i1 = LBound(varAttrefs) To UBound(varAttrefs)  'Alle Attribute durchlaufen
                   
                        Set objAttRef = varAttrefs(i1)  'AttRef-Zeiger auf aktuelle Attributreferenz
                       
                        Set objBlockDef = ThisDrawing.Blocks(objBlockRef.Name)  'Blockdef-Zeiger auf Blockdefinition
                       
                        AttDefGefunden = False
                       
                        For Each objEntityBlockdef In objBlockDef  'Alle Elemente der Blockdefinition durchlaufen
                       
                            If objEntityBlockdef.ObjectName = "AcDbAttributeDefinition" Then    'Prüfen, ob Attributsdefinition gefunden
                           
                                Set objAttDef = objEntityBlockdef  'Wenn Ja Attdef-Zeiger auf aktuelle Attributsdefinition
                               
                                If objAttDef.TagString = varAttrefs(i1).TagString Then  'Prüfen, ob gesuchtes Attribut gleich der Aktuellen Definition ist
                               
                                    ptBlockRef = objBlockRef.InsertionPoint 'Einfügepunkt Blockreferenz
                                   
                                    ptAttDef = objAttDef.InsertionPoint 'Einfügepunkt Attributsdefinition
                                   
                                 
                                    ptAttRef(0) = ptBlockRef(0) + ptAttDef(0) * objBlockRef.XScaleFactor    'Neue Position des Attributes ermitteln
                                    ptAttRef(1) = ptBlockRef(1) + ptAttDef(1) * objBlockRef.YScaleFactor    'Koordinate Attributsdefinition + Koordinate Blockreferenz x Maßstab
                                    ptAttRef(2) = ptBlockRef(2) + ptAttDef(2) * objBlockRef.ZScaleFactor
                                   
                                   
                                    With objAttRef  'Neue Werte an Attribut schreiben
                                        .color = objAttDef.color                'Farbe
                                        .Linetype = objAttDef.Linetype          'Linientyp
                                        .LineWeight = objAttDef.LineWeight      'Linienbreite
                                        .Layer = objAttDef.Layer                'Layer
                                        .Alignment = objAttDef.Alignment        'Textausrichtung
                                        .InsertionPoint = ptAttRef              'Einfügepunkt
                                        .Height = objAttDef.Height * objBlockRef.YScaleFactor 'Texthöhe
                                        .ScaleFactor = objAttDef.ScaleFactor    'Textweite
                                        .StyleName = objAttDef.StyleName        'Textstil
                                        .InsertionPoint = ptAttRef              'Einfügepunkt
                                        .Rotation = objAttDef.Rotation          'Ursprungsdrehung wie in Definition
                                        .Rotate objBlockRef.InsertionPoint, objBlockRef.Rotation    'Attribut nachträglich drehen, wie Blockdrehung
                                    End With
                                   
                                    AttDefGefunden = True 'Markierung, das AttDef gefunden wurde
                                End If
                            End If
                        Next
                        If Not AttDefGefunden Then objAttRef.Delete 'Wenn Attdef in neuem Block fehlt, AttRef löschen
                    Next i1
                End If
            End If
        End If
    Next
    Exit Sub
   
Error:
    MsgBox "Sie haben keinen gültigen Block gewählt!"
End Sub

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