---

Hallo Zusammen,

zum Ausfüllen von Attributen im Autocad, brauche ich eure Hilfe. Da bei uns kein VBA für Autocad/Mechanical installiert und soll auch nicht gemacht werden. Daher meine Überlegung, daß das VBA vom Excel (365 falls es von Wichtigkeit ist) hier einspringen soll.
Im Forum habe ich auch schon viele Stunden gestöbert und die Sachen ausprobiert. Leider mit dem Ergebnis, daß Parameter und Befehle nicht verstanden werden.
Die Daten zum Ausfüllen liegen im Excel vor, und sollen in die vorhandenen Attributsfelder des Blockes eingeschrieben werden. Dieser Block ist nur 1x im CAD vorhanden. Die Daten aus dem Excel auszulesen ist für mich kein Problem,nur die Übergabe in die Attributsfelder.
Der Block heißt: rohrtabelle
Ein Atribut heißt : Rohrdurchmesser
Diesen will ich mit dem Wert 21.3 füllen
Dazu habe ich aus mehreren Beiträgen einen Programmcode geschrieben, welcher nicht funktioniert . Könnt ihr mir bitte die Fehler darin aufzeigen, damit ich hier zu einer Lösung komme?

Code:

---

Sub Rohrtabelle()
    'Declaring the necessary variables.
    Dim acadApp As AcadApplication
    Dim acadDoc As AcadDocument
    Dim blockObj As AcadBlock
    Dim insertionPnt(0 To 2) As Double
    Dim attributeObj As AcadAttribute
    Dim tag As String
    Dim value As String
    Dim tAtts As Variant
    Dim i As Integer
    'Check if AutoCAD is open.
    On Error Resume Next
    Set acadApp = GetObject(, "AutoCAD.Application")
    On Error GoTo 0
    'If AutoCAD is not opened create a new instance and make it visible.
    If acadApp Is Nothing Then
        Set acadApp = New AcadApplication
        acadApp.Visible = True
    End If
    'Check if there is an active drawing.
    On Error Resume Next
    Set acadDoc = acadApp.ActiveDocument
    On Error GoTo 0
   
    'No active drawing found. Create a new one.
    If acadDoc Is Nothing Then
        Set acadDoc = acadApp.Documents.Add
        acadApp.Visible = True
    End If
    insertionPnt(0) = 0#: insertionPnt(1) = 0#: insertionPnt(2) = 0#
    Set blockObj = acadDoc.Blocks.Item("rohrtabelle")
  ' Create the attribute definition object in model space
  For i = LBound(tAtts) To UBound(tAtts)
    If tAtts(i).TagString = "Rohrdurchmesser" Then
      tAtts(i).TextString = "21.3"
      Exit For
  End If
Next
End Sub

---

Gruß Acaduser84

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

---

Hallo Acaduser84, Willkommen im  Forum 

Habe zwar gerade kein Autocad bei der Hand aber vielleicht auf die Schnelle ein paar Hinweise.

Zunächst schreibst Du Du hast eine Autocadzeichnung die den Block "Rohrtabelle" enthält. Im Programm überprüfst Du zwar ob eine Autocadzeichnung geöffnet ist, falls nicht wird einfach eine neue Zeichnung geöffnet. Stellt sich mir natürlich gleich die Frage ob der Block in der Standardvorlage enthalten ist.

Dann holst Du Dir die Blockdefinition und möchtest das Attribut der Definition ändern ohne zu überprüfen ob der Block überhaupt Attribute hat. Hier scheint es am grundsätzlichen Blockverständnis zu fehlen.

Zunächst mußt Du einmal unterscheiden zwischen dem AcadBlock, das ist praktisch die Bauanleitung, und der AcadBlockReference, das ist das was Du in der Zeichnung siehst. Die Blöcke sind in der Blocks-Section gespeichert, die BlockReferencen im Modellspace oder den Layouts.

