Hallo liebe CAD-Gemeinde,
kurz vorab, ich bin erst seit 3 wochen mit VBA und AutoCad vertraut, also bitte nicht gleich schimpfen
Meine Frage/Aufgabe:
Ich möchte an eine mit VBA neu erstellte Blockreferenz mehrere Attribute anhängen. Wenn ich das richtig verstanden habe, dann kann ich beim Erstellen eines Attributes einen Tag(verstehe ich als Name) und einen Value(ZahlenWert, der zum Namen gehört) anhängen. Leider je Attribut nur je einen. Ich möchte aber an eine Blockreferenz mehrere Attribute anhängen(zB Reihe 21, TeilNr 12, Blatt 7), um den einzelnen Block später aus einer Vielzahl von Blöcken wieder eindeutig herausfinden zu können. Ich habe mal mit hilfe von alten Beiträgen ein wenig rumprobiert(siehe Anhang). Habe ich das jetzt richtig gemacht, dass ich 3 mal ein Attribut angehängt habe, oder gibt es da noch ne andere Möglichkeit? Kann ich diese Attribute später auch wieder mit VBA auslesen und evtl sogar in Excel expotieren?
schon mal Danke für die Hilfe!!!
Mein erster Versuch:
Sub Attributes()
Dim A, B, C As Integer
A = 243 ' sollen später aus Excel Datei kommen
B = 26
C = 5
' Blockdefinition anlegen
Dim blockObj As AcadBlock
Dim Radius As Double
Dim N As Integer
Dim Kreis As AcadCircle
Dim insertionPnt(0 To 2) As Double
Radius = 2
insertionPnt(0) = 5: insertionPnt(1) = 5: insertionPnt(2) = 0
Set blockObj = ThisDrawing.Blocks.Add(insertionPnt, "Kreis")
Set Kreis = blockObj.AddCircle(insertionPnt, Radius)
Kreis.color = 90
' 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(0 To 2) As String
Dim value(0 To 2) As String
height = 1
mode = acAttributeModeInvisible
prompt = ""
insertionPoint(0) = 4: insertionPoint(1) = 4: insertionPoint(2) = 0
tag(0) = "KreisNr"
tag(1) = "BlattNr"
tag(2) = "ReiheNr"
value(0) = A
value(1) = B
value(2) = C
' Create the attribute definition object in model space
Set attributeObj = blockObj.AddAttribute(height, mode, prompt, insertionPoint, tag(0), value(0))
Set attributeObj = blockObj.AddAttribute(height, mode, prompt, insertionPoint, tag(1), value(1))
Set attributeObj = blockObj.AddAttribute(height, mode, prompt, insertionPoint, tag(2), value(2))
' Einfügen der Blockreference
Dim blockRefObj As AcadBlockReference
insertionPnt(0) = 2: insertionPnt(1) = 2: insertionPnt(2) = 0
Set blockRefObj = ThisDrawing.ModelSpace.InsertBlock(insertionPnt, "Kreis", 1, 1, 1, 0)
ZoomAll
' Auslesen der Attribute
Dim varAttributes As Variant
varAttributes = blockRefObj.GetAttributes
' Attribute in einen String schreiben, damit man Sie mit einer MsgBox ausgeben kann
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 "Die Attribue vom Block " & blockRefObj.Name & " sind: " & strAttributes, , "Infokasten (Da kann man mal schauen, ob das Teil auch funktioniert)"
End Sub
mfg Frank
------------------
Wenn das Wasser bis zum Hals steht, sollte man den Kopf nicht hängen lassen...
Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP
Foren auf CAD.de
| 
