---

Hallo VBA-Freunde,

da ich sehr unbeholfen mit der Programmierung bin, und im Excel-Forumsberich nur bedingt weitergekommen bin,
bitte ich euch hier um Hilfe.

Programstatus:
-Excel öffnet Zeichnung <-OK
-Acad aus Zielblock auslesen <- 
-Acad in Zielblock schreiben <- 
-Acad Zeichnung schließen <-OK

Ich hoffe das mir hier wer helfen kann!

------------------
mfg Ronald

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

---

Hallo Ronald,
Dein Stenostil ist wohl etwas für Insider ...
So ganz ist mir nicht klar was Du genau machen möchtest.

Ich gehe mal davon aus, Du hast ein Tabellenblatt mit irgendwelchen Attributen (welche? Bedeutung?) die Du zu irgendwelchen Blöcken zuordnen möchtest.
Oder sollen die Blöcke neu erstellt werden? Aktualisiert (mit welcher Referenz)?

Es ist immer günstiger eine genauer Beschreibung anzugeben, noch besser Codeschnipsel (oder Beispielzeichnung, ~tabelle) bei denen Du nicht weiterkommst. Aber hier haben die wenigsten Lust auf Ratespiele 

Grüße
Klaus 

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

---

Nachdem im Fernseh nichts kam und ich noch nicht müde war bin ich doch mal Deinem Link gefolgt und habe die ZIP-Datei gefunden. OK, da hast Du ja schon Deine Versuche mitgeliefert.

Im Prinzip mußt Du in Deinem Code gar nicht viel verändern.
Im Versuch 2 solltest Du doch schon ganz gute Ergebnisse bekommen haben, nur müßtest Du anstelle des festen Textes Deinen Zellenwert übergeben.

Im Versuch 3 schaut es noch besser aus, nachdem ich aber meine HomeUse noch nicht verlängert habe, konnte ich den Code nicht testen. Welche Schwierigkeiten gab es denn?

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

---

Hallo Klaus,

Bei Versuch 3 muss ich den Block im ACAD auswählen (ich kenne aber den Blocknamen!)
weiters werden nur die Attributenamen ins Excel geschrieben und das dazu noch in Spalte "A" und Zeile "2"
obwohl mein Auswahlfeld der Zeichnung auf Spalte "AF"  und Zeile "9" und die Attribute ab Spalte "AH" beginnen sollten.

------------------
mfg Ronald

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

---

Also bei mir macht es Dein Programm (mit kleinen Änderungen  )

zunächstmal: Warum hast Du denn die Autocad/ObjectDBX .. Type Library in den Verweisen aktiviert ?
bei mir hat diese verhindert, dass dem bl das Element aus dem ssgetObj zugewiesen werden konnte.

Dann habe ich noch ein Element dazugefügt (unter dim bl)
          Dim ent As AcadEntity

Mir ist eine for each Abfrage lieber
            ' For s = 0 To ssetObj.Count - 1
            For Each ent In ssetObj
              If ent.ObjectName = "AcDbBlockReference" Then
              Set bl = ent 'Set bl = ssetObj.Item(s)
              ...
              End If
            Next ent

Unwesentlich aber vielleicht hilfreich:
                ' ActiveCell.FormulaR1C1 = acad.ActiveDocument.FullName ' falsch ergibt Fehler
                ActiveCell.FormulaR1C1 = acad.FullName '<= Programmname : "Acad"
                ActiveCell.FormulaR1C1 = acad.Caption '= Zeichnungsname

Dann zur Zelle:
                z = Asc("AJ") ' < = falsch! z bekommt nur den Wert von "A" also 65
                ' besser wäre über die Cells(reihe, spalte) Eigenschaft zuzugreifen
                ' "AJ" = 26+10 = 36
                z = 36
Und zum Block:
                For k = LBound(attr) To UBound(attr)
                  Cells(j + 1, z).Select ' Range(Chr(z) + Trim(Str(j + 1))).Select
                  ActiveCell.FormulaR1C1 = attr(k).TagString
                  z = z + 1
                  Cells(j + 1, z).Select ' Range(Chr(z) + Trim(Str(j + 1))).Select
                  ActiveCell.FormulaR1C1 = attr(k).TextString
                  z = z + 1
                Next k

Viel Spaß beim Basteln 

Klaus 

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

---

Hallo Klaus,