Wenn Du also den Block sehen möchtest mußt Du zunächst den Block als BlockReference in die Zeichnung eintragen (set oBlockRef = AcadDoc.ModellSpace.InsertBlock(InsertionPoint, Name, Xscale, Yscale, ZScale, Rotation [, Password]) ) oder den ModellSpace (evtl. auch Layout) untersuchen ob bereits die BlockReference eingetragen ist.

Dann überprüfst Du ob die BlockReference Attribute hat ( if oBlockRef.HasAttributes ), und holst Dir die Attribute ( tAtts = oBlockRef.GetAttributes ). Jetzt kannst Du den Wert wie programmiert ändern.

Willst Du wirklich die Blockdefinition wie in Deinem Code ändern, müßtest Du die Block.item - Collection durchlaufen und untersuchen ob das Item ein AcadAttribute ist. Dann vergleichst Du den Tagstring des AcadAttributes und änderst den Textstring. Beim nächsten Einfügen dieses Blockes in die Zeichnung (als BlockReference) hätte dann jeder eingefügte Block bereits diesen Wert. Kann bei selten veränderbaren Werten (z.B. Firmenname im Planstempel) sinnvoll sein, in Deinem Fall des Rohrdurchmessers aber wohl nicht nötig da jede Leitung unterschiedliche Werte haben wird.

So weit eine kurze Einführung, jetzt kommt es darauf an was Du wirklich machen möchtest, die Bauanleitung ändern oder ein bestimmtes Zeichnungselement?

Grüße
Klaus 

selber erstellst Du aber diesen Block

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

---

Zusatz:
Ich denke die Beschreibung ist klar: Es sollen Attributwerte eingetragen werden,
also wird vom Code her an der falschen Stelle geschaut. Gesucht ist die Blockreferenz mit (vielleicht) anhängenden Attributen und vielleicht ist das gesuchte dabei.

Die Us bekommt Klak morgen, geht aktuell nicht :-)

@TO
Auch wenn es nicht das ActiveX Modell zeigt, die Infos zu Block Blockreferenz, Attributdefinition und Attributen trifft dennoch zu:
http://ww3.cad.de/foren/ubb/Forum54/HTML/013223.shtml

Schaden kann es ja nicht.

------------------
CAD on demand GmbH - Beratung und Programmierung rund um AutoCAD

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

---

Moin, das geht so nicht     
Also du öffnest über VBA Autocad *grinst* Sag mal euren IT Fuzzies, sie sollen mal alle MS Produkte die VBA enthalten deinstallieren... (Was die da treiben ist grober Unfug der VBA Enabler greift auf die selben DLLS zurück) aber egal.

2. Das eingebaute Daten extraction TOOL sollte den Job auch erledigen.
Aber wir wollen ja scripten...

Wir haben ein Autocad dokument und wollen Attribute extrahieren....

1.) alles in Autocad und vba ist ein Block.
dim block as cadblock
dim entity as acadentity
Also mit
for ech block in this drawing
for each entity in block
debug.print entity.objectname
next
next
kommt man an jedes Autocad element ran...
Nur nicht an Blockattribute
Wenn man sich das ganze mal quer durchs Hirn schießen lässt wird klar, das BLOCKREFERENZEN ja nur abbilder von Blöcken sind.
Und weiterhin das wenn solche Abbilder infos enthalten sollen die Kopiespeziefisch sind wohl jede Referenz eine eigene braucht. - DEM IST SO !

Machen es wir mal nicht wissenschaftlich (Blöcke könne Blöcke enthalten etc)

Wir nehmen mal an der Kram lungert nur im Modelspace rum...

'die  funktion funzt !!!!!

Function block_get_attribute(blo As AcadBlockReference, tagname, Optional found As Boolean = False) As String
    Dim attlist As Variant
    On Error Resume Next
    If blo.hasattributes Then
        attlist = blo.GetAttributes
        For i = LBound(attlist) To UBound(attlist)
            If UCase(attlist(i).TAGSTRING) = tagname Or UCase(Trim(attlist(i).TAGSTRING)) = tagname & "_001" Then
                block_get_attribute = attlist(i).textString
                found = True
                Exit Function

            End If
        Next
    End If
