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
Foren auf CAD.de
| 
