---

Hallo liebe, nette Community.
Habe folgendes Problem:
Ich versuche derzeit auf die Daten(Attribute) eines Mcad(genius) Schriftfeldes mit VB zuzgreifen. Per .GetEntity klappt alles wunderbar (Hier erstmal nur mit Ausgabe der Attribute):

Code:

---

Function GetAttributes2()
   
    Dim target As AcadObject
    Dim pt As Variant
   
    acadApp.ActiveDocument.Utility.GetEntity target, pt, "Bitte ein Objekt auswählen"
         
    Dim oBlock As AcadBlockReference
   
    Set oBlock = target
   
    If oBlock.HasAttributes = True Then
        MsgBox ("Objekt besitzt Attribute")
    Else
        MsgBox ("keine Attribute")
    End If
     
    Dim varAttributes As Variant
    varAttributes = oBlock.GetAttributes
   
    Dim strAttributes As String
    Dim i As Integer
    For i = LBound(varAttributes) To UBound(varAttributes)
        strAttributes = strAttributes & "  Tag: " & varAttributes(i).TagString & _
                        "  Value: " & varAttributes(i).TextString & "    "
    Next
    MsgBox "The attributes for blockReference " & oBlock.Name & " are: " & strAttributes, , "GetAttributes Example"
   
End Function

---

Allerdings will ich einen gewissen Automatismus einbauen:

Code:

---

Function GetGentitle2()
    Dim target As AcadObject
 
    Form1.Text1.Text = acadApp.ActiveDocument.Blocks.Count
    Dim n As Long
    Dim i As Integer
    i = 0
    For n = 0 To acadApp.ActiveDocument.Blocks.Count - 1
        acadApp.ActiveDocument.Utility.prompt (acadApp.ActiveDocument.Blocks(n).Name & vbNewLine)
        If acadApp.ActiveDocument.Blocks(n).Name = "gentitle_abc" Then
            i = i + 1
            Set target = acadApp.ActiveDocument.Blocks(n)
        End If
   
    Form1.Text3.Text = acadApp.ActiveDocument.Blocks(n).ObjectName
   
    Next
    Form1.Text2.Text = i
    If i > 1 Then
        MsgBox "Die Anzahl der 'gentitle_abc' Schriftfelder ist >1." & vbNewLine & "Bitte das Referenz-Schriftfeld auswählen"
        '...
    Else
   
    End If
 
  '########################################################
    Dim oBlock As AcadBlockReference2

    Set oBlock = target    '####!!!!!!  HIER IST DER FEHLER  !!!!!####
   
    If oBlock.HasAttributes = True Then
        MsgBox ("Objekt besitzt Attribute")
    Else
        MsgBox ("keine Attribute")
    End If

    Dim varAttributes As Variant
    varAttributes = oBlock.GetAttributes
   
    Dim strAttributes As String
    Dim m As Integer
    For m = LBound(varAttributes) To UBound(varAttributes)
        strAttributes = strAttributes & "  Tag: " & varAttributes(m).TagString & _
        "  Value: " & varAttributes(m).TextString & vbNewLine
    Next
    MsgBox "The attributes for blockReference " & oBlock.Name & " are: " & strAttributes, , "GetAttributes Example"

End Function

---

Sprich: Die Funktion 'GetGentitle2()' soll das Schriftfeld selber "identifizieren" und wenn es nur ein Schriftfeld gibt eben ausgeben. Ansonsten ist das Referenzschriftfeld auszuwählen (dafür eben die erste Funktion GetAttributes2()).

Wie man sieht versuch ich es über die Blöcke. Allerdings bekomme ich dann Probleme mit den Objekttypen der Blöcke(siehe Markierung "Hier ist der Fehler")

Hab leider noch nicht soviel Ahnung von den Objekttypen/Strukturen in Acad.

Meine eigentlich Frage ist jetzt ob vielleicht jemand Lösung kennt wie ich ohne Manuelle Auswahl an das Schriftfeld oder mehrere in einer Zeichnung herankomme.

Vielen Dank bis hierher, ich hoffe auf Hilfe...

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

---

Sorry! Überflüssiger Beitrag!

Habe jetzt mal nach dem Stichwort "Attribute" gesucht und jede Menge Antworten gefunden...

Tja nächstesmal weiss ich was ich zu tun habe.
Also sorry für die Zeitverschwendung.

Trotzdem noch ein Gruss und Dank an alle die ihr Wissen hier weitergeben.
Hoffe ich komme auch bald in die Lage.

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

---

Nach einigem Rumgemogel und "Thread/Hilfe-Blättern"
hier ein Teilergebnis, nur um den Thread einen Sinn zu geben:

Code:

---

Function getGentitleXyz() As Variant
   
    Dim Cola As Collection
    Dim Objekt As AcadObject
    Set Cola = New Collection

    For Each Objekt In acadApp.ActiveDocument.ModelSpace
       
        If Objekt.ObjectName = "AcDbBlockReference" Then
            If Objekt.Name = "GENTITLE_Xyz" Then
                Cola.Add Objekt
            End If
        End If
   
    Next
   
    Dim BlockRef As AcadBlockReference
    Set BlockRef = Cola(1)

    getGentitle_Xyz = BlockRef.GetAttributes

End Function

---

[Diese Nachricht wurde von bassenc am 01. Jul. 2005 editiert.]

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