End Function

sub xyz (BLOCKNAME as STRING, TAGNAME as STRING)'einfach mal ins unreine getippt
dim entity as acadentity
dim BLOCKREF as acadblockreferece

'tagname="Object_der_Begierde"
For ech entity in thisdrawing.modelspace

if lcaseblockref.objectname) = "acdbblockreference" then
SET BLOCKREF=ENTITY
'damit kommen wir an das Abbild ran
if blockref.effectivename=BLOCKNAME then
'für den fall das ein spezieller Block gesucht wird
debug.print block_get_attribute(blockref,tagname)

end if
end if

end sub

So kommt man an soetwas ran     

Das hier bracuhen wir nicht:
'No active drawing found. Create a new one.
    If acadDoc Is Nothing Then
        Set acadDoc = acadApp.Documents.Add
        acadApp.Visible = True
    End If
    insertionPnt(0) = 0#: insertionPnt(1) = 0#: insertionPnt(2) = 0#
    Set blockObj = acadDoc.Blocks.Item("rohrtabelle")
  ' Create the attribute definition object in model space
** da wird nichts erzeugt... da wird abgefargt.
Nutzt nur nix, da keien Blockreferenz gesetze wurde

  For i = LBound(tAtts) To UBound(tAtts)
    If tAtts(i).TagString = "Rohrdurchmesser" Then
      tAtts(i).TextString = "21.3"
      Exit For
  End If
Next

Set blockObj = acadDoc.Blocks.Item("rohrtabelle")
*damit öffnet man einen Blcok zu SCHREIBEN...

Ich hab hier mal einige Module zu dem Thema Blockreferenzen gepostet. Die erschlagen so ziemlich alles (fast) .
Es mag Mühe bereiten die hier zu finden. Nur dürfte das durchaus der Mühe Wert sein :="

Lieben Gruß Thomas
P.S. nu krieg ich wieder ne Abmahnung wegen Spachstiel etc     
Egal - hoff es hilft     

------------------
Wer es nicht versucht, hat schon verlorn     
Und bei 3 Typos gibts den vierten gratis !
<<< for sale !

[Diese Nachricht wurde von rexxitall am 14. Mai. 2017 editiert.]

[Diese Nachricht wurde von rexxitall am 14. Mai. 2017 editiert.]

[Diese Nachricht wurde von rexxitall am 14. Mai. 2017 editiert.]

[Diese Nachricht wurde von rexxitall am 14. Mai. 2017 editiert.]

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

---

Hallo Thomas,
Hast Du schon mal eine Abmahnung wegen Sprachstil bekommen ? 

Leider wissen wir ja (noch) nicht was Acaduser84 wirklich vor hat, will er einen neuen Block mit einem Attribut aus Excelwerten erstellen oder neue Blockreferenzen mit vorgegebenen Werten aus der Exceltabelle füllen oder bestehende Blockreferenzen mit Werten aus Excel füllen. Im letzteren Fall ist die angesprochene Datenextraktion sicher eine gangbare einfache Alternative.

Aber so wie das geschrieben war fehlt es ja am grundsätzlichen Verständnis des Acad Objektmodells, dshalb mein ausführlicher Text oben. Ansonsten hätte man auch einfach auf die Autocad Hilfe verweisen können. Dort ist das ja eigentlich recht schön beschrieben.

Schönes WE
Klaus 

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

---

servus

http://ww3.cad.de/foren/ubb/Forum54/HTML/026881.shtml#000001

------------------
<----- Bitte Systeminfo eintragen, warum siehst du hier. Schöne Grüsse aus der Steiermark  Bernd P.

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

---

Hallo KlaK,