Deine Tips habe ich jetzt eingebaut.
Habe noch drei Probleme beim Auslesen der Blöcke
1. möcht ich statt

Code:

---

ssetObj.SelectOnScreen gpCode, dataValue

---

einen Blocknamen ansprechen (zb. Schrifkopf)
2. wenn eine andere Zeichnung ausgewählt wird (zb. eine Zeile weiter unten), werden die Daten trotzdem in die gleichen Felder geschrieben
3. wenn ich mehrere Zeichnungen in meinem Excel auswähle dann wird nur die erste gemacht (da verliert der Counter etwas)

Aktueller Code:

Code:

---

Public Sub ACAD_TO_EXCEL()

'Option Explicit
'Public Tatts As Variant
'Public Tatts2 As Variant
'Public Tatts3 As Variant
'Public count2 As Integer
'
'Public ssnew As Object
'Public Merker As Integer
'Public Auswahlsatz1 As Integer
'Public excelapp As Object
'Public wbkObj As Object
'Public shtObj As Object
'Dim gtotal As Integer

Dim Tatts As Variant
Dim Tatts2 As Variant
Dim Tatts3 As Variant
Dim count2 As Integer

Dim ssnew As Object
Dim Merker As Integer
Dim Auswahlsatz1 As Integer
Dim excelapp As Object
Dim wbkObj As Object
Dim shtObj As Object
Dim gtotal As Integer

On Error Resume Next
'Dim tAcadApp As AcadApplication
Dim tAcadApp As Object
Set tAcadApp = GetObject(, "AutoCAD.Application") 'verbindet sich mit AutoCAD, wenn dieses schon laeuft
If tAcadApp Is Nothing Then
  'dann laeuft noch keine AutoCAD-Session ==> also eine starten
  Set tAcadApp = CreateObject("AutoCAD.Application")
End If

If tAcadApp Is Nothing Then
  'dann Fehlermeldung ausgeben, AutoCAD kann nicht gestartet werden
Else
  tAcadApp.Application.WindowState = acMax
  tAcadApp.Visible = True
  tAcadApp.Documents.Close
 
  '..... Dein Code, jetzt hast Du AutoCAD in der Hand
 

    Dim AngBracDwg As String
    Dim Schriftkopf1 As String
    Dim Schriftkopf2 As String
    
    Schriftkopf1 = Cells(7, 26 + 8).Text 'glaub da stimmt was net
    
    For I = 1 To Selection.Count
    AngBracDwg = Selection.Item(I).Text
    tAcadApp.Documents.Open (AngBracDwg)
    '.................................................................................................................
''          Versuch 3
          Dim tempObj As AcadObject
          Dim gpCode(0) As Integer
          Dim dataValue(0) As Variant
          Dim ssetObj As AcadSelectionSet
          Dim bl As AcadBlockReference
          Dim ent As AcadEntity
          Dim ip(0 To 2) As Double
          Dim s, j, k, z As Long
          Dim attr As Variant

          autocad_gestartet = True
          On Error Resume Next
          Set cad = GetObject(, "AutoCAD.Application")
          If Err.Number <> 0 Then
            Err.Clear
            MsgBox "AutoCAD ist nicht gestartet", vbOKOnly, "Fehler"
            Exit Sub
          End If
          Set acad = cad

          If IsNull(acad.ActiveDocument) Then
            MsgBox "Keine Zeichnung geöffnet", vbOKOnly, "Fehler"
            Exit Sub
          End If

          gpCode(0) = 0
          dataValue(0) = "Insert"

          Set ssetObj = acad.ActiveDocument.SelectionSets.Add("SS2")

          AppActivate acad.Caption
          ssetObj.SelectOnScreen gpCode, dataValue

    Dim filtertype(0 To 1) As Integer
            Dim filterdata(0 To 1) As Variant
            filtertype(0) = 0: filterdata(0) = "insert"
            filtertype(1) = 2: filterdata(1) = Schriftkopf1
            ssetObj.Select acSelectionSetAll, , , filtertype, filterdata

'          thisdrawing.Utility.GetString (schriftkofp1)
'
'          If Objekt.EntityName = "AcDbBlockReference" Then 'Block?
'          If Objekt.name = Schrifkopf1.Text Then 'Blockname
'          If Objekt.HasAttributes Then
'          End If

          AppActivate Application.Caption

          j = Selection.Count  '<--geändert
          If ssetObj.Count > 0 Then
'          'Mir ist eine for each Abfrage lieber
'            ' For s = 0 To ssetObj.Count - 1
'            For Each ent In ssetObj
'              If ent.ObjectName = "AcDbBlockReference" Then
'              Set bl = ent 'Set bl = ssetObj.Item(s)
'              ...
            For s = 0 To ssetObj.Count - 1
              Set bl = ssetObj.Item(s)
              If bl.HasAttributes = True Then
'                Range("AG" + Trim(Str(j + 1))).Select
'                ActiveCell.FormulaR1C1 = acad.ActiveDocument.FullName
'                Range("AH" + Trim(Str(j + 1))).Select
'                ActiveCell.FormulaR1C1 = bl.Handle
'                Range("AI" + Trim(Str(j + 1))).Select
'                ActiveCell.FormulaR1C1 = bl.name
                attr = bl.GetAttributes
                'Dann zur Zelle:
'                z = Asc("AJ") ' < = falsch! z bekommt nur den Wert von "A" also 65
                ' besser wäre über die Cells(reihe, spalte) Eigenschaft zuzugreifen
                ' "AJ" = 26+10 = 36
                z = 34
'                z = Asc("AJ")
                'Und zum Block:
                For k = LBound(attr) To UBound(attr)
'                  Cells(j + 1, z).Select ' Range(Chr(z) + Trim(Str(j + 1))).Select
'                  ActiveCell.FormulaR1C1 = attr(k).TagString
'                  z = z + 1
'                  Cells(j + 1, z).Select ' Range(Chr(z) + Trim(Str(j + 1))).Select
'                  ActiveCell.FormulaR1C1 = attr(k).TextString
'                  z = z + 1
'
                  Cells(8, z).Select ' Range(Chr(z) + Trim(Str(j + 1))).Select
                  ActiveCell.FormulaR1C1 = attr(k).TagString
'                  z = z + 1
                  Cells(j + 8, z).Select ' Range(Chr(z) + Trim(Str(j + 1))).Select
                  ActiveCell.FormulaR1C1 = attr(k).TextString
                  z = z + 1

                Next k
'                For k = LBound(attr) To UBound(attr)
'                  Range(Chr(z) + Trim(Str(j + 1))).Select
'                  ActiveCell.FormulaR1C1 = attr(k).TagString
'                  z = z + 1
'                  Range(Chr(z) + Trim(Str(j + 1))).Select
'                  ActiveCell.FormulaR1C1 = attr(k).TextString
'                  z = z + 1
'                Next k
                j = j + 1
              Else
                MsgBox "Gewählte Blöcke haben keine Attribute!", vbOKOnly, "Meldung"
              End If
            Next s
          Else
            MsgBox "Keine Blöcke gewählt!", vbOKOnly, "Meldung"
          End If
          ssetObj.Delete

   

'.................................................................................................................
    tAcadApp.Documents.Close
'    tAcadApp.Visible = flase
   
    Next

     
End If
'Cells(1, 1).Select
End Sub

---

Problem 1 habe ich schon gelöst
------------------
mfg Ronald

[Diese Nachricht wurde von KAME am 04. Apr. 2013 editiert.]

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

---

zu 2. wenn eine andere Zeichnung ausgewählt wird (zb. eine Zeile weiter unten), werden die Daten trotzdem in die gleichen Felder geschrieben:

Du verwendest für die Cells immer (j+1,z) hast aber als Schleifenzähler I
ersetze doch einfach die Zeile : j = Selection.Count  '<--geändert
mit: j=I

zu 3. wenn ich mehrere Zeichnungen in meinem Excel auswähle dann wird nur die erste gemacht
(da verliert der Counter etwas)
=> Dachte ich mir schon, aber Deine ersten Fragen war ja auf Acad bezogen 

Schriftkopf1 = Cells(7, 26 + 8).Text 'glaub da stimmt was net
=> ist doch der Name des Blockes aus Zelle "AH,7", sollte passen, evtl. hier auch "mitrutschen"
man könnte sich auch ein Funktion schreiben, die den Spaltenwert umrechnet
z.B. für "AH":  (ASC("A")-64) * 26 + ASC("H") - 64
und bekommt sofort 34 als Ergebnis

ABER : Beobachte mal was Deine Selection macht
Jedesmal wenn Du ein cells().select machst ändert sie den Wert, wandert mit ...
Du kannst doch die Werte auch ohne cells().select in die entsprechenden Zellen schreiben
also z.B.   Cells(j + 1, z).Text = attr(k).TagString

Ist immer günstig für solche Fälle die Variable im Überwachungsfenster zu beobachten

Grüße
Klaus  

[Diese Nachricht wurde von KlaK am 04. Apr. 2013 editiert.]

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

---

Hallo Klaus,

da mir heute der kopf schon raucht werd ich das morgen probieren

------------------
mfg Ronald

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

---

Hallo Klaus,

Sieht gut aus die hälfte meines Programms funktionier schon
Bin jetzt soweit das ich alle daten auslesen kann

Teil 2 sollte vorhandene daten in die Zeichnungen schreiben

hier mal ein entwurf / ab 'Block 1 funktioniert er nicht richtig

Code:

---

Dim AngBracDwg As String
    Dim Schriftkopf1 As String
    Dim Schriftkopf2 As String
   
    Schriftkopf1 = Cells(3, 26 + 6).Text
    Schriftkopf2 = Cells(5, 26 + 6).Text
   
    For i = 1 To Selection.Count
    AngBracDwg = Selection.Item(i).Text
    tAcadApp.Documents.Open (AngBracDwg)
   
 

'.................................................................................................................

          Dim tempObj As AcadObject
          Dim gpCode(0) As Integer
          Dim dataValue(0) As Variant
          Dim ssetObj As AcadSelectionSet
          Dim bl, bl2 As AcadBlockReference
          Dim ent, ent2 As AcadEntity
          Dim ip(0 To 2) As Double
          Dim x, s, t, j, k, m, n, y, z As Long
          Dim attr As Variant

          autocad_gestartet = True
          On Error Resume Next
          Set cad = GetObject(, "AutoCAD.Application")
          If Err.Number <> 0 Then
            Err.Clear
            MsgBox "AutoCAD ist nicht gestartet", vbOKOnly, "Fehler"
            Exit Sub
          End If
          Set acad = cad

          If IsNull(acad.ActiveDocument) Then
            MsgBox "Keine Zeichnung geöffnet", vbOKOnly, "Fehler"
            Exit Sub
          End If

          gpCode(0) = 0
          dataValue(0) = "Insert"

          Set ssetObj = acad.ActiveDocument.SelectionSets.Add("SS2")

          AppActivate acad.Caption

'.................................................................................................................
'Block 1
            Dim filtertype1(0 To 1) As Integer
            Dim filterdata1(0 To 1) As Variant
            filtertype1(0) = 0: filterdata1(0) = "insert"
            filtertype1(1) = 2: filterdata1(1) = Schriftkopf1
            ssetObj.Select acSelectionSetAll, , , filtertype1, filterdata1

          AppActivate Application.Caption

  j = i
  z = 26 + 8
  While Cells(z, j).Value <> ""
    dwgname = Cells(z, j).Value
    j = j + 1
    handle = Cells(z, j).Value
    j = j + 1
    blname = Cells(8, j).Value
    j = j + 1
    x = 0
    k = 0
    While Cells(z, j).Value <> ""
      j = j + 2
      x = x + 1
    Wend
    j = j - 2 * x
    ReDim attr(x * 2 - 1)
    x = 0
    While Cells(z, j).Value <> ""
      attr(x) = Cells(z, j).Value
      x = x + 1
      j = j + 1
      attr(x) = Cells(z, j).Value
      j = j + 1
      x = x + 1
    Wend
   
    If acad.ActiveDocument.FullName = dwgname Then
      Set tempObj = acad.ActiveDocument.HandleToObject(handle)
      Set bl = tempObj
      If bl.HasAttributes = True Then
        ba = bl.GetAttributes
        If UBound(ba) + 1 = x / 2 Then
          x = 0
          For j = LBound(ba) To UBound(ba)
            x = 0
            While (attr(x) <> ba(j).TagString) And (x <= UBound(attr))
              x = x + 2
            Wend
            If attr(x) = ba(j).TagString Then
              ba(j).TextString = attr(x + 1)
            End If
          Next j
        Else
          MsgBox "Der Block " + blname + " hat nicht die gleiche Anzahl an Attributen!", vbOKOnly, "Fehler"
        End If
      Else
        MsgBox "Der Block " + blname + " hat keine Attribute!", vbOKOnly, "Fehler"
      End If
    Else
      MsgBox "Sie haben die falsche Zeichnung geöffnet", vbOKOnly, "Fehler"
      Exit Sub
    End If
   
    j = 1
    z = z + 1
  Wend
 
         
'..............
'Block 2
     
'.................................................................................................................
'    tAcadApp.Documents.Close
'    tAcadApp.Visible = flase
   
    Next

     
End If

---

------------------
mfg Ronald

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

---

Hallo,
Sorry aber mit dem "funktioniert es nicht richtig" kann man wenig anfangen.
Setz doch mal die Fehlermeldung zurück
  On Error goto 0

dann bekommst Du die Fehlermeldungen direkt angezeigt
meine Vermutung beim Blick auf den Code liegt bei dem
If acad.ActiveDocument.FullName = dwgname Then

ansonsten :
befüllen von Attributwerten macht man üblicherweise mit einer
select case - Abfrage

da gibt es im Forum hier aber genügend Beispiele

Schönes WE
Klaus   

PS: Keine AHnung ob ich am WE noch mal genauer schauen kann ..

Edit: Gerade gesehen:

Code:

---

j = i  '< = Reihe ?
  z = 26 + 8  ' < = Spalte "AH" ?
  While Cells(z, j).Value <> ""

---

hatte Dir oben schon angegeben Cells ( Reihe bzw. Zeile, Spalte )
Da sind die Werte vertauscht !!

Noch ein Tip: Für Dich (oder andere die später mit Deinem Programm weiterarbeiten müssen) ist es einfach aussagekräftige Variablen zu verwenden.
z.B. intZeil für Zeilenzähler, intSpalt für Spaltenzähler
I, J, K, L verwende ich eigentlich nur als Laufvariable wenn es übersichtliche Arrays sind

[Diese Nachricht wurde von KlaK am 06. Apr. 2013 editiert.]

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

---

Hallo Klaus,

hab mal aufgeräumt und die Definitionen geändert.
weiters hab ich auf 4 Blöcke erweitert

Code:

---

    Dim AngBracDwg As String
    Dim Block1, Block2, Block3, Block4 As String
       
    Block1 = Cells(2, 26 + 7).Text
    Block2 = Cells(3, 26 + 7).Text
    Block3 = Cells(4, 26 + 7).Text
    Block4 = Cells(5, 26 + 7).Text
   
    For intSel = 1 To Selection.Count
    AngBracDwg = Selection.Item(intSel).Text
    tAcadApp.Documents.Open (AngBracDwg)
'.................................................................................................................

         
          Dim tempObj As AcadObject
          Dim gpCode(0) As Integer
          Dim dataValue(0) As Variant
          Dim ssetObj As AcadSelectionSet
          Dim bl1 As AcadBlockReference
          Dim ent1 As AcadEntity
          Dim ip(0 To 2) As Double
          Dim s1, intZeil, attWert1, intSpalt1 As Long
          Dim attr1 As Variant

          autocad_gestartet = True
          On Error Resume Next
          Set cad = GetObject(, "AutoCAD.Application")
          If Err.Number <> 0 Then
            Err.Clear
            MsgBox "AutoCAD ist nicht gestartet", vbOKOnly, "Fehler"
            Exit Sub
          End If
          Set acad = cad

          If IsNull(acad.ActiveDocument) Then
            MsgBox "Keine Zeichnung geöffnet", vbOKOnly, "Fehler"
            Exit Sub
          End If
         
'.................................................................................................................
'Block
          gpCode(0) = 0
          dataValue(0) = "Insert"

          Set ssetObj = acad.ActiveDocument.SelectionSets.Add("SS2")

          AppActivate acad.Caption

            Dim filtertype1(0 To 1) As Integer
            Dim filterdata1(0 To 1) As Variant
            filtertype1(0) = 0: filterdata1(0) = "insert"
            filtertype1(1) = 2: filterdata1(1) = Block1
            ssetObj.Select acSelectionSetAll, , , filtertype1, filterdata1
           
            Dim filtertype2(0 To 1) As Integer
            Dim filterdata2(0 To 1) As Variant
            filtertype2(0) = 0: filterdata2(0) = "insert"
            filtertype2(1) = 2: filterdata2(1) = Block2
            ssetObj.Select acSelectionSetAll, , , filtertype2, filterdata2
           
            Dim filtertype3(0 To 1) As Integer
            Dim filterdata3(0 To 1) As Variant
            filtertype3(0) = 0: filterdata3(0) = "insert"
            filtertype3(1) = 2: filterdata3(1) = Block3
            ssetObj.Select acSelectionSetAll, , , filtertype3, filterdata3
           
            Dim filtertype4(0 To 1) As Integer
            Dim filterdata4(0 To 1) As Variant
            filtertype4(0) = 0: filterdata4(0) = "insert"
            filtertype4(1) = 2: filterdata4(1) = Block4
            ssetObj.Select acSelectionSetAll, , , filtertype4, filterdata4
           
           
            AppActivate Application.Caption

            intZeil = intSel                              <------- Zeilenwert?
          If ssetObj.Count > 0 Then
            For Each ent1 In ssetObj
              If ent1.ObjectName = "AcDbBlockReference" Then
              Set bl1 = ent1 'Set bl1 = ssetObj.Item(s)
'              ...
            End If
            Next ent1

              intSpalt1 = 26 + 8

            For s1 = 0 To ssetObj.Count - 1
              Set bl1 = ssetObj.Item(s1)
              If bl1.HasAttributes = True Then
'                Cells(intZeil + 8, intSpalt1).Value = acad.ActiveDocument.FullName
'                intSpalt1 = intSpalt1 + 1
'                Cells(intZeil + 8, intSpalt1).Value = bl1.handle
'                intSpalt1 = intSpalt1 + 1
'                Cells(intZeil + 8, intSpalt1).Value = bl1.name                  <-----------Zeilenwert
'                intSpalt1 = intSpalt1 + 1

                attr1 = bl1.GetAttributes

                'Und zum Block:
                For attWert1 = LBound(attr1) To UBound(attr1)
                  Cells(8, intSpalt1).Value = attr1(attWert1).TagString
                  Cells(intZeil + 8, intSpalt1).Value = attr1(attWert1).TextString
                  intSpalt1 = intSpalt1 + 1
                Next attWert1
              Else
                MsgBox "Gewählte Blöcke haben keine Attribute!", vbOKOnly, "Meldung"
              End If
            Next s1
          Else
            MsgBox "Keine Blöcke gewählt!", vbOKOnly, "Meldung"
          End If
'.................................................................................................................
          ssetObj.Delete

---

den Weg zum reinschreiben sieht so aus

Code:

---

  Set bl1 = ssetObj.Item(s1)
              If bl1.HasAttributes = True Then
'                Cells(intZeil + 8, intSpalt1).Value = acad.ActiveDocument.FullName
'                intSpalt1 = intSpalt1 + 1
'                bl1.handle = Cells(intZeil + 8, intSpalt1).Value
'                intSpalt1 = intSpalt1 + 1
                bl1.name = "Block1,Block2, Block3, Block4"
'                intSpalt1 = intSpalt1 + 1

                attr1 = bl1.GetAttributes

                'Und zum Block:
                For attWert1 = LBound(attr1) To UBound(attr1)
                  attr1(attWert1).TagString = Cells(8, intSpalt1).Value
                  attr1(attWert1).TextString = Cells(intZeil + 8, intSpalt1).Value
                  intSpalt1 = intSpalt1 + 1
                Next attWert1

---

wird wahrscheinlich nicht der sauberste sein aber er funktioniert (sieht zumindest so aus)

1. leider fängt der er nicht in der Zeile an wo der Dateiname steht, sondern immer in zeile 8
wie kann ich den "intZeil" anpassen (habs im Code markiert)

2. Weiters hab ich noch das Problem das ich ab und zu Zeichnungen habe die aus mehreren Layouts bestehen wo alle Blöcke dementsprechend wieder vorkommen <-hier hab ich noch gar keinen plan

------------------
mfg Ronald

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

---

Hallo Ronald,

Du hast ja immer Spezialfragen 
Zunächst mal Gratulation zu den bisherigen Erfolgen, dann gleich die erste Frage:
Bist Du Dir sicher, dass Ddein Programm in der Zeile 8 beginnt?
Du setzt: 
intZeil = intSel                              <------- Zeilenwert?
D.h. Hier wird beim ersten Wert 1 und dann jeweils der erhöhte Wert zugewiesen.
Dann kommt die Zuweisung:
Cells(intZeil + 8, intSpalt1).Value = acad.ActiveDocument.FullName
also: 1 + 8 = 9 
Nur mal so zum Nachdenken ...

Aber nun zur eigentlichen Frage:
1. leider fängt der er nicht in der Zeile an wo der Dateiname steht, sondern immer in zeile 8
wie kann ich den "intZeil" anpassen (habs im Code markiert)
=> Wenn Du Dir über die Excel VBA Hilfe mal das Selection Element ansiehst, wirst Du feststellen, dass es dort eine Row und eine column Eigenschaft gibt.
Du kannst also über selection.row die Zeile und selection.column die Spalte des ersten Wertes der Selection herauslesen.

2. Weiters hab ich noch das Problem das ich ab und zu Zeichnungen habe die aus mehreren Layouts bestehen wo alle Blöcke dementsprechend wieder vorkommen <-hier hab ich noch gar keinen plan
=> Hier beginnt es interessant zu werden 
Da hilft wohl nur sich einmal mit dem Autocad Objektmodell zu beschäftigen. Zum Beispiel der Layouts-Collection.
Die kann man durchwandern und auf die Blöcke hin untersuchen
Gibt aber auch noch andere Möglichkeiten ...

Hoffe das hilft Dir ein wenig weiter.

Grüße
Klaus 

PS.: Noch ein Hinweis, aber vielleicht war es auch Absicht:
Dim s1, intZeil, attWert1, intSpalt1 As Long
=> Hier wird nur intSpalt1 als Long deklariert
s1, intZeil, attWert1 sind vom Typ Variant da keine Typzuweisung angegeben wurde. Das Komma ist keine Trennung um alle Variablen den gleichen Typ zuzuweisen.

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

---

Noch einen ergänzenden Hinweis:
Ich weis ja nicht welche Art von Blöcken Du bearbeiten willst, aber ich finde den Abschnitt zum befüllen der Blöcke sehr gefährlich, da Du damit die Attribute praktisch neu definierst. Wenn also der Block in der Zeichnung nicht genau den Vorgaben entspricht werden manche Felder einfach überschrieben.

Meist geht man hier so vor dass man das Array aus dem Tabellenblatt liest und dann das Blockattribut mit dem neuen Inhalt füllt.
Beim Planstempel etwa so ähnlich:

Select case attrib(i).tagstring
case "Verfasser" : attrib(i).textstring = bl.Verfasser
case "Datum": attrib(i).textstring = bl.Datum
..
end case

Natürlich muß man da zuvor den Typ neu definieren:

Type Attributwerte
Verfasser as string
Datum as String
End Type

und der Variablen zuweisen:

Dim bl as Attributwerte

Aber wie anfangs erwähnt, ich weis nicht welche Blöcke Du bearbeiten möchtest ...

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

---

Hallo Klaus,

soweit funktioniert jetzt alles
ausgelesen wird in die richtige zeile und auch umgekehrt
das mit dem überschreiben der attribute ist immo egal da ich sowieso vorher auslesen muss und die blöcke mit sicherheit ident sind

zum Problem mit dem layoutwechsel
ich bin soweit das ich vom excel die blattzahl bekomme
nur mit dem umschalten das funktioniert nicht

Code:

---

            Dim BlattNR As String
            intZeil = Selection.Item(intsel).Row
            BlattNR = Cells(intZeil, 12).Text
            BlattNR = Format$(BlattNR, "0")
'            MsgBox BlattNR
            ThisDrawing.ActiveLayout = ThisDrawing.Layouts("Blatt_" & BlattNR)

---

leider wird nicht auf zb. Blatt_2 umgeschaltet (der wert BlattNR = 2)
es wird immer Blatt 1 ausgelesen!

Info mit dieser methode mach ich für jedes blatt die Zeichnung neu auf (was mich jedoch nicht stört)

------------------
mfg Ronald

[Diese Nachricht wurde von KAME am 12. Apr. 2013 editiert.]

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

---

Da sind mir zu wenig Infos ..

Laß Dir einfach mal in der msgbox anzeigen welche Werte intZeil, intSel annehmen
(oder überprüfen es im Lokal oder Überwachungsfenster)

Kann ja nur an der Selection.Item(intsel).Row liegen

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