---

Hallo NG,
Ich möchte ganz banal aus einem bestehenden Block ("Plankopf")
den Wert des ITEM (_Plannummer) ändern.

Die Hilfe Beispiele sind immer in der Form ausgelegt, dass ein neues Attribut hinzugefügt wird. Ich möchte ein bestehende Attribut ändern.

D.h. Der TextString von (_Plannummer) ist "TEST".

Ich möchte diesen auf...  "555" ändern.

Könnt Ihr mir helfen ???

Ich habe es so versucht...

Public Const StrPlanKopf As String = "testplankopf"

Private Function GetBlockReferences(Block As String) As Boolean
Dim BlockList As New Collection
Dim ACADObject As AcadEntity
GetBlockReferences = False
       
    ' Get list of available Block references
    For Each ACADObject In ThisDrawing.ModelSpace
        If ACADObject.ObjectName = "AcDbBlockReference" Then
            If UCase(ACADObject.Name) = UCase(Block) Then
                GetBlockReferences = True
                Exit Function
            End If
            'MsgBox ACADObject.Name
        End If
    Next
   
End Function

Private Sub start()
Dim wichblock As AcadBlock
Dim x As Object
Dim attribObj As AcadAttribute
   
    If GetBlockReferences(StrPlanKopf) = False Then
        MsgBox "Kein Plankopf gefunden!"
        Exit Sub
    End If
   
   
    Set wichblock = ThisDrawing.Blocks.Item(StrPlanKopf)
   
    For Each x In wichblock
        If x.ObjectName = "AcDbAttributeDefinition" Then
            Set attribObj = x
            Select Case UCase(attribObj.TagString)
           
                Case "_PLANNUMMMER"
                    MsgBox attribObj.TagString, vbInformation, attribObj.TextString
                   
                    Dim s As String
                   
                    s = InputBox("Neue Plannummer:")
                    attribObj.Verify = True
                   
                    attribObj.TextString = s
                    attribObj.Update
            End Select
        End If
    Next
End Sub

Danke für Eure Tips

Manfred Büttner

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

---

Hallo Manfred,

leider sagst Du uns nicht mit welcher Version Du arbeitest. Ich setz jetzt einfach mal ACAD 2000 oder hoeher voraus. Wenn Du die Express-Tools hast, kannst Du es auch einfacher machen. Block als Zeichnung oeffnen, das gewuenschte Attribut modifizieren, danach speichern. Nun in der eigentlichen Zeichnung den Block wieder einfuegen (ueber Browse, nicht den Block im Zeichnungsspeicher verwenden), Frage nach Neudefinition mit ja beantworten. Den neuen Block irgendwo am Rand plazieren, dann den Befehl von den Express-Tools "Block synchronisieren" anwenden und schon ist der alte Block mit den neuen Attribut-Definitionen aktualisiert, nun kann der neu eingefuegte Block wieder geloescht werden.
Hope it helps

------------------
Gruss aus dem sonnigen Athen
Wolfgang

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

---

Hallo Wolfgang,

nein, das hilft nicht, denn:

Im Papierbereich (es geht um einen Plankopf) gibt es sagen wir einmal 10 Layouts. In jedem dieser Layout ist mind. ein Plankopf enthalten.

Ich möchte nun folgendes realisieren...
Der Benutzer ruft das VBA- Makro auf.
Er wird gebeten eine Auswahl zu treffen (Selection-Set), sodass auch nur dieser Plankopf geändert wird....

Das Makro liest aus dem definierten Plankopf (StrPlankopf) die Plannummer aus (diese ist eindeutig).

Es öffnet sich eine Userform, die z.B. die Plandaten darstellt.
(Relationale DB mit Änderungsindexen zum einen und Versandinformationen zum anderen).

Ändert nun der Benutzer einen Wert...  (z.B. de Plannummer, oder den Masstab) möchte ich diese Daten zurücklesen und nur in diesen Block schreiben....

--> Mit meinem Makro kann ich zwar den Textstring ändern, dieser wird aber nicht angezeigt :-[

Vielleicht kannst Du mir doch noch weiterhelfen...?

Danke

Manfred Büttner

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

---

Hi Manfred,

nun, mein Loesungsvorschlag war ein Schuss ins Blaue. Aber nun versteh ich besser was Du meinst: Aber leider hab ich keine Loesung dafuer, aber einen Link zu einem Acad-Programmer Forum, ich schau da aus Neugierde ab und zu rein (bin ne Null im lispeln), ich denke das Du da sehr schnell ne Loesung bekommst. Der Link ist: http://www.industrie24.com/bbs/list.php?f=5

Ich hoffe dass Dir dies besser weiterhilft

------------------
Gruss aus dem sonnigen Athen
Wolfgang

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

---

Versuch es einmal damit

Code:

---

Public Sub AttChangeTest()
   
    Dim blockObj As AcadBlockReference
    Dim Atts As Variant
    Dim Count As Integer
    Dim AttText As String
   
    'Zuerst Block blockObj wählen, wie immer du das auch machen möchtest
   
    If blockObj.HasAttributes = False Then Exit Sub
    Atts = blockObj.GetAttributes
   
    For Count = UBound(Atts) To 0 Step -1
        ' Wir lesen die Daten
        Select Case Format(Atts(Count).TagString, ">")
            Case "_PLANNUMMMER"
                'Deine Abfragen
                'Zum Beispiel
                AttText = ThisDrawing.Utility.GetString(0, "Neue Plannummer: ")
                Atts(Count).textString = AttText
                GoTo ENDE
        End Select
       
    Next Count
ENDE:

End Sub

---

Hoffe dir geholfen zu haben

------------------
Roland

[Diese Nachricht wurde von RoSiNiNo am 26. November 2002 editiert.]

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

---

Ich danke Euch für Eure schnellen Infos...
diese Lösung klappt: (nur falls noch eine(r) das Problemchen hat)

Option Explicit

Public Const Def_StrPlanKopfName As String = "testplankopf"
Public Const Def_StrPlannummer As String = "_plannummmer"

Public Sub showAttribut()
Dim ActObj As Object
Dim pickedPoint
Dim i As Integer

On Local Error Resume Next
Do
ThisDrawing.Utility.GetEntity ActObj, pickedPoint, "Block wählen"
If TypeName(ActObj) = "Nothing" Then
    Exit Do
Else

If UCase$(ActObj.ObjectName) = "ACDBBLOCKREFERENCE" Then
    If UCase$(ActObj.Name) = UCase$(Def_StrPlanKopfName) Then
        If ActObj.HasAttributes = True Then
        Dim nvarAttrib As Variant
        nvarAttrib = ActObj.GetAttributes
            For i = LBound(nvarAttrib) To UBound(nvarAttrib)
           
                Select Case nvarAttrib(i).TagString
               
                    Case UCase$(Def_StrPlannummer)
                        'MsgBox "AttributReferenz: " & nvarAttrib(i).TagString & vbCrLf & "AttributDaten: " & nvarAttrib(i).TextString
                        Dim s As String
                        s = InputBox("Neue Plannummer: ", "Alte Plannummer: " & nvarAttrib(i).TextString)
                        nvarAttrib(i).TextString = s
               
                End Select
           
            Next
        End If
    End If
End If
Set ActObj = Nothing
End If
Loop
End Sub

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