| | | Gut zu wissen: Hilfreiche Tipps und Tricks aus der Praxis prägnant, und auf den Punkt gebracht für Autodesk Produkte |
Autor
|
Thema: AutoCAD Sichtbarkeiten eines dynamischen Blocks mit VBA (2828 / mal gelesen)
|
Andre B. Mitglied Sachbearbeiter und Zeichner
Beiträge: 19 Registriert: 04.02.2018 Win 10 64bit Access 2016 AutoCAD 2018 AutoCAD MEP 2018
|
erstellt am: 04. Feb. 2018 10:14 <-- editieren / zitieren --> Unities abgeben:
Hallo liebe CAD-Gemeinde, ich bin nun leider am verzweifeln . Ich habe viel gelesen, auch hier im Forum. Leider bin ich im VBA-Programmieren von AutoCAD noch ein totales Greenhorn. Mein Ziel: Ich habe eine Access Datenbank aus der ich ACad-Zeichnungen öffnen möchte und die Blöcke, welche dort enthalten sind, auslesen. Die Zeichnung öffnen und alle Blocktypen auslesen (inkl. Attribute) habe ich schon geschafft. Ich weiß auch, ob es sich um einen dynamischen Block handelt. Jetzt fehlt mir lediglich der VBA Befehl, um die einzelnen Sichtbarkeiten eines dynamischen Blocks auszulesen. Kann mir da jemand weiterhelfen? Vielen Dank im vorraus. André [Diese Nachricht wurde von Andre B. am 06. Feb. 2018 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: 2789 Registriert: 02.05.2006 AutoCAD LandDesktop R2 bis 2004 Civil 3D 2005 - 2022 Plateia, Canalis Visual Basic
|
erstellt am: 04. Feb. 2018 20:26 <-- editieren / zitieren --> Unities abgeben: Nur für Andre B.
|
rexxitall Mitglied Dipl. -Ing. Bau
Beiträge: 270 Registriert: 07.06.2013 Various: systems, Operating systems, cad systems, cad versions, programming languages.
|
erstellt am: 06. Feb. 2018 21:29 <-- editieren / zitieren --> Unities abgeben: Nur für Andre B.
Hi, seid man nicht so geizig ! Im anhang ist die ganze Lib Lieben Gruß Thomas ------------------ Wer es nicht versucht, hat schon verlorn Und bei 3 Typos gibts den vierten gratis ! <<< for sale ! Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
Andre B. Mitglied Sachbearbeiter und Zeichner
Beiträge: 19 Registriert: 04.02.2018 Win 10 64bit Access 2016 AutoCAD 2018 AutoCAD MEP 2018
|
erstellt am: 06. Feb. 2018 21:42 <-- editieren / zitieren --> Unities abgeben:
Erst einmal vielen Dank. Das ist viel zu lesen und versuchen es zu verstehen. Ich melde mich später mit Erfolgsmeldung oder weiteren Fragen ------------------ MS Access 2016, Autodesk AutoCAD 2018, MS Office 2016 Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
rexxitall Mitglied Dipl. -Ing. Bau
Beiträge: 270 Registriert: 07.06.2013 Various: systems, Operating systems, cad systems, cad versions, programming languages.
|
erstellt am: 07. Feb. 2018 11:29 <-- editieren / zitieren --> Unities abgeben: Nur für Andre B.
Das ist eigentlich recht einfach. Man fragt wie in dem Schnibsel gezeigt die Propertys ab und versucht den Variablentyp und die Art der Property heraus zu bekommen. Beim Block mit dem Visuelen Stil ist es z.B. ein String, der den Namen der Sichtbarkeitsalternative angibt. Diese Propertys kann man dann umgekehrt genau so wieder setzen. Da mir das Ganze zu blöd war um es für jeden Einzelfall gesondert zu programmieren schreibe ich diese Dinge in Dictioarys. In die "normalen" von windows scripting host bereitgestellten. Da diese mitunter nicht verfügbar sind, gibt es auch noch eine Lösung bei der diese über VBA selbst dargetsellt werden. (VBA Klasse). Diese Dictorys kann man auch wunderbar als Parameter bei Methoden oder Klassenaufrufen übergeben. Was die gesamte Problematik "Block " hinterher zum Klacks werden lässt So kann man Attribute Propertys und Paraeter in Dictionarys schieben, die Blockreferenz oder den gesamten Block austauschen und diese zurückschreiben. Damit sind Block erstezungen oder das clonen von Parametern etc ein Kinderspiel. ------------------ Wer es nicht versucht, hat schon verlorn Und bei 3 Typos gibts den vierten gratis ! <<< for sale ! Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
Andre B. Mitglied Sachbearbeiter und Zeichner
Beiträge: 19 Registriert: 04.02.2018 Win 10 64bit Access 2016 AutoCAD 2018 AutoCAD MEP 2018
|
erstellt am: 07. Feb. 2018 21:09 <-- editieren / zitieren --> Unities abgeben: Nur für Andre B.
OK. Danke für die Erklärung. Leider bin ich wirklich noch nicht so weit mit dem Verständnis. Frage: Was sind Dictionaries? Beim Google findet man hauptsächlich "Wörterbücher", was ja auch die Übersetzung ist. Auch hier im Forum finde ich nicht so recht die richtig gestellte Frage für die Suche. Befindet sich die "Dictionary" in einer Zeichnung? Wie schreibe ich die Funktionen da rein? Tut mir leid, dass ich so viel nachfragen muss . A. ------------------ MS Access 2016, Autodesk AutoCAD 2018, MS Office 2016 Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
rexxitall Mitglied Dipl. -Ing. Bau
Beiträge: 270 Registriert: 07.06.2013 Various: systems, Operating systems, cad systems, cad versions, programming languages.
|
erstellt am: 09. Feb. 2018 13:09 <-- editieren / zitieren --> Unities abgeben: Nur für Andre B.
HI Ein Dictionary ist so eine Art Nachschlagewerk für Variablen. Man durchläuft das nicht wie ein Array mit For Next zum Durchsuchen sondern bekommt die werte gleich zurück. Du must den Windows scripting host (Verweis auf WSHOM.dll) als Referenz setzen. Die residiert normalerweise in c:\windows\system32 dann kann man sich mit: dim DICT as new SCRIPTING.DICTIONARY ' <<<< Danach kann man auch mal googlen so ein Objekt anlegen. Dictionarys haben einen KEY, der muss einzigartig sein. Denzufolge muss man zuerst überprüfen ob der schon existiert bevor man da was reinschreibt if dict.exist("MeinKey") then dict.item("MeinKey")="Dolles Ding" else dict add "MeinKey", "Dolles Ding" end if Stell dir einfach das ganze so vor als wenn du dynamisch variablen beim Programmlauf selbst erzeugst. die "Variable" (eher das Objekt) "MeinKey" kann man nun über das ITEM des Dictionarys suchen une befüllen / abfragen dim S as string S=DICT.ITEM("MeinKey") DICT.ITEM("MeinKey")="Doch nicht ganz so dolles Ding" Das geht rasend schnell - deswegen hab ich die ganzen Dinge in diese Dictionarys kodiert.
Da es Objekte sind kann man Dictionarys byref an andere Routinen übergeben. Egal wie groß die sind, es werden dabei nur ein paar byte für den Pointer übertragen. Was na klar auch rasend schnell ist In Fakt dabei wird nur die Speicheradresse übertragen. Wenn man also irgnedwelche Datenlisten schnell durchsuchen wíll sind diese Dinger das Mittel der Wahl. (z.B. Excel Tabellenspalten als Key und die Spalennummer Nummer als Wert z.B. ) Lieben Gruß Thomas Diese Dictionarys haben NICHTS mit den Autocad Dictionarys zu tun - auch wenn die ähnlich funktionieren. Sie existieren nur im Speicher und nicht in der Zeichnung.
end if
------------------ Wer es nicht versucht, hat schon verlorn Und bei 3 Typos gibts den vierten gratis ! <<< for sale ! Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
Andre B. Mitglied Sachbearbeiter und Zeichner
Beiträge: 19 Registriert: 04.02.2018 Win 10 64bit Access 2016 AutoCAD 2018 AutoCAD MEP 2018
|
erstellt am: 11. Feb. 2018 11:26 <-- editieren / zitieren --> Unities abgeben:
Hallo, ich wieder. Danke für die Antworten, ich habe alle mal versucht zu verstehen und am Code gearbeitet. Leider bin ich immer noch daran, die Eigenschaften aus dem Block zu bekommen. Mein Problem scheint es zu sein, dass ich AutoCAD von Access aus steure. Daher habe ich das mit den Directonaries noch nicht probiert. Hab mir ein ein VBA-AutoCAD-Buch besorgt und das Grundlegende versucht zu verstehen. Vielleicht kann mir jemand helfen:
Code: Private Sub bt_BloeckeEinlesen_Click() On Error Resume NextDim Rs1 As Recordset, Rs2 As Recordset, Rs3 As Recordset, Rs4 As Recordset Dim tAcadApp As AcadApplication Dim tAcadDoc As AcadDocument Dim tAcadBlock As AcadBlock Dim objBlockRef As AcadBlockReference Dim objAcad As AcadObject Dim DynBloProp As AcadDynamicBlockReferenceProperty Dim varBlockName As Variant Dim varAttribute As Variant Dim varDyn As Variant Dim strPropName As String Dim K As Variant, i As Integer Set tAcadApp = AcadApplication Set Rs1 = CurrentDb.OpenRecordset("tbl_Zeichnung") Set Rs2 = CurrentDb.OpenRecordset("tbl_ACadBlock") Set Rs3 = CurrentDb.OpenRecordset("tbl_Attribute") Set Rs4 = CurrentDb.OpenRecordset("tbl_ACadSichtbarkeit") If Rs1.EOF = False Then Rs1.MoveFirst Do While Rs1.EOF = False Set tAcadDoc = tAcadApp.Documents.Open(Rs1!Zeichnungspfad) With tAcadDoc .WindowState = acMax .ActiveSpace = acModelSpace .Application.ZoomExtents For Each tAcadBlock In .Blocks '------------------------------------------------------------------ 'Alle Blöcke (Blockreferenz), welche in der Zeichnung verfügbar sind - funktioniert '------------------------------------------------------------------ If Not Left(tAcadBlock.Name, 1) = Chr(42) And Not Left(tAcadBlock.Name, 1) = "_" And Not Left(tAcadBlock.Name, 2) = "-U" Then 'Eitrag Blockname Rs2.AddNew Rs2!Blockname = tAcadBlock.Name Rs2!HandleID = Trim(tAcadBlock.Handle) Rs2!DynamicBlock = tAcadBlock.IsDynamicBlock Rs2!Zeichnung_ID = Rs1!Zeichnung_ID Rs2.Update '------------------------------------------------------------------ 'Alle Attribute, welche in dem Block enthalten sind - funktioniert '------------------------------------------------------------------ For Each varAttribute In tAcadBlock If TypeName(varAttribute) = "IAcadAttribute" Then Rs3.AddNew Rs3!ACadBlock_ID = DLookup("Block_ID", "tbl_ACadBlock", "Blockname = '" & tAcadBlock.Name & "'") Rs3!Attribute_Name = varAttribute.TagString Rs3.Update End If Next '------------------------------------------------------------------ 'Alle Eigenschaften (Sichtbarkeiten), welche in dem Block enthalten sind - funktioniert nicht '------------------------------------------------------------------ If tAcadBlock.IsDynamicBlock = True Then varDyn = tAcadBlock.GetDynamicBlockProperties 'MsgBox "varDyn: " & varDyn & " / " & tAcadBlock.Name For K = LBound(varDyn) To UBound(varDyn) '<--- Hier gibt es keine Eigenschaften, es wird übersprungen Set DynBloProp = varDyn(K) strPropName = DynBloProp.PropertyName St1 = DynBloProp.value 'Ausgabe der Eigenschaft, später in Tabelle schreiben MsgBox "Propname: " & strPropName & " / " & tAcadBlock.PropertyName Next End If '----------------------------------------------------------------- End If Next .Close False End With Rs1.MoveNext Set tAcadDoc = Nothing Loop End If End Sub
Ich bekomme alle Blöcke der zeichnung ausgelesen und schreibe sie in die Datenbank, auch alle Attribute kann ich richtig zuweisen. Nur bei den Eigenschaften bekomme ich einfach kein Ergebnis . Könnte mir vielleicht jemand einen Tipp geben, der mich auch den richtigen Weg führt ? André ------------------ MS Access 2016, Autodesk AutoCAD 2018, MS Office 2016 Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
Andre B. Mitglied Sachbearbeiter und Zeichner
Beiträge: 19 Registriert: 04.02.2018 Win 10 64bit Access 2016 AutoCAD 2018 AutoCAD MEP 2018
|
erstellt am: 13. Feb. 2018 11:56 <-- editieren / zitieren --> Unities abgeben:
|
KlaK Ehrenmitglied V.I.P. h.c. Dipl. Ing. Vermessung, CAD- und Netz-Admin
Beiträge: 2789 Registriert: 02.05.2006 AutoCAD LandDesktop R2 bis 2004 Civil 3D 2005 - 2022 Plateia, Canalis Visual Basic
|
erstellt am: 13. Feb. 2018 13:56 <-- editieren / zitieren --> Unities abgeben: Nur für Andre B.
Da wir nicht mit dynamischen Blöcken arbeiten kann ich mangels Beispieldaten Deinen Code nicht testen. Aber wenn Du mal eine Zeichnung mit zwei, drei Blöcken zum analysieren hier einstellst kann ich mir das gerne mal ansehen. Grüße Klaus Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
Andre B. Mitglied Sachbearbeiter und Zeichner
Beiträge: 19 Registriert: 04.02.2018 Win 10 64bit Access 2016 AutoCAD 2018 AutoCAD MEP 2018
|
erstellt am: 14. Feb. 2018 06:59 <-- editieren / zitieren --> Unities abgeben:
Guten Morgen, anbei ein Beispiel mit zwei dynamischen Blöcken, welche jeweils Sichtbarkeiten enthalten. Ich brauche keinen fertigen Code, mir reicht lediglich ein Denkanstoß. Vielen Dank im Voraus. André ------------------ MS Access 2016, Autodesk AutoCAD 2018, MS Office 2016
[Diese Nachricht wurde von Andre B. am 14. Feb. 2018 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: 2789 Registriert: 02.05.2006 AutoCAD LandDesktop R2 bis 2004 Civil 3D 2005 - 2022 Plateia, Canalis Visual Basic
|
erstellt am: 18. Feb. 2018 12:15 <-- editieren / zitieren --> Unities abgeben: Nur für Andre B.
Hallo André, So ganz verstehe ich Dein Problem nicht. Gerade mal einen Test gemacht mit folgendem Code:
Code:
Sub DynBlock()Dim tAcadBlock As AcadBlockReference Dim varDyn As Variant For Each ent In ThisDrawing.ModelSpace If ent.ObjectName = "AcDbBlockReference" Then Set tAcadBlock = ent Debug.Print tAcadBlock.Name & " / " & tAcadBlock.EffectiveName & " : "; If tAcadBlock.IsDynamicBlock = True Then varDyn = tAcadBlock.GetDynamicBlockProperties For K = LBound(varDyn) To UBound(varDyn) '<--- Hier gibt es keine Eigenschaften, es wird übersprungen Set DynBloProp = varDyn(K) strPropName = DynBloProp.PropertyName st1 = DynBloProp.Value 'Ausgabe der Eigenschaft, später in Tabelle schreiben Debug.Print "Propname: " & strPropName & " / " & st1 ' <= geändert, alt: & tAcadBlock.PropertyName Next End If End If Next ent End Sub
Ergebnis:
Code:
*U3 / Jung_LS990_Schalter_senkrecht : Propname: Schaltertyp / 1-fach Wippe *U4 / Jung_LS990_Behindertennotruf : Propname: Typ / Zugtaster *U5 / Jung_LS990_Schalter_senkrecht : Propname: Schaltertyp / 2-fach Wippe *U6 / Jung_LS990_Schalter_senkrecht : Propname: Schaltertyp / 2-fach Serienwippe *U7 / Jung_LS990_Schalter_senkrecht : Propname: Schaltertyp / 3-fach Wippe
Einzige Änderung: Debug.Print "Propname: " & strPropName & " / " & st1 Grüße Klaus [Edit] Ach ja was mir noch auffällt: In meinem Code werden die eingefügten Blöcke abgefragt, in Deinem untersuchst Du den Blockaufbau ( For Each tAcadBlock In .Blocks ) daher dürfte der Fehler kommen. Wenn Du wirklich den Blockaufbau der in der Zeichnung enthaltenen "Zeichnungsanweisungen" in die DB übernehmen möchtest müßte ich das nochmal ansehen ... [Edit 2] Und sinnvollerweise solltest Du dann bei den Attributen nicht TagString alleine speichern sondern den Inhalt (Textstring) zum TagString zuordnen. [Diese Nachricht wurde von KlaK am 18. Feb. 2018 editiert.] Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
Andre B. Mitglied Sachbearbeiter und Zeichner
Beiträge: 19 Registriert: 04.02.2018 Win 10 64bit Access 2016 AutoCAD 2018 AutoCAD MEP 2018
|
erstellt am: 19. Feb. 2018 07:01 <-- editieren / zitieren --> Unities abgeben:
Guten Morgen Klaus, danke für den Ansatz. Seltsamerweise musste ich es etwas anpassen. Die Zeile Zitat: Debug.Print "Propname: " & strPropName & " / " & st1
hat immer einen Fehler gebracht, wenn der Inhalt von strPropName "Origin" war. Keine Ahnung warum, hab ich aber ausgegrenzt, dann funktionierte es. Leider nicht ganz das Ergebnis, welches ich erhofft hatte. Eigentlich wollte ich nach Ablauf der Prozedur, dass ich von jedem einzelnen Referenz-Block alle möglichen Sichtbarkeiten erhalte. Dies hat den Hintergrund, dass ich eine Zeichnung auslese, um den Sichtbarkeiten bestimmte Werte zuweise, um sie mengenmäßig auswerten zu können. Das Ergebnis, welches du mir präsentierst, brauche ich zwar auch, aber erst später, wenn ich die Referenz-Zeichnung ausgewertet habe, dann wird mit dieser Funktion die Projekt-Zeichnung ausgewertet. Ich hoffe, ich habe es nicht zu kompliziert beschrieben. Grüße aus Berlin, André ------------------ MS Access 2016, Autodesk AutoCAD 2018, MS Office 2016 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: 2789 Registriert: 02.05.2006 AutoCAD LandDesktop R2 bis 2004 Civil 3D 2005 - 2022 Plateia, Canalis Visual Basic
|
erstellt am: 19. Feb. 2018 13:46 <-- editieren / zitieren --> Unities abgeben: Nur für Andre B.
Hallo André, das wird so nicht gehen, da man über VBA keinen Zugriff auf die dynamischen Eigenschaften von Blöcken hat. Man kann lediglich über die eingefügten Blockreferenzen zugreifen. Möchtest Du nun alle in der Block-Section enthaltenen Blöcke und deren dynamische Eigenschaften in einer DB speichern, müßte man hier einen kleinen Umweg gehen und diese Blöcke temporär in die Zeichnung einfügen. Anschließend könntest Du Dir über diese BlockReferencen mit z.B.: AV = DynBloProp.AllowedValues die zulässigen Werte holen und diese für den Block hinterlegen. Was meintest Du mit Fehler bei strPropName "Origin"? Hast Du mal im Lokal-Fenster (Debug-Modus, Halt setzen) nachgesehen ob für diesen Parameter überhaupt Werte verfügbar sind? Der Parameter Origin bezeichnet normalerweise den Urprung / Bezugspunkt des Blockes wenn dieser nicht auf 0,0 liegt bzw. explizit im dynamischen Block gesetzt wurde. Unterschiedliche Parameterwerte können dafür nicht vorhanden sein. Grüße Klaus
[Diese Nachricht wurde von KlaK am 19. Feb. 2018 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: 2789 Registriert: 02.05.2006 AutoCAD LandDesktop R2 bis 2004 Civil 3D 2005 - 2022 Plateia, Canalis Visual Basic
|
erstellt am: 20. Feb. 2018 10:07 <-- editieren / zitieren --> Unities abgeben: Nur für Andre B.
Zitat: Original erstellt von Andre B.: Eigentlich wollte ich nach Ablauf der Prozedur, dass ich von jedem einzelnen Referenz-Block alle möglichen Sichtbarkeiten erhalte. Dies hat den Hintergrund, dass ich eine Zeichnung auslese, um den Sichtbarkeiten bestimmte Werte zuweise, um sie mengenmäßig auswerten zu können.
Du kennst aber schon den Befehl Datenextraktion ? (siehe Bild)
Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
rexxitall Mitglied Dipl. -Ing. Bau
Beiträge: 270 Registriert: 07.06.2013 Various: systems, Operating systems, cad systems, cad versions, programming languages.
|
erstellt am: 21. Feb. 2018 10:47 <-- editieren / zitieren --> Unities abgeben: Nur für Andre B.
Hi, Das Dictionary ist ein Windows VBS Object, es ist standardmäßig von Microsoft installiert - dazu brauchst du kein Autocad - nicht mal ein Access das hast du bereits wen duie nur das OS installierst. Es kann über die VBA MENÜleiste / Tools / verwNennt sich Windows Script Host Object Modell und kann durch laden von c:\Windows\System32\wshom.ocx eingebunden werden. Der Verweis steht anschließend im VBA Programm drin. Das muss man also nur einmal machen. Das ist die gleiche Nummer als wenn du das AcAdFocusControl einbindest. Das OCX biete auch noch Zugriff auf das FilesystemObject und bietet Dialoge zum Datei laden etc. Google da mal nach Den Origin kann man nicht setzen, dazu müsstes du sämtliche Blockinhalte im Block verschieben Was aber im Normalfalle dazu führt, das die dynamischen Eigenschften "zerbröseln" . Das funktioniert nicht mal im Blockeditor :/.
In einem anderen Beitrag hab ich noch was gefunden um die allowedPropertys auszulesen. Da sich das auf eine Blockreferenz auwirkt muss man die zumindest temporär in die Zeichnung packen. Danke KLK für den Hinweis, den kannte ich noch gar nicht
Wenn dir das mit dem Einbinden zu heikel ist: Hier Nachbauten in reinem VBA welche auch funktionieren wenn der Sysadmin VBS abgedreht hat. Benötigen KEINE DLL. damit das funktioniert benötigst due eine Hilfsklasse "KeyValuePairs" (neue Klasse anlegen im VBA)
da steht nur folgendes drin : '------------------------------ 'Unrestricted class just to hold pairs of values together and permit Dictionary object updating Public KEY As String Public value As Variant '---------------------------------- https://github.com/zrisher/vba_collection Von: https://forums.autodesk.com/t5/visual-basic-customization/vba-changing-dynamic-block-property-values/td-p/5409653 und http://www.sysmod.com/Dictionary.cls darauf basieren meine DICTIONARYS_VBA Option Explicit
Sub main() Dim sBlkPnt As String Dim sLng As String 'Dim sBldLung As Double Dim iBldLung As Integer, iBldAlt As Integer, iBldLng As Integer sBlkPnt = "501_T_Prospetto" iBldAlt = 1 ' 0 = 2659 , 1 = 2959 'sBldLung = 2400# iBldLung = 1 ' 0 = 2400 , 1 = 2890 'sLng = "ITA" iBldLng = 1 ' 0 = "ITA" , 1 = "ENG", 2 = "FRA" 'Call ChangeAttr_PP(sBlkPnt, "D_TLung", sBldLung, , , , , True, "Visibility1", sLng) Call ChangeAttr_PP(sBlkPnt, "D_TLung", iBldLung, "D_Alt", iBldAlt, , , True, "Visibility1", iBldLng) End Sub 'Function ChangeAttr_PP(sBlk As String, sAttrTag1 As String, ByVal sVal1 As Variant, Optional sAttrTag2 As String, Optional ByVal sVal2 As Variant, Optional sAttrTag3 As String, Optional ByVal sVal3 As Variant, Optional bAttr As Boolean, Optional sAttrLng As String, Optional sValLng As String) Function ChangeAttr_PP(sBlk As String, sAttrTag1 As String, ByVal sVal1 As Integer, Optional sAttrTag2 As String, Optional ByVal sVal2 As Integer, Optional sAttrTag3 As String, Optional ByVal sVal3 As Integer, Optional bAttr As Boolean, Optional sAttrLng As String, Optional sValLng As Integer) Dim objBlock As AcadBlock Dim objBlockRef As AcadBlockReference Dim iCount As Integer, iobj As Integer Dim dybprop As Variant, i As Integer Dim sVal As Variant, obj As Variant Dim okCase As Boolean Dim acadDoc As AcadDocument ' added by RICVBA Set acadDoc = ThisDrawing ' added by RICVBA iCount = 0 'Debug.Print acadDoc.FullName Set objBlock = acadDoc.Blocks.Item(sBlk) If objBlock.IsDynamicBlock Then Dim ssetObj As AcadSelectionSet Set ssetObj = BlocksSset() For Each objBlockRef In ssetObj 'iterate through reference blocks collection Debug.Print objBlockRef.ObjectName If objBlockRef.IsDynamicBlock Then 'Check to see if it is a Dynamic Block dybprop = objBlockRef.GetDynamicBlockProperties For i = LBound(dybprop) To UBound(dybprop) 'Goes through Results With dybprop(i) okCase = True Select Case .PropertyName Case sAttrTag1 sVal = sVal1 Case sAttrTag2 sVal = sVal2 Case sAttrTag3 sVal = sVal3 Case sAttrLng sVal = sValLng Case Else okCase = False End Select If okCase Then iobj = 0 For Each obj In .AllowedValues If iobj = sVal Then .Value = obj iCount = iCount + 1 Exit For End If iobj = iobj + 1 Next obj End If End With Next i End If Next ' synchronize definition of block attributes acadDoc.SendCommand ("attsync n " & sBlk & vbCr) MsgBox "Done. Successfully updated " & iCount & " dyn blocks." iCount = 0 Else
'[...] End If End Function Function BlocksSset() As AcadSelectionSet
Dim gpCode(0) As Integer Dim dataValue(0) As Variant Dim ssetObj As AcadSelectionSet gpCode(0) = 0: dataValue(0) = "INSERT" On Error Resume Next Set ssetObj = ThisDrawing.SelectionSets.Item("BlocksSset") If Err <> 0 Then Set ssetObj = ThisDrawing.SelectionSets.Add("BlocksSset") Else ssetObj.Clear End If On Error GoTo 0 ZoomExtents ssetObj.Select acSelectionSetAll, , , gpCode, dataValue Set BlocksSset = ssetObj End Function Und da wir nicht geizig sind meine Dictionary_VBA Klasse die die KeyValue Klasse auch benötigt es müssen also zwei Class Dinxe in das VBA Projekt eingebunden werden Option Explicit 'Collection methods: Add, Count, Item, Remove 'Dictionary : .Add(Key as string, Item as variant), .CompareMode, .Count, .Exists(Key); _ .Item(Key) - writeable, .Items, .Keys, .Remove(Key), .RemoveAll 'plus KeyValuePairs collection, KeyValuePair(Index as long), Tag as variant ' 25-11-2011 KeyValuePair helper object Public KeyValuePairs As Collection ' open access but allows iteration Public tag As Variant ' read/write unrestricted Private Sub Class_Initialize() Set KeyValuePairs = New Collection End Sub
Private Sub Class_Terminate() Set KeyValuePairs = Nothing End Sub Public Property Get CompareMode() As VbCompareMethod ' in Dictionary this is writeable, here we have only vbtextCompare because we are using a Collection CompareMode = vbTextCompare '=1; vbBinaryCompare=0 End Property Public Property Let ITEM(KEY As String, ITEM As Variant) ' dic.Item(Key) = value ' update a scalar value for an existing key Let KeyValuePairs.ITEM(KEY).value = ITEM End Property Public Property Set ITEM(KEY As String, ITEM As Variant) ' Set dic.Item(Key) = value ' update an object value for an existing key Set KeyValuePairs.ITEM(KEY).value = ITEM End Property Public Property Get ITEM(KEY As String) As Variant AssignVariable ITEM, KeyValuePairs.ITEM(KEY).value End Property Public Sub Add(KEY As String, ITEM As Variant) ' Collection parameter order is Add(Item,Key); Dictionary is Add(Key,Item) so always used named arguments On Error GoTo 0 Dim oKVP As KeyValuePair Set oKVP = New KeyValuePair ''debug.print Err.DESCRIPTION oKVP.KEY = KEY ''debug.print Err.DESCRIPTION If IsObject(ITEM) Then ''debug.print Err.DESCRIPTION Set oKVP.value = ITEM ' 'debug.print Err.DESCRIPTION Else ''debug.print Err.DESCRIPTION Let oKVP.value = ITEM ' 'debug.print Err.DESCRIPTION End If KeyValuePairs.Add ITEM:=oKVP, KEY:=KEY ''debug.print Err.DESCRIPTION End Sub Public Property Get Exists(KEY As String) As Boolean On Error Resume Next Exists = TypeName(KeyValuePairs.ITEM(KEY)) > "" ' we can have blank key, empty item End Property Public Sub Remove(KEY As String) 'show error if not there rather than On Error Resume Next KeyValuePairs.Remove KEY End Sub Public Sub RemoveAll() Set KeyValuePairs = Nothing Set KeyValuePairs = New Collection End Sub Public Property Get count() As Long count = KeyValuePairs.count End Property Public Property Get Items() As Variant ' for compatibility with Dictionary Dim vList As Variant, i As Long If Me.count > 0 Then ReDim vList(0 To Me.count - 1) ' to get a 0-based array same as Dictionary For i = LBound(vList) To UBound(vList) AssignVariable vList(i), KeyValuePairs.ITEM(1 + i).value ' could be scalar or array or object Next i Items = vList End If End Property Public Sub ResetValues(Optional initvalue As Variant = vbNullString) 'reinitialize the structure Dim PAIR As KeyValuePair Dim i As Long If Me.count > 0 Then For i = 1 To Me.count Set PAIR = KeyValuePairs.ITEM(i) PAIR.value = initvalue Next End If End Sub Public Property Set KEY(i As Long, KEY As Variant) KeyValuePairs.ITEM(i + 1).KEY = KEY End Property
Public Property Get KEY(i As Long) As String KEY = KeyValuePairs.ITEM(1 + i).KEY End Property Public Property Get KEYS(Optional sort As Boolean = False) As String() Dim vList() As String, i As Long If Me.count > 0 Then ReDim vList(0 To Me.count - 1) For i = LBound(vList) To UBound(vList) vList(i) = KeyValuePairs.ITEM(1 + i).KEY ' Next i KEYS = vList If sort Then QuickSort2 KEYS, LBound(KEYS), UBound(KEYS) Else ReDim KEYS(0) End If End Property Public Property Get KeyValuePair(Index As Long) As Variant ' returns KeyValuePair object Set KeyValuePair = KeyValuePairs.ITEM(1 + Index) ' collections are 1-based End Property Private Sub AssignVariable(Variable As Variant, value As Variant) If IsObject(value) Then Set Variable = value Else Let Variable = value End Sub Public Sub DebugPrint() Dim lItem As Long, lIndex As Long, vItem As Variant, oKVP As KeyValuePair lItem = 0 For Each oKVP In KeyValuePairs lItem = lItem + 1 '''debug.print lItem; oKVP.Key; " "; TypeName(oKVP.value); If InStr(1, TypeName(oKVP.value), "()") > 0 Then vItem = oKVP.value '''debug.print "("; CStr(LBound(vItem)); " to "; CStr(UBound(vItem)); ")"; For lIndex = LBound(vItem) To UBound(vItem) '''debug.print " (" & CStr(lIndex) & ")"; TypeName(vItem(lIndex)); "="; vItem(lIndex); Next '''debug.print Else '''debug.print "="; oKVP.value End If Next End Sub
'NB VBA Collection object index is 1-based, Dictionary items array is 0-based 'cf Dictionary Methods s.Add(Key, Item), s.CompareMode, s.Count, s.Exists(Key); _ s.Item(Key) - updateable, s.Items, s.Key(Key), s.Keys, s.Remove(Key), s.RemoveAll 'Dictionary has no index number; you can index the 0-based variant array of Items returned ' unlike Collections which can be indexed starting at 1 'Efficient iteration is For Each varPair in thisdic.KeyValuePairs 'Another difference I introduce is that in a Dictionary, the doc says ' If key is not found when changing an item, a new key is created with the specified newitem. ' If key is not found when attempting to return an existing item, a new key is created and its corresponding item is left empty. 'but I want to raise an error when addressing a key that does not exist 'similarly, the Dictionary will create separate integer and string keys for eg 2 ------------------ Wer es nicht versucht, hat schon verlorn Und bei 3 Typos gibts den vierten gratis ! <<< for sale ! Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
Andre B. Mitglied Sachbearbeiter und Zeichner
Beiträge: 19 Registriert: 04.02.2018 Win 10 64bit Access 2016 AutoCAD 2018 AutoCAD MEP 2018
|
erstellt am: 27. Feb. 2018 12:48 <-- editieren / zitieren --> Unities abgeben:
Hallo Klaus, sorry, hatte aktuell nur wenig Zeit dem Problem weiter zu begegnen. Zitat: Möchtest Du nun alle in der Block-Section enthaltenen Blöcke und deren dynamische Eigenschaften in einer DB speichern, müßte man hier einen kleinen Umweg gehen und diese Blöcke temporär in die Zeichnung einfügen. Anschließend könntest Du Dir über diese BlockReferencen mit z.B.: AV = DynBloProp.AllowedValues die zulässigen Werte holen und diese für den Block hinterlegen.
Klingt nach dem was ich suche. Verstehe nur nicht, wo ich das ".AllowedValues" anwenden muss. Eigentlich muss ich doch den Block in der Referenzdatei kopieren und in eine neue Datei (temprärer Art) einfügen, oder Code: Sub CopyBlock() 'Quelle ww3.cad.de Dim SourceDoc As AcadDocument Dim Targetdoc As AcadDocument Dim BlockDef As AcadBlock Dim CopyBlockDef(0) As Object Dim Result As Variant ' Zeichnung zuweisen (beide sind geöffnet) Set SourceDoc = Application.Documents(0) Debug.Print SourceDoc.Name Set Targetdoc = Application.Documents(1) Debug.Print Targetdoc.Name ' Der zu kopierende Block Set CopyBlockDef(0) = SourceDoc.Blocks("Block1") ' Block in die Blocks Collection kopieren Result = SourceDoc.CopyObjects(CopyBlockDef, Targetdoc.Blocks) ' Zum Test einfügen Dim insPkt(0 To 2) As Double Dim BlockRef As AcadBlockReference Set BlockRef = Targetdoc.ModelSpace.InsertBlock(insPkt, "Block1", 1, 1, 1, 0) BlockRef.Update End Sub
Aber was macht das ".AllowedValues"? Zitat: Du kennst aber schon den Befehl Datenextraktion ? (siehe Bild)
Kenne ich schon, bringt im Ganzen betrachtet aber nicht das Ergebnis, dass ich suche. Wenn man ein Gesamtprojekt sieht und das Ziel hinter der Datenbank betrachtet, einfach zu langsam und unflexibel. Trotzdem Danke für den Hinweis André
------------------ Die meisten Probleme entstehen bei ihrer Lösung. ------------------------------------------------ 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: 2789 Registriert: 02.05.2006 AutoCAD LandDesktop R2 bis 2004 Civil 3D 2005 - 2022 Plateia, Canalis Visual Basic
|
erstellt am: 27. Feb. 2018 15:38 <-- editieren / zitieren --> Unities abgeben: Nur für Andre B.
Hallo André, Besser eine späte Rückmeldung als gar keine Zitat: Aber was macht das ".AllowedValues"?
Diese Liste gibt an welche Werte für den Parameter eingestellt werden können und nachdem Du ja zunächst Deine Referenzzeichnung untersuchen wolltest um alle möglichen Einstellung herauszubekommen, wirst Du um diese Liste nicht herumkommen. Schau Dir mal die Eigenschaften in Autocad eines eingefügten dynamischen Blockes an. Wenn Du unter Benutzerdefiniert einen Parameter antippst, erhältst Du genau diese Liste. Zum reinen Ermitteln der Werte mußt Du den Block nicht in eine neue Zeichnung kopieren, nur in Deiner Referenzzeichnung temporär einfügen Mal als Beispiel in Autocad:
Code:
Sub GetAttribute() Dim Ent As AcadObject Dim L1 As Integer, L2 As Integer Dim tBlock As AcadBlock Dim tBlockRef As AcadBlockReference Dim strPropName As String, st1 As String Dim varDyn As Variant Dim AV As Variant Dim InsertionPnt(0 To 2) As Double InsertionPnt(0) = 0#: InsertionPnt(1) = 0#: InsertionPnt(2) = 0# For Each Ent In ThisDrawing.Blocks If Not Ent.IsLayout Then ' Modell- und Paperspaceobjekte ausschließen If Not Left(Ent.Name, 1) = "*" Then ' anonyme Blöcke ausschließen ' Einfügen des Blocks in die Zeichnung Set tBlockRef = ThisDrawing.ModelSpace.InsertBlock(InsertionPnt, Ent.Name, 1#, 1#, 1#, 0) ' Name des Blockes ausgeben: Debug.Print tBlockRef.Name & " / " & tBlockRef.EffectiveName & " : "; ' Wenn es ein dynamischer Block ist If tBlockRef.IsDynamicBlock = True Then ' Holen der Eigenschaften und ausgeben varDyn = tBlockRef.GetDynamicBlockProperties For L1 = LBound(varDyn) To UBound(varDyn) Set DynBloProp = varDyn(L1) strPropName = DynBloProp.PropertyName st1 = DynBloProp.Value 'Ausgabe der Eigenschaft, später in Tabelle schreiben Debug.Print "Propname: " & strPropName & " / " & st1 ' <= in st1 wird der Standardwert ausgegeben AV = varDyn(L1).AllowedValues ' Ausgabe der erlaubten Werte For L2 = LBound(AV) To UBound(AV) Debug.Print "Allowed Values (" & L2 & ") : " & AV(L2) Next L2 Next L1 End If ' tBlockRef.IsDynamicBlock = True ' Eingefügten Block wieder löschen tBlockRef.Delete End If ' Not Left(ent.Name, 1) = "*" End If ' Not ent.IsLayout Next Ent End Sub
Grüße Klaus
[Diese Nachricht wurde von KlaK am 27. Feb. 2018 editiert.] Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
Andre B. Mitglied Sachbearbeiter und Zeichner
Beiträge: 19 Registriert: 04.02.2018 Win 10 64bit Access 2016 AutoCAD 2018 AutoCAD MEP 2018
|
erstellt am: 15. Mrz. 2018 12:08 <-- editieren / zitieren --> Unities abgeben:
Hallo Klaus, sorry, dass ich jetzt erst antworte. Komme zu nichts mehr. Ich wollte nur noch einen Riesigen DANK loswerden . Dat ist exakt was ich versucht habe. Grüße aus Bln, André ------------------ Die meisten Probleme entstehen bei ihrer Lösung. ------------------------------------------------
[Diese Nachricht wurde von Andre B. am 15. Mrz. 2018 editiert.] Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
| Anzeige.:
Anzeige: (Infos zum Werbeplatz >>)
|