Hot News:

Unser Angebot:

  Foren auf CAD.de (alle Foren)
  AutoCAD VBA
  AutoCAD Sichtbarkeiten eines dynamischen Blocks mit VBA

Antwort erstellen  Neues Thema erstellen
CAD.de Login | Logout | Profil | Profil bearbeiten | Registrieren | Voreinstellungen | Hilfe | Suchen

Anzeige:

Darstellung des Themas zum Ausdrucken. Bitte dann die Druckfunktion des Browsers verwenden. | Suche nach Beiträgen nächster neuer Beitrag | nächster älterer Beitrag
  
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 (2771 mal gelesen)
Andre B.
Mitglied
Sachbearbeiter und Zeichner


Sehen Sie sich das Profil von Andre B. an!   Senden Sie eine Private Message an Andre B.  Schreiben Sie einen Gästebucheintrag für Andre B.

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 oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities

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



Sehen Sie sich das Profil von KlaK an!   Senden Sie eine Private Message an KlaK  Schreiben Sie einen Gästebucheintrag für KlaK

Beiträge: 2624
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 oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für Andre B. 10 Unities + Antwort hilfreich

Hallo André,
Willkommen im Forum 

Hier mal ein Code von unserem User Rexxitall zum Lesen der Parameter der dynamischen Blöcke

In der Hilfe findest Du die Eigenschaften

Grüße
Klaus 

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

rexxitall
Mitglied
Dipl. -Ing. Bau


Sehen Sie sich das Profil von rexxitall an!   Senden Sie eine Private Message an rexxitall  Schreiben Sie einen Gästebucheintrag für rexxitall

Beiträge: 266
Registriert: 07.06.2013

Various: systems, Operating systems, cad systems, cad versions, programming languages.

erstellt am: 06. Feb. 2018 21:29    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für Andre B. 10 Unities + Antwort hilfreich


dynblock.txt

 
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


Sehen Sie sich das Profil von Andre B. an!   Senden Sie eine Private Message an Andre B.  Schreiben Sie einen Gästebucheintrag für Andre B.

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 oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities

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


Sehen Sie sich das Profil von rexxitall an!   Senden Sie eine Private Message an rexxitall  Schreiben Sie einen Gästebucheintrag für rexxitall

Beiträge: 266
Registriert: 07.06.2013

Various: systems, Operating systems, cad systems, cad versions, programming languages.

erstellt am: 07. Feb. 2018 11:29    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für Andre B. 10 Unities + Antwort hilfreich

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


Sehen Sie sich das Profil von Andre B.  an!   Senden Sie eine Private Message an Andre B.  Schreiben Sie einen Gästebucheintrag für Andre B.

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 oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für Andre B. 10 Unities + Antwort hilfreich

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


Sehen Sie sich das Profil von rexxitall an!   Senden Sie eine Private Message an rexxitall  Schreiben Sie einen Gästebucheintrag für rexxitall

Beiträge: 266
Registriert: 07.06.2013

Various: systems, Operating systems, cad systems, cad versions, programming languages.

erstellt am: 09. Feb. 2018 13:09    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für Andre B. 10 Unities + Antwort hilfreich

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


Sehen Sie sich das Profil von Andre B. an!   Senden Sie eine Private Message an Andre B.  Schreiben Sie einen Gästebucheintrag für Andre B.

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 oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities

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 Next

Dim 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


Sehen Sie sich das Profil von Andre B. an!   Senden Sie eine Private Message an Andre B.  Schreiben Sie einen Gästebucheintrag für Andre B.

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 oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities

Keiner eine Idee, wie ich mit dem Problem weiterkomme?

------------------
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



Sehen Sie sich das Profil von KlaK an!   Senden Sie eine Private Message an KlaK  Schreiben Sie einen Gästebucheintrag für KlaK

Beiträge: 2624
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 oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für Andre B. 10 Unities + Antwort hilfreich

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


Sehen Sie sich das Profil von Andre B. an!   Senden Sie eine Private Message an Andre B.  Schreiben Sie einen Gästebucheintrag für Andre B.

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 oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities


Sichtbarkeiten.dwg

 
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



Sehen Sie sich das Profil von KlaK an!   Senden Sie eine Private Message an KlaK  Schreiben Sie einen Gästebucheintrag für KlaK

Beiträge: 2624
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 oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für Andre B. 10 Unities + Antwort hilfreich

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


Sehen Sie sich das Profil von Andre B. an!   Senden Sie eine Private Message an Andre B.  Schreiben Sie einen Gästebucheintrag für Andre B.

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 oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities

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



Sehen Sie sich das Profil von KlaK an!   Senden Sie eine Private Message an KlaK  Schreiben Sie einen Gästebucheintrag für KlaK

Beiträge: 2624
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 oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für Andre B. 10 Unities + Antwort hilfreich

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



Sehen Sie sich das Profil von KlaK an!   Senden Sie eine Private Message an KlaK  Schreiben Sie einen Gästebucheintrag für KlaK

Beiträge: 2624
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 oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für Andre B. 10 Unities + Antwort hilfreich


20180220_Datenextrakt.jpg

 
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


Sehen Sie sich das Profil von rexxitall an!   Senden Sie eine Private Message an rexxitall  Schreiben Sie einen Gästebucheintrag für rexxitall

Beiträge: 266
Registriert: 07.06.2013

Various: systems, Operating systems, cad systems, cad versions, programming languages.

erstellt am: 21. Feb. 2018 10:47    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für Andre B. 10 Unities + Antwort hilfreich

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


Sehen Sie sich das Profil von Andre B. an!   Senden Sie eine Private Message an Andre B.  Schreiben Sie einen Gästebucheintrag für Andre B.

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 oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities

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



Sehen Sie sich das Profil von KlaK an!   Senden Sie eine Private Message an KlaK  Schreiben Sie einen Gästebucheintrag für KlaK

Beiträge: 2624
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 oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für Andre B. 10 Unities + Antwort hilfreich

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


Sehen Sie sich das Profil von Andre B. an!   Senden Sie eine Private Message an Andre B.  Schreiben Sie einen Gästebucheintrag für Andre B.

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 oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities

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 >>)

Darstellung des Themas zum Ausdrucken. Bitte dann die Druckfunktion des Browsers verwenden. | Suche nach Beiträgen

nächster neuerer Beitrag | nächster älterer Beitrag
Antwort erstellen


Diesen Beitrag mit Lesezeichen versehen ... | Nach anderen Beiträgen suchen | CAD.de-Newsletter

Administrative Optionen: Beitrag schliessen | Archivieren/Bewegen | Beitrag melden!

Fragen und Anregungen: Kritik-Forum | Neues aus der Community: Community-Forum

(c)2023 CAD.de | Impressum | Datenschutz