| | | Gut zu wissen: Hilfreiche Tipps und Tricks aus der Praxis prägnant, und auf den Punkt gebracht für Autodesk Produkte |
Autor
|
Thema: Attribut mit VBA erstellen und mit Inhalt füllen (1886 mal gelesen)
|
Gregi Mitglied
Beiträge: 274 Registriert: 26.03.2004 Lenovo Thinkpad W701 Intel Core i7 X920 @ 2.00GHz 4 GB RAM NVIDIA Quadro FX 3800M -------------------------------- SolidWorks Prof. 2016 SP1 Autodesk Building Design Suite Ultimate 2015 Rhinoceros 5.0 -------------------------------- Windows 7 Enterprise SP1
|
erstellt am: 02. Dez. 2008 11:37 <-- editieren / zitieren --> Unities abgeben:
Hallo Zusammen, ich habe in meiner Zeichnung einen Block "Pfahl" definiert. Dieser Block enthält neben Zeichnungelementen auch Attribute. Diesen Block füge ich mittels VBA mehrmals in meine Zeichnung ein. Die Frage ist nun, wie kann ich diese Attribute ebenfalls mit VBA mit Werten füllen? Habs noch vergessen...Ergänzend noch die Frage, ob man auch neue Attribute mittels VBA in einen Block einfügen kann? ------------------ Grüßle Gregi [Diese Nachricht wurde von Gregi am 02. Dez. 2008 editiert.] Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
Ex-Mitglied
|
erstellt am: 02. Dez. 2008 12:48 <-- editieren / zitieren -->
Hi, Blockreferenzen haben eine Eigenschaft '.Attributes', diese kann abgefragt werden (so vorhanden) und dann befüllt. Code: dim tBlRef as AcadBlockReference set tBlRef = xxxxx 'da muss Du Deine Blockreferenz einsetzendim tAtts as Variant dim i as Integer tAtts = tBlRef.Attributes For i = lbound(tAtts) to ubound(tAtts) If tAtts(i).TagString = "MEINE_ATTBEZEICHNUNG" then tAtts(i).TextString = "Mein neuer Wert" Exit For End If Next
Ein nachträgliches Hinzufügen von Attributen sollte zuvor in der Blockdefinition gemacht werden (bevor das Einfügen passiert) sonst läufst Du in Gefahr, gleiche Blocktypen mit unterschiedlichen Attributen zu haben - alfred - |
Gregi Mitglied
Beiträge: 274 Registriert: 26.03.2004 Lenovo Thinkpad W701 Intel Core i7 X920 @ 2.00GHz 4 GB RAM NVIDIA Quadro FX 3800M -------------------------------- SolidWorks Prof. 2016 SP1 Autodesk Building Design Suite Ultimate 2015 Rhinoceros 5.0 -------------------------------- Windows 7 Enterprise SP1
|
erstellt am: 02. Dez. 2008 14:05 <-- editieren / zitieren --> Unities abgeben:
Danke für die Antwort, aber ich bekomme es irgendwie nicht hin...habe folgenden Code geschrieben: Code: Sub Bestandsbohrpfahl() Dim Exceltabelle As Object Set Exceltabelle = GetObject(, "Excel.Application") Dim dblRechtswert As Double Dim dblHochwert As Double Dim dblBetrKM As Double Dim i As Integer Dim blockRefObj As AcadBlockReference Dim insertionPnt(0 To 2) As Double For i = 7 To 126 dblRechtswert = CDbl(Exceltabelle.ActiveSheet.Cells(i, 2).value) dblHochwert = CDbl(Exceltabelle.ActiveSheet.Cells(i, 3).value) dblBetrKM = CDbl(Exceltabelle.ActiveSheet.Cells(i, 7).value) insertionPnt(0) = dblRechtswert insertionPnt(1) = dblHochwert insertionPnt(2) = 0 Set blockRefObj = ThisDrawing.ModelSpace.InsertBlock(insertionPnt, "Bestandsbohrpfahl", 1#, 1#, 1#, 0) Dim tAtts As Variant Dim t As Integer 'Set blockRefObj = Bestandsbohrpfahl tAtts = blockRefObj.Attributes For t = LBound(tAtts) To UBound(tAtts) If tAtts(t).TagString = "Betriebskilometer" Then tAtts(t).textString = dblBetrKM Exit For End If Next Next i End Sub
und bei 'tAtts = blockRefObj.Attributes' bekomme ich eine Fehlermeldung, das dieses Objekt diese Eigenschaft nicht unterstützt. Was ist hier verkehrt? ------------------ Grüßle Gregi Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
CADmium Moderator Maschinenbaukonstrukteur
Beiträge: 13508 Registriert: 30.11.2003 Hinweis: Meine Mitarbeit auf CAD.DE ist fakultativ, unentgeltlich und beruht nur auf einem ausgeprägtem Helfersyndrom.
|
erstellt am: 02. Dez. 2008 14:10 <-- editieren / zitieren --> Unities abgeben: Nur für Gregi
die Eigenschaft heißt HasAttributes .. und wenn die True ist, kann man die Methode GetAttributes aufrufen .... in der ACADVBA-Hilfe steht dazu folgendes Beispiel : Code:
Sub Example_GetAttributes() ' This example creates a block. It then adds attributes to that ' block. The block is then inserted into the drawing to create ' a block reference. ' Create the block 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") ' Define the attribute definition 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 = "Attribute Prompt" insertionPoint(0) = 5#: insertionPoint(1) = 5#: insertionPoint(2) = 0 tag = "Attribute Tag" value = "Attribute Value" ' Create the attribute definition object in model space Set attributeObj = blockObj.AddAttribute(height, mode, prompt, insertionPoint, tag, value) ' Insert the block 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 ' Get the attributes for the block reference Dim varAttributes As Variant varAttributes = blockRefObj.GetAttributes ' Move the attribute tags and values into a string to be displayed in a Msgbox 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 " & blockRefObj.name & " are: " & strAttributes, , "GetAttributes Example" ' Change the value of the attribute ' Note: There is no SetAttributes. Once you have the variant array, you have the objects. ' Changing them changes the objects in the drawing. varAttributes(0).textString = "NEW VALUE!" ' Get the attributes Dim newvarAttributes As Variant newvarAttributes = blockRefObj.GetAttributes ' Again, display the tags and values strAttributes = "" For I = LBound(varAttributes) To UBound(varAttributes) strAttributes = strAttributes & " Tag: " & varAttributes(I).TagString & _ " Value: " & varAttributes(I).textString & " " Next MsgBox "The attributes for blockReference " & blockRefObj.name & " are: " & strAttributes, , "GetAttributes Example" End Sub
------------------ - Thomas - "Bei 99% aller Probleme ist die umfassende Beschreibung des Problems bereits mehr als die Hälfte der Lösung desselben." Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
Ex-Mitglied
|
erstellt am: 02. Dez. 2008 14:56 <-- editieren / zitieren -->
sorry, natürlich GetAttributes (und nicht Attributes), danke CADmium Man soll halt doch nicht mehreres gleichzeitig machen - alfred - |
Gregi Mitglied
Beiträge: 274 Registriert: 26.03.2004 Lenovo Thinkpad W701 Intel Core i7 X920 @ 2.00GHz 4 GB RAM NVIDIA Quadro FX 3800M -------------------------------- SolidWorks Prof. 2016 SP1 Autodesk Building Design Suite Ultimate 2015 Rhinoceros 5.0 -------------------------------- Windows 7 Enterprise SP1
|
erstellt am: 02. Dez. 2008 17:52 <-- editieren / zitieren --> Unities abgeben:
|
| Anzeige.:
Anzeige: (Infos zum Werbeplatz >>)
|