warum weißt du nicht was ich vorhabe? Es ist oben alles beschrieben. Das der Programmcode so nicht funktioniert habe ich bereits erwähnt.Dort habe ich aus einigen Quellen etwas zusammenkopiert, in der Hoffnung daß es klappt.
Den Verweis auf die Autocad Hilfe ist zwar schön, aber der Server ist für mich nicht erreichbar.
nun schreibe ich mein Problem noch mal, hoffentlich etwas verständlicher:
- Autocad ist geöffnet
- der Block "rohrtabelle" ist im Modellbereich 1x eingefügt, die Attributsfelder sind über Autocad ausfüllbar
- Excel VBA soll nun diese Felder ausfüllen.
Gruß Acaduser84

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

---

Sorry mein Fehler ich sollte mehr schreiben Attributtext ändern bei Skript-Programmierung.

------------------
<----- Bitte Systeminfo eintragen, warum siehst du hier. Schöne Grüsse aus der Steiermark  Bernd P.

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

---

@Bernd: Ich glaube nicht dass Acaduser84 mit der Lisp so etwas anfangen kann auch wenn es zum ändern eines Attributes eines Blockes eine einfache Möglichkeit wäre.

Zitat:

---

Original erstellt von Acaduser84:
Hallo KlaK,
warum weißt du nicht was ich vorhabe? Es ist oben alles beschrieben. Das der Programmcode so nicht funktioniert habe ich bereits erwähnt.Dort habe ich aus einigen Quellen etwas zusammenkopiert, in der Hoffnung daß es klappt.

---

Wie bereits oben beschrieben, Du hast immer nur von Block in der Zeichnung geschrieben, nie davon dass dieser bereits in die Zeichnung als Blockreferenz eingefügt ist. Nun gut, jetzt wissen wir mehr. Es gibt also eine Blockreferenz in der Zeichnung.

Vielleicht noch ein Hinweis für zukünftige Anfragen:
- Es ist immer günstiger eine Beispielzeichnung und Beispielarbeitsmappe mit beizulegen. Diese sollten natürlich nicht Test.dwg genannt werden, da der Anhang bei hochladen der nächsten Test.dwg ohne Rückfrage überschrieben würde. Sinnvoll hat sich hier der Zusatz eines Datums erwiesen (2017-05-15_Test.dwg)
- Je genauer der Fehler beschrieben wird umso einfacher ist die Fehlerfindung.
Man könnte z.B. im Code angeben ' <= Hier Abbruch, Fehler xxx Block ist keine Blockreferenz
Oder sonstige Fehlermeldungen (vermutlich kein Zugriff auf Autocad oder ähnliches)

Zitat:

---

Original erstellt von Acaduser84:
Den Verweis auf die Autocad Hilfe ist zwar schön, aber der Server ist für mich nicht erreichbar.

---

Erstaunlich denn egal von welchem PC ich den Link anklicke, es kommen immer die gleichen Hilfeseiten.
Evtl. mal mit dem Netzadmin besprechen ob es da Routersperren gibt. Die Hilfeseiten von Autodesk.com sollten schon zugängig sein.

Zitat:

---

Original erstellt von Acaduser84:

---

Dann versuchen wir mal unser Glück ...
Frage zuvor:
Du hast unter Excel Visual Basic
unter Extras - Verweise
die Autocad 20xx Type Library aktiviert? Ohne die geht nichts

Ich habe Deinen Code einmal geändert:

Code:

---

Sub Rohrtabelle()
    'Declaring the necessary variables.
    Dim acadApp As AcadApplication
    Dim acadDoc As AcadDocument
''    Dim blockObj As AcadBlock   ' <= hier nicht erforderlich
    Dim blockRefObj As AcadBlockReference   ' <= das hier brauchen wir
''    Dim insertionPnt(0 To 2) As Double      ' <= könnte auch entfallen
''    Dim attributeObj As AcadAttribute       ' <= könnte auch entfallen
''    Dim tag As String      ' <= wird nicht verwendet
''    Dim value As String      ' <= wird nicht verwendet
    Dim tAtts As Variant
    Dim i As Integer
    Dim Ent As AcadObject     ' <= Hätte man nicht deklarieren brauchen aber so werden die Eigenschaften beim Programmieren angezeigt
    'Check if AutoCAD is open.
    On Error Resume Next
    Set acadApp = GetObject(, "AutoCAD.Application")
    On Error GoTo 0
    'If AutoCAD is not opened create a new instance and make it visible.
    If acadApp Is Nothing Then
''        Set acadApp = New AcadApplication    ' <= Ich denke Autocad ist offen, warum nochmal öffnen?
''        acadApp.Visible = True
      ' anstatt dessen: Hinweis für den Benutzer Voraussetzungen fürs Programm schaffen
      MsgBox "Bitte zunächst Autocad mit Zeichnung öffnen", vbCritical, "Fehler Zugriff auf Autocad"
      ' und Programm beenden
      Exit Sub
    End If
    'Check if there is an active drawing.
    On Error Resume Next
    Set acadDoc = acadApp.ActiveDocument
    On Error GoTo 0
    'No active drawing found. Create a new one.  ' <= Warum Neue??
    If acadDoc Is Nothing Then
''        Set acadDoc = acadApp.Documents.Add
''        acadApp.Visible = True
      ' Hinweis für den Benutzer Voraussetzungen fürs Programm schaffen
      MsgBox "Bitte zunächst Autocad mit Zeichnung öffnen", vbCritical, "Fehler Zugriff auf Zeichnung"
      ' und Programm beenden
      Exit Sub
    End If
''    ' <= Nachfolgende Zeilen wären nur nötig wenn ein neuer Block eingefügt wird
''    insertionPnt(0) = 0#: insertionPnt(1) = 0#: insertionPnt(2) = 0#
''    Set blockObj = acadDoc.Blocks.Item("rohrtabelle")
''  ' Create the attribute definition object in model space  ' Hier wird nicht erzeugt!
''  ' Durchsuchen der Zeichnung, Wir gehen von einer Einfügung im Modell aus
   For Each Ent In acadDoc.ModelSpace
     If Ent.ObjectName = "AcDbBlockReference" Then
       Set blockRefObj = Ent
       If blockRefObj.Name = "Rohrtabelle" Then
         If blockRefObj.HasAttributes Then
           tAtts = blockRefObj.GetAttributes
           ' Jetzt passt Dein Code
           For i = LBound(tAtts) To UBound(tAtts)
             If tAtts(i).TagString = "ROHRDURCHMESSER" Then  ' Tag sind immer groß geschrieben
               tAtts(i).TextString = "21.3"
               Exit For
             End If
''            ' Alternativ :
''            Select Case tAtts(i).TagString
''              Case "ROHRDURCHMESSER": tAtts(i).TextString = Cells(5, 3) ' Zelle C5
''              Case "ROHRMATERIAL": tAtts(i).TextString = Cells(5, 2) ' Zelle B5
''            End Select
           Next i  ' auch wenn einige es ohne machen, es ist immer sinnvoll die Laufvariable mit anzugeben
                   ' erhöht Lesbarkeit und Fehlersuche in größeren Programmen
           blockRefObj.Update  ' Damit es auch sichbar wird
         Else
           MsgBox "Block Rohrtabelle hat keine Attribute", vbOKOnly
         End If
       End If
     End If
   Next Ent
End Sub

---

Grüße
Klaus  

[Diese Nachricht wurde von KlaK am 15. Mai. 2017 editiert.]

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

---

Hallo KlaK,

SUPER, der Code funktioniert genau wie ich es brauche und mir wünschte.
Vielen Dank auch an alle, welche hier ihre Unterstützung mit Beiträgen geliefert haben.

Gruß Acaduser84 

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

---

Zur Ergänzung:
Natürlich könnte man das Programm auch schneller machen indem man zunächst einen Filter (SelectionSet) definiert und dann nur die BlockReferenz mit entsprechenden Namen untersucht. Dürfte aber erst ab ca. 20000 Zeichnungselementen wirklich spürbar werden.

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