---

Ich habe diese Frage schon einmal hier im Forum gestellt - allerdings habe ich da das Problem nicht richtig beschrieben. Daher nochmal mein Problem, detaillierter:

Habe mit Visual Basic ein Programm zur automatisierten Blockerstellung geschrieben.
Nach dem Erstellen und Einfügen des Blockes per Programm liegen die Attributwerte irgendwo auf der Zeichnung (also habe ich gedacht, der Einfügepunkt der Attribute ist falsch). Wenn ich aber den Block in den Ursprung setze, dann sehe ich die die Attributdefinitionen am eigentlichen Einfügepunkt (also da, wo sie sein sollten). Wieso sind die Attributwerte dann aber an der falschen Stelle. Wenn ich den neu erstellten und eingefügten Block lösche und ihn danach nochmal in die Zeichnung einfüge, sind die Werte an der richtigen Stelle (das funktioniert allerdings nur unter ACAD2004, unter 2000 und 2002 werden die Werte auch nach dem zweiten EInfügen an der falschen Stelle angezeigt!!) - ich versteh's einfach nicht!

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

---

Hi,
hab mal aus den Beispielen so nen Code zusammen gekloppt, ich hoffe das gibt das wieder was Du machen willst. Musst nur den Block danach erstmal manuell einfügen. Bei mir läufts jedenfalls und die Positionen sind wie erwartet.

Sub Example_AddAttribute()
   
    Dim attributeObj As AcadAttribute
    Dim height As Double
    Dim mode As Long
    Dim prompt As String
    Dim tag As String
    Dim value As String
    Dim blockObj As AcadBlock
    Dim insertionPnt(0 To 2) As Double
   
    height = 1#
    mode = acAttributeModeVerify
    prompt = "New Prompt"
    insertionPnt(0) = 0#: insertionPnt(1) = 0#: insertionPnt(2) = 0#
    tag = "New Tag"
    value = "New Value"
   
    Set blockObj = ThisDrawing.Blocks.Add(insertionPnt, "New_Block3")
    insertionPnt(0) = 5#: insertionPnt(1) = 5#: insertionPnt(2) = 0#
    blockObj.AddAttribute height, mode, prompt, insertionPnt, tag, value
    MsgBox blockObj.Name & " has been added." & vbCrLf & _
            "Origin: " & blockObj.origin(0) & ", " & blockObj.origin(1) _
            & ", " & blockObj.origin(2), , "Add Example"
End Sub

Vielleicht ist der Bock ja wo anders oder ich hab Dein Problem nicht kapiert (sorry..)

Gruss,
Harry

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

---

Also, das Problem ist weniger die Blockerstellung per Code - die funktioniert einwandfrei. Auch das Einfügen des Blockes an einem definierten Einfügepunkt per Code ist ok. Das Problem ist, dass ich im Code die Blockattribute definiere - diese aber, sobald Werte drinstehen, nicht an ihrem Einfügepunkt sondern irgendwo in der Landschaft angezeigt werden. Wenn ich den Block auflöse, dann stehen die Attribute wirklich am eigentlichen, definierten Einfügepunkt - mache ich das Auflösen wieder rückgängig, stehen sie wieder irgendwo.

Die Attributdefinition erfolgt mit folgendem Code:

Public insertionPnt As Variant
Dim InsPoint(2) As Double
Dim attributeObj As Object
GetInsPoint = ThisDrawing.Utility.GetPoint(, "Block-Einfügepunkt wählen: ")
For g = LBound(GetInsPoint) To UBound(GetInsPoint)
InsPoint(g) = GetInsPoint(g)
Next g
insertionPnt = InsPoint
Set attributeObj = nBlock.AddAttribute(1#, acAttributeModeInvisible, "Objektnummer", insertionPnt, "T_Objekt_NR", "")

Hoffe, mein Problem ist etwas deutlicher geworden!!

Ralf

Zitat:

---

Original erstellt von harryk:
Hi,
hab mal aus den Beispielen so nen Code zusammen gekloppt, ich hoffe das gibt das wieder was Du machen willst. Musst nur den Block danach erstmal manuell einfügen. Bei mir läufts jedenfalls und die Positionen sind wie erwartet.

Sub Example_AddAttribute()
   
    Dim attributeObj As AcadAttribute
    Dim height As Double
    Dim mode As Long
    Dim prompt As String
    Dim tag As String
    Dim value As String
    Dim blockObj As AcadBlock
    Dim insertionPnt(0 To 2) As Double
   
    height = 1#
    mode = acAttributeModeVerify
    prompt = "New Prompt"
    insertionPnt(0) = 0#: insertionPnt(1) = 0#: insertionPnt(2) = 0#
    tag = "New Tag"
    value = "New Value"
   
    Set blockObj = ThisDrawing.Blocks.Add(insertionPnt, "New_Block3")
    insertionPnt(0) = 5#: insertionPnt(1) = 5#: insertionPnt(2) = 0#
    blockObj.AddAttribute height, mode, prompt, insertionPnt, tag, value
    MsgBox blockObj.Name & " has been added." & vbCrLf & _
            "Origin: " & blockObj.origin(0) & ", " & blockObj.origin(1) _
            & ", " & blockObj.origin(2), , "Add Example"
End Sub

Vielleicht ist der Bock ja wo anders oder ich hab Dein Problem nicht kapiert (sorry..)

Gruss,
Harry

---

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

---

Ok, die Attribute schwirren irgendwo rum, hab ich verstanden. Hab Deinen Code in etwas abgeänderter Form mal integriert. Den Einfügepunkt setzte ich allerdings nicht mit ner Schleife um. Aber trotzdem funktioniert es (oder ich kapier's wirklich nicht...)!?!
Wenn's nicht hilft solltest Du mal nen lauffähigen Code hier abbilden der nur dieses Teilproblem angeht damit man das nachvollziehen kann.

Viel Erfolg,

Harry
Sub Example_AddAttribute()
   
    Dim attributeObj As AcadAttribute
    Dim height As Double
    Dim mode As Long
    Dim prompt As String
    Dim tag As String
    Dim value As String
    Dim blockObj As AcadBlock
    Dim insertionPnt(0 To 2) As Double
   
    height = 1#
    prompt = "New Prompt"
    tag = "New Tag"
    value = "New Value"
   
    mode = acAttributeModeVerify
'    mode = acAttributeModeInvisible

    GetInsPoint = ThisDrawing.Utility.GetPoint(, "Block-Einfügepunkt wählen: ")
    insertionPnt(0) = GetInsPoint(0): insertionPnt(1) = GetInsPoint(1): insertionPnt(2) = GetInsPoint(2)
   
    Set blockObj = ThisDrawing.Blocks.Add(insertionPnt, "New_Block66")
    blockObj.AddCircle insertionPnt, 6#
   
    insertionPnt(0) = insertionPnt(0) + 5#: insertionPnt(1) = insertionPnt(1) + 5#: insertionPnt(2) = 0#
   
    Set attributeObj = blockObj.AddAttribute(height, mode, prompt, insertionPnt, tag, "")
   
    attributeObj.TextString = "NEW VALUE66"
    attributeObj.Update
    MsgBox blockObj.Name & " has been added." & vbCrLf & _
            "Origin: " & blockObj.origin(0) & ", " & blockObj.origin(1) _
            & ", " & blockObj.origin(2), , "Add Example"
           
End Sub

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

---

Hallo Ralf!

Ich bin mir ganz sicher ob Dir dieses weiter hilft, aber bei meiner programmiererei hilft mir oft die AutoCAD Hilfe auf die Sprünge.

Hier einige Info's zu Blockattributen:

In diesem Beispiel wird ein Block definiert und ein Attribut zur Blockdefinition hinzugefügt. Anschließend wird der Block in die Zeichnung eingefügt.

Sub Ch10_CreatingAnAttribute()
    ' Definieren des Blocks
    Dim blockObj As AcadBlock
    Dim insertionPnt(0 To 2) As Double
    insertionPnt(0) = 0
    insertionPnt(1) = 0
    insertionPnt(2) = 0
    Set blockObj = ThisDrawing.Blocks.Add _
                    (insertionPnt, "BlockWithAttribute")
   
    ' Hinzufügen eines Attributs zum Block
    Dim attributeObj As AcadAttribute
    Dim height As Double
    Dim mode As Long
    Dim prompt As String
    Dim insertionPoint(0 To 2) As Double
    Dim tag As String
    Dim value As String
    height = 1
    mode = acAttributeModeVerify
    prompt = "Neue Eingabeaufforderung"
    insertionPoint(0) = 5
    insertionPoint(1) = 5
    insertionPoint(2) = 0
    tag = "Neuer Tag"
    value = "Neuer Wert"
    Set attributeObj = blockObj.AddAttribute(height, mode, _
                          prompt, insertionPoint, tag, value)
    ' Einfügen des Blocks, Erstellen einer Blockreferenz
    ' und einer Attributreferenz
    Dim blockRefObj As AcadBlockReference
    insertionPnt(0) = 2
    insertionPnt(1) = 2
    insertionPnt(2) = 0
    Set blockRefObj = ThisDrawing.ModelSpace.InsertBlock _
              (insertionPnt, "BlockWithAttribute", 1#, 1#, 1#, 0)
End Sub

In diesem Beispiel wird ein Block definiert und ein Attribut zur Blockdefinition hinzugefügt. Anschließend wird der Block in die Zeichnung eingefügt. Der Attributtext wird dann so aktualisiert, daß er rückwärts dargestellt wird.

Sub Ch10_RedefiningAnAttribute()
    ' Definieren des Blocks
    Dim blockObj As AcadBlock
    Dim insertionPnt(0 To 2) As Double
    insertionPnt(0) = 0
    insertionPnt(1) = 0
    insertionPnt(2) = 0
    Set blockObj = ThisDrawing.Blocks.Add _
                    (insertionPnt, "BlockWithAttribute")
   
    ' Hinzufügen eines Attributs zum Block
    Dim attributeObj As AcadAttribute
    Dim height As Double
    Dim mode As Long
    Dim prompt As String
    Dim insertionPoint(0 To 2) As Double
    Dim tag As String
    Dim value As String
    height = 1
    mode = acAttributeModeVerify
    prompt = "Neue Eingabeaufforderung"
    insertionPoint(0) = 5
    insertionPoint(1) = 5
    insertionPoint(2) = 0
    tag = "Neuer Tag"
    value = "Neuer Wert"
    Set attributeObj = blockObj.AddAttribute(height, mode, _
                          prompt, insertionPoint, tag, value)
    ' Einfügen des Blocks, Erstellen einer Blockreferenz
    ' und einer Attributreferenz
    Dim blockRefObj As AcadBlockReference
    insertionPnt(0) = 2
    insertionPnt(1) = 2
    insertionPnt(2) = 0
    Set blockRefObj = ThisDrawing.ModelSpace.InsertBlock _
              (insertionPnt, "BlockWithAttribute", 1#, 1#, 1#, 0)
   
    ' Neudefinieren des Attributtexts, damit er rückwärts dargestellt wird.
    attributeObj.Backward = True
    attributeObj.Update
End Sub

In diesem Beispiel wird ein Block definiert und ein Attribut zur Blockdefinition hinzugefügt. Anschließend wird der Block in die Zeichnung eingefügt. Die Attributdaten werden dann ausgegeben und in einem Meldungsfeld angezeigt. Sie werden dann für die Blockreferenz aktualisiert und anschließend erneut ausgegeben und angezeigt.

Sub Ch10_GettingAttributes()
    ' Erstellen des Blocks
    Dim blockObj As AcadBlock
    Dim insertionPnt(0 To 2) As Double
    insertionPnt(0) = 0
    insertionPnt(1) = 0
    insertionPnt(2) = 0
    Set blockObj = ThisDrawing.Blocks.Add _
                          (insertionPnt, "TESTBLOCK")
   
    ' Erstellen der Attributdefinition
    Dim attributeObj As AcadAttribute
    Dim height As Double
    Dim mode As Long
    Dim prompt As String
    Dim insertionPoint(0 To 2) As Double
    Dim tag As String
    Dim value As String
    height = 1#
    mode = acAttributeModeVerify
    prompt = "Attributeingabeaufforderung"
    insertionPoint(0) = 5
    insertionPoint(1) = 5
    insertionPoint(2) = 0
    tag = "Attributsbezeichnung"
    value = "Attributwert"
   
    ' Erstellen des Attributdefinitionsobjekts auf dem Block
    Set attributeObj = blockObj.AddAttribute _
                        (height, mode, prompt, _
                        insertionPoint, tag, value)
   
 
    ' Einfügen des Blocks
    Dim blockRefObj As AcadBlockReference
    insertionPnt(0) = 2
    insertionPnt(1) = 2
    insertionPnt(2) = 0
    Set blockRefObj = ThisDrawing.ModelSpace.InsertBlock _
                    (insertionPnt, "TESTBLOCK", 1, 1, 1, 0)
    ZoomAll
   
    ' Abrufen der Attribute für die Blockreferenz
    Dim varAttributes As Variant
    varAttributes = blockRefObj.GetAttributes
   
    ' Verschieben der Attributbezeichnungen und Werte in eine
    ' Zeichenkette, um sie in einem Mitteilungsfeld anzuzeigen
    Dim strAttributes As String
    strAttributes = ""
    Dim I As Integer
    For I = LBound(varAttributes) To UBound(varAttributes)
        strAttributes = strAttributes + "  Tag: " + _
                    varAttributes(I).TagString + vbCrLf + _
                    "  Wert: " + varAttributes(I).textString
    Next
    MsgBox "Die Attribute für blockReference " + _
                  blockRefObj.Name & " lauten: " & vbCrLf _
                  & strAttributes
   
    ' Ändern des Attributwerts
    ' Anmerkung: SetAttributes wird nicht benötigt. Sobald Sie über die
    ' Variant-Anordnung verfügen, haben Sie auch die Objekte.
    ' Bei einer Änderung ändern sich auch die Objekte in der Zeichnung.
    varAttributes(0).textString = "NEUER WERT!"
   
    ' Erneutes Abrufen der Attribute
    Dim newvarAttributes As Variant
    newvarAttributes = blockRefObj.GetAttributes
   
    ' Erneutes Anzeigen der Bezeichnungen und Werte
    strAttributes = ""
    For I = LBound(varAttributes) To UBound(varAttributes)
        strAttributes = strAttributes + "  Tag: " + _
                    newvarAttributes(I).TagString + vbCrLf + _
                    "  Wert: " + newvarAttributes(I).textString
    Next
    MsgBox "Die Attribute für blockReference " & _
                  blockRefObj.Name & " lauten: " & vbCrLf _
                  & strAttributes
End Sub

Ich hoffe es hilft.

Gruß Dirk

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

---

Hallo Harry,

Dein Code produziert genau meinen Fehler, wenn Du den erstellten Block auch per Code einfügst - und zwar so:

Sub Example_AddAttribute()
   
    Dim attributeObj As AcadAttribute
    Dim height As Double
    Dim mode As Long
    Dim prompt As String
    Dim tag As String
    Dim value As String
    Dim blockObj As AcadBlock
    Dim insertionPnt(0 To 2) As Double
   
    height = 1#
    prompt = "New Prompt"
    tag = "New Tag"
    value = "New Value"
   
    mode = acAttributeModeVerify
'    mode = acAttributeModeInvisible

    GetInsPoint = ThisDrawing.Utility.GetPoint(, "Block-Einfügepunkt wählen: ")
    insertionPnt(0) = GetInsPoint(0): insertionPnt(1) = GetInsPoint(1): insertionPnt(2) = GetInsPoint(2)
   
    Set blockObj = ThisDrawing.Blocks.Add(insertionPnt, "New_Block66")
    blockObj.AddCircle insertionPnt, 6#
   
    insertionPnt(0) = insertionPnt(0) + 5#: insertionPnt(1) = insertionPnt(1) + 5#: insertionPnt(2) = 0#
   
    Set attributeObj = blockObj.AddAttribute(height, mode, prompt, insertionPnt, tag, "")
   
    attributeObj.TextString = "NEW VALUE66"
    attributeObj.Update

'Einfügen des Blockes:
Set blockRefObj = ThisDrawing.ModelSpace.InsertBlock(insertionPnt, "New_Block66", 1#, 1#, 1#, 0)

    MsgBox blockObj.Name & " has been added." & vbCrLf & _
            "Origin: " & blockObj.origin(0) & ", " & blockObj.origin(1) _
            & ", " & blockObj.origin(2), , "Add Example"
End Sub

Was machen?!?!?

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

---

potzblitz...wär ja auch zu einfach gewesen.

es gibt einen Zusammenhang, das Attribut wandert immer im gleichen Abstand von seiner "Soll" Position weg wie der Blockeinfügepunkt vom Weltkoordinatenursprung entfernt ist-aber ich glaube das hattest Du bereits selber herausgefunden.

Die einzige Möglichkeit die ich gefunden habe den Block wie gewollt einzufügen ist über .SendCommand. Ansonsten muss ich erstmal passen. Ich bin mir aber sicher das der Bock in der Insert Funktion liegt, füge ich den Block danach oder davor von Hand ein ist alles Ok.

Was ich Dir für die .SendCommand Krücke bieten kann ist eine Funktion die Dir das zuletzt erstellte Element eines Zeichnungsbereiches wiedergibt damit Du sofort die Attribute ausfüllen kannst (habs mal irgendwann im Netz aufgeschnappt):

Public Function EntLast(Optional Layout As String = "Model", Optional Index As Long = 1) As AcadObject
Dim blk As AcadBlock
Set blk = ThisDrawing.Layouts(Layout).Block
Set entlast = blk.Item(blk.Count - Index)
End Function

Purpose
Returns the nth to last object created in a given layout

Arguments
Optional layout name and index. If no layout is specified, defaults to Model. Index is the number of places starting at the last position, so 1 is the last, 2 is second from last, etc.

Example
Set ent = EntLast("Layout1", 2)

Vielleicht kannst Du damit erstmal weiterkommen.

Gruss,

Harry

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

---

Hallo Harry,

schönen Dank für die Hilfe!

Mit sendcommand geht es übrigens auch so:

orgpnt = nBlock.origin

GetInsPoint(0) = orgpnt(0)
GetInsPoint(1) = orgpnt(1)
strorgpnt0 = Replace(orgpnt(0), ",", ".")
strorgpnt1 = Replace(orgpnt(1), ",", ".")
Set blockRefObj = ThisDrawing.ModelSpace.InsertBlock(GetInsPoint, nBlockName, 1#, 1#, 1#, 0)
ThisDrawing.SendCommand "_erase" & vbCr & "l" & vbCr & vbCr
ThisDrawing.SendCommand "-einfüge" & vbCr & nBlockName & vbCr & strorgpnt0 & "," & strorgpnt1 & ",0" & vbCr & vbCr & vbCr & vbCr & "            "

Nach dem Einfügen den Block einmal löschen und sofort wieder einfügen - alles in Ordnung. Funktioniert aber nur unter ACAD 2004, nicht unter 2000/2002.

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