| | | Gut zu wissen: Hilfreiche Tipps und Tricks aus der Praxis prägnant, und auf den Punkt gebracht für Autodesk Produkte | | | | PNY präsentiert die neue NVIDIA RTX A400 und die A1000 Grafikkarte, eine Pressemitteilung
|
Autor
|
Thema: Blockattribute aus einer Zeichnung und in Excel übergeben (2856 mal gelesen)
|
KAME Mitglied techn. Angestellter
Beiträge: 152 Registriert: 21.06.2006
|
erstellt am: 02. Apr. 2013 15:49 <-- editieren / zitieren --> Unities abgeben:
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 |
KlaK Ehrenmitglied V.I.P. h.c. Dipl. Ing. Vermessung, CAD- und Netz-Admin
Beiträge: 2799 Registriert: 02.05.2006 AutoCAD LandDesktop R2 bis 2004 Civil 3D 2005 - 2022 Plateia, Canalis Visual Basic
|
erstellt am: 02. Apr. 2013 22:22 <-- editieren / zitieren --> Unities abgeben: Nur für KAME
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 |
KlaK Ehrenmitglied V.I.P. h.c. Dipl. Ing. Vermessung, CAD- und Netz-Admin
Beiträge: 2799 Registriert: 02.05.2006 AutoCAD LandDesktop R2 bis 2004 Civil 3D 2005 - 2022 Plateia, Canalis Visual Basic
|
erstellt am: 03. Apr. 2013 01:04 <-- editieren / zitieren --> Unities abgeben: Nur für KAME
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 |
KAME Mitglied techn. Angestellter
Beiträge: 152 Registriert: 21.06.2006
|
erstellt am: 03. Apr. 2013 19:24 <-- editieren / zitieren --> Unities abgeben:
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 |
KlaK Ehrenmitglied V.I.P. h.c. Dipl. Ing. Vermessung, CAD- und Netz-Admin
Beiträge: 2799 Registriert: 02.05.2006 AutoCAD LandDesktop R2 bis 2004 Civil 3D 2005 - 2022 Plateia, Canalis Visual Basic
|
erstellt am: 03. Apr. 2013 22:55 <-- editieren / zitieren --> Unities abgeben: Nur für KAME
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 |
KAME Mitglied techn. Angestellter
Beiträge: 152 Registriert: 21.06.2006
|
erstellt am: 04. Apr. 2013 20:11 <-- editieren / zitieren --> Unities abgeben:
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 |
KlaK Ehrenmitglied V.I.P. h.c. Dipl. Ing. Vermessung, CAD- und Netz-Admin
Beiträge: 2799 Registriert: 02.05.2006 AutoCAD LandDesktop R2 bis 2004 Civil 3D 2005 - 2022 Plateia, Canalis Visual Basic
|
erstellt am: 04. Apr. 2013 21:29 <-- editieren / zitieren --> Unities abgeben: Nur für KAME
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 |
KAME Mitglied techn. Angestellter
Beiträge: 152 Registriert: 21.06.2006
|
erstellt am: 04. Apr. 2013 22:01 <-- editieren / zitieren --> Unities abgeben:
|
KAME Mitglied techn. Angestellter
Beiträge: 152 Registriert: 21.06.2006
|
erstellt am: 05. Apr. 2013 15:27 <-- editieren / zitieren --> Unities abgeben:
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 |
KlaK Ehrenmitglied V.I.P. h.c. Dipl. Ing. Vermessung, CAD- und Netz-Admin
Beiträge: 2799 Registriert: 02.05.2006 AutoCAD LandDesktop R2 bis 2004 Civil 3D 2005 - 2022 Plateia, Canalis Visual Basic
|
erstellt am: 05. Apr. 2013 19:26 <-- editieren / zitieren --> Unities abgeben: Nur für KAME
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 |
KAME Mitglied techn. Angestellter
Beiträge: 152 Registriert: 21.06.2006
|
erstellt am: 09. Apr. 2013 19:13 <-- editieren / zitieren --> Unities abgeben:
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 |
KlaK Ehrenmitglied V.I.P. h.c. Dipl. Ing. Vermessung, CAD- und Netz-Admin
Beiträge: 2799 Registriert: 02.05.2006 AutoCAD LandDesktop R2 bis 2004 Civil 3D 2005 - 2022 Plateia, Canalis Visual Basic
|
erstellt am: 10. Apr. 2013 00:18 <-- editieren / zitieren --> Unities abgeben: Nur für KAME
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 |
KlaK Ehrenmitglied V.I.P. h.c. Dipl. Ing. Vermessung, CAD- und Netz-Admin
Beiträge: 2799 Registriert: 02.05.2006 AutoCAD LandDesktop R2 bis 2004 Civil 3D 2005 - 2022 Plateia, Canalis Visual Basic
|
erstellt am: 10. Apr. 2013 00:41 <-- editieren / zitieren --> Unities abgeben: Nur für KAME
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 |
KAME Mitglied techn. Angestellter
Beiträge: 152 Registriert: 21.06.2006
|
erstellt am: 12. Apr. 2013 10:04 <-- editieren / zitieren --> Unities abgeben:
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 |
KlaK Ehrenmitglied V.I.P. h.c. Dipl. Ing. Vermessung, CAD- und Netz-Admin
Beiträge: 2799 Registriert: 02.05.2006 AutoCAD LandDesktop R2 bis 2004 Civil 3D 2005 - 2022 Plateia, Canalis Visual Basic
|
erstellt am: 12. Apr. 2013 15:07 <-- editieren / zitieren --> Unities abgeben: Nur für KAME
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 |
| Anzeige.:
Anzeige: (Infos zum Werbeplatz >>)
|