Hot News:

Unser Angebot:

  Foren auf CAD.de (alle Foren)
  AutoCAD VBA
  Schleife über Elemente in einem Block

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:  Schleife über Elemente in einem Block (2133 mal gelesen)
doubleq23
Mitglied


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

Beiträge: 6
Registriert: 11.06.2015

Windows 7 prof, AutoCAD 2017

erstellt am: 25. Okt. 2016 11: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 allerseits,

ich habe mal wieder eine Frage im Zusammenhang mit VBA und Blöcken.
Ziel wäre es, alle Objekte eines Blockes durchzugehen, zu prüfen ob es sich um einen Volumenkörper handelt und dann layerweise die Volumina aufzuaddieren. Ich finde gerade aber keinen Weg auf die Elemente eines Blockes zuzugreifen. Kann mir da jemand einen Tipp geben, wie das geht oder habe ich auf dem Weg keine Chance auf Erfolg?

Herzliche Grüße
Christian

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: 25. Okt. 2016 12:33    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 doubleq23 10 Unities + Antwort hilfreich

Hallo Christian,
bringst Du da gerade etwas durcheinander? 3DSolid <> Block ?
Oder hast Du Blöcke definiert die Volumenkörper beinhalten und die Blockreferenzen haben unterschiedliche Skalierungen?

Du solltest schon etwas genauer beschreiben was Du machen möchtest und evtl. eine Beispielzeichnung (dwg) beilegen.

Grüße
Klaus 

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

doubleq23
Mitglied


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

Beiträge: 6
Registriert: 11.06.2015

Windows 7 prof, AutoCAD 2017

erstellt am: 25. Okt. 2016 13: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

Hallo Klaus,

Danke für die Antwort - ich versuche mal etwas klarer zu beschreiben was ich erreichen möchte, da auch bei konkreteren Umsetzungsgedanken die Schwierigkeiten die das Vorhaben mit sich bringt deutlich werden.

Hintergrund ist folgender:
Ich habe Blöcke, die Volumenkörper enthalten welche auf verschiedenen Materiallayern liegen. Ich möchte nun mit einem Klick die Volumina aller Körper pro Layer aufsummieren um dann schließlich eine Massenermittlung durchzuführen.
Als kleine weitere Schwierigkeit kommt dazu, dass meine Blöcke neben Volumenkörpern auch weitere Blöcke mit Volumenkörpern enthalten können (verschachtelte Blöcke), die am Liebsten auch rekursiv mitgerechnet werden sollen.

Eigentlich wünsche ich mir einen Block, der die Eigenschaft "Gewicht" hat und mit Bezug auf eine Dichte pro Layer selbst seine enthalten Volumenkörper aufsummiert und die Gewichte von verschachtelten Blöcken (die selbige ja dann auch als Eigenschaft mit sich führen) einfach mitrechnet.

Wurde das jetzt etwas klarer?

Beste Grüße
Christian

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: 25. Okt. 2016 17: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 Nur für doubleq23 10 Unities + Antwort hilfreich

Hallo Christian,

Ein nettes Projekt, kann man schon machen. Aber dann solltest Du in jedem Block evtl. ein Attribut Gewicht mitführen.

Die Vorgehensweise wäre im Prinzip genauso wie in Deiner ersten Frage:
- Du durchsuchst Deine Auswahl (oder den Modellbereich)
- Wenn Du auf die Blockreferenz (object.name = "AcDbBlockReference") triffst wird diese untersucht und das Gewicht eingetragen
Beim untersuchen der Blockreferenz wirst Du jetzt auf zwei Varianten kommen:
- entweder Du findest ein 3DSolid, dann mußt Du über object.volumen und object.layer das Gewicht bestimmen
- oder Du findest wieder eine Blockreferenz, dann holst Du Dir daraus das Gewicht
- ist dieses noch nicht eingetragen müßte man evtl. aus der Blockdefinition zunächst dieses bestimmen

Wenn man eine Beispielzeichnung zum testen hätte wäre so ein Code eigentlich recht schnell geschrieben, zumal wenn alle Blockreferenzen nicht skaliert sind. Ansonsten müßte man bei Skalierungen kontrollieren wie sich das Volumen verhält, evtl. bei enthaltenen Rundungen den Block temporär sprengen um auf das richtige Volumen zu kommen.

Vielleicht habe ich heute abend ja mal Gelegenheit das anzugehen, jetzt gehts erstmal heim 

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: 25. Okt. 2016 18:52    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 doubleq23 10 Unities + Antwort hilfreich

Hi, mal so eben im Fundus gewühlt 

2 Funktionen um ersteinmal den gewünschen Block zu finden wenn es mehrere gibt:

Blockname is bekannt:

Function block_def_exists(blockname As String, Optional block As AcadBlock = Nothing) As Boolean
    block_def_exists = False
    On Error Resume Next
    err.Clear
    Set block = ThisDrawing.BLOCKS.ITEM(blockname)
    If Not block Is Nothing And err.Number = 0 Then block_def_exists = True
    On Error GoTo 0
End Function

Alternative: Block enthält Blockreference mit bestimmten gesetztem attribut.


Function Find_Block_by_attribute(ID As String) As String
Set Find_Block_by_attribute = ""
    Dim entity As AcadEntity
    Dim blockref As AcadBlockReference
    Dim block As AcadBlock
    Dim S As String

    For Each block In ThisDrawing.BLOCKS
        For Each entity In block
            If LCASE(entity.ObjectName) = "acdbblockreference" Then
                Set blockref = entity
                If blockref.EffectiveName = "POSMARK" Then
                   
                    test = block_get_attribute(blockref, "ID")
                    If test = ID Then
                        Set Find_Block_by_attribute = block.Name
                        Exit Function
                   
                    End If

                End If
            End If

        Next
    Next
End Function


nu den Block durchwühlen...

dim solid as acad3dsolid
dim layer as string
dim volumen as double
set Block=thisdrawing.blocks.item(blockname)
for each entity in block
if instr(lcase(entity.objectname),"solid")>0 then
set solid=entity
layer=solid.layer
volumen=solid.volumen

'so und ab hier ist es eine frage des Geschmacks wie man es aufaddiert

end if
next

Zum Aufaddieren:

Ganz rustikal: du mißbrauchst die Layer Kommentare als dictionary

Kindergarten: 2 Spaltiges textarray und immer feste durchlaufen umd dort den Layer zu finden 

Waghalsig: Du klebst die volumeninfo als xdata an die layer

Masochistisch: Du schreibst die in ein Zeichnungsdictionary

Penibel: du hast die layer von 1-x durchnummeriert und kanst den Index aus dem layernamen extrahieren

Cool und easy: Du schreibst die in ein scripting dictionary

Viel Spaß mit den Anregungen
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

doubleq23
Mitglied


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

Beiträge: 6
Registriert: 11.06.2015

Windows 7 prof, AutoCAD 2017

erstellt am: 26. Okt. 2016 15:12    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,

Danke für die Antwort! Genau so hatte ich mir das auch gedacht. Irgendwie dem Block ein Attribut für das Gewicht mitgeben und ggf. noch einen Zeitstempel, wann das zum letzten Mal berechnet wurde.
Mein erster Versuch (nach etwas Forumssuche) resultierte auch schon in einem Code bei dem ich einen Block auswähle und er dann für alle beinhalteten Volumenkörper Volumen und Layername ausgegeben hat.
Und verarbeitet werden eben Volumenkörper und Blockdefinitionen, bei denen dann mehr oder weniger rekursiv das Gleiche abläuft.

Ich bin nun noch am Überlegen wie ich die unterschiedlichen Dichten der Layer benutzerfreundlich zuweisen kann. Schön wäre natürlich, das Volumen pro Layer aufzusummieren und dann aus einer Liste für Layernamen eine Dichte auszulesen und bei unbekannten Layern nach einer Dichte zu fragen, die dann auch gleich in eine Datenbank kommt.
Hier hat ja Thomas (vielen Dank!) verschiedene Möglichkeiten mit plakativer Einschätzung gegeben - da würde ich mich mal noch ein bißchen einlesen. Die Frage ist tatsächlich auch, wie man das möglichst elegant lösen kann, da das als Tool bei uns voraussichtlich ziemlich häufig zu Einsatz kommen wird.

Ich werde mich in den nächsten Tagen weiter damit beschäftigen - wie es so zwischen das Tagesgeschäft so passt.

Beste Grüße
Christian

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

doubleq23
Mitglied


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

Beiträge: 6
Registriert: 11.06.2015

Windows 7 prof, AutoCAD 2017

erstellt am: 26. Okt. 2016 18:54    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 Thomas,
hallo Klaus,

ich sage schonmal vielen Dank für Eure Hinweise! Ich habe daraus jetzt für mich mal folgendes zusammengebastelt was wirklich super funktioniert:

Code:

Sub VolumenListe(Block As AcadBlock, ScriptingDictionary As Object, Optional Talk As Boolean = False)
    Dim i As Integer
    Dim AktSolid As Acad3DSolid
    Dim AktVolume As Double
       
    For i = 0 To Block.Count - 1
        'Wenn das aktuelle Objekt ein Volumenkörper ist
        If Block.Item(i).ObjectName = "AcDb3dSolid" Then
            'In entsprechende Variable casten
            Set AktSolid = Block.Item(i)
            'Volumen im passenden Layer aufsummieren
            With ScriptingDictionary
                AktVolume = .Item(AktSolid.Layer)
                AktVolume = AktVolume + AktSolid.volume
                .Item(AktSolid.Layer) = AktVolume
            End With
           
            'Kommandozeilenausgabe zu debugging-Zwecken wenn Talk=true
            If Talk Then ThisDrawing.Utility.Prompt Str(AktSolid.volume) & " " & AktSolid.Layer & vbCrLf
        End If
    Next i
End Sub

Bleibt noch das Problem mit den verschachtelten Blöcken und die Frage, wie ich den Wert zu diesem Zweck noch als Attribut ergänze. Da stehe ich vor der Aufgabe, dass ich das Attribut gerne zu einer Blockreferenz hinzufügen möchte, die schon eingefügt ist. Wenn ich mit AddAttribute Attribute hinzufüge, dann gilt das nur für Blöcke die ich danach einfüge..
Ich habe kein Problem damit, wenn ich jede Referenz einzeln bearbeiten muss, aber ich will den Block nicht immer neu einfügen müssen deswegen. Vielleicht öffne ich dazu auch noch einen neuen Thread bzw. schau morgen mal ob ich über die Suche noch was finde.
Das ScriptingDictionary war mir noch komplett unbekannt - ich bin echt begeistert.

Beste Grüße
Christian

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: 28. Okt. 2016 05:32    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 doubleq23 10 Unities + Antwort hilfreich

Hi Christian
Das mit den verschachtelten Blöcken hab ich früher mal mit Rekursion angegangen. Wenn man etwas drüber nachdenkt ist das grober Unfug 
Wenn an einfach alle Blöcke die es so gibt, erschlägt man auch die verschachtelten automatisch.

Attribute nachträglich einfügen ist kein Ding, wenn man begriffen hat das es egal ist ob paper modelspace - I acad ist ALLES ein Block.
Wenn man also den richtigen Block ermittelt hat...
Anstelle thisdrawing.modelspace ein
Dim Block as acadblock
set block = thisdrawings.block.item(blockname)
und nun anstelle this...ing.addattribute
BLOCK.addattribute(

So damit hast du den Block deines Vertrauens mit nem Attribut element versorgt.

HAKEN Deine Zeichnung weiß noch nicht von ihrem Glück...
Um das auf Reihe zu bekommen gibt es 2 Möglichkeiten.
Entweder liest du sämtliche referenzen bis ins letzte Detail aus, löscht die und fügst die wieder neu ein.  Kann man machen, ist aber ein Heidenaufwand in VBA.  Alles für den Fuß, thisdrawing.sendcommand mit dem richtigen Srring für attsync ist da "schneller" wobei das auch noch lahm ist. Interessanterweise ist das rasend schnell, wenn du die neuen Bläcke in eine neue Zeichung verfrachtest und anschließend die blockrefs hinterherkopierst. Den ganzen Kram in der temporären neuen Zeichnung zu einem Block zusammenfassen, alles in der Ursprungszeichnung löschen, den neuen Monsterblock zurück importieren und explodieren ist schnell. NEIN FRAG MICH NICHT 
In meinen letzten posts hab ich von diesen Techniken reichlich gebrauch gemacht.

zum thema Attsnc:
Sub block_entity_update(selectionset As AcadSelectionSet)
    Dim entity As AcadEntity
    Dim BLOCK As AcadBlock
    Dim blockref As AcadBlockReference
    Dim dict As New DICTIONARY_VBA
    Dim HA As String
   
    If selectionset.COUNT = 0 Then Exit Sub
    For Each entity In selectionset
        If TypeOf entity Is AcadBlockReference Then
            Set blockref = entity
            Dim BNAME As String
            BNAME = blockref.EffectiveName
            If Not dict.Exists(BNAME) Then
                If blockref.HasAttributes Then HA = "TRUE" Else HA = "FALSE"
                dict.Add BNAME, HA

                Set BLOCK = ThisDrawing.BLOCKS.ITEM(BNAME)
                Call block_def_entity_update(BLOCK)
            End If
        Else
            Call entity_update(entity)
        End If
    Next
    If dict.COUNT > 0 Then
        V = dict.keys
        For I = 0 To UBound(V)
            'If dict.ITEM(V(i)) = "TRUE" Then
                ThisDrawing.SendCommand "ATTSYNC" & vbCr & "n" & vbCr & V(I) & vbCr
            'End If
   
        Next
   
    End If
End Sub


Nicht über das DICTIONARY_VBA wundern 
Irgendjemand war mal so genial und hat das schripting dictionary in VBA nachgebaut. Ich benutz nur noch den Nachbau aus 5 Gründen:
1: kann man nachstricken
2: ist der glaub ich sogar schneller
3: keine externe Referenz
4: ziemlich kompatibel (drop in)
5: jemand war weit genialer als ich . Nee, ist so simpel und elegant, das ist abgefahren  Auf soetwas muß man erst einmal kommen ! 

Ich missbrauch diese Dictionarys auch oft dafür wenn ich UNIQUE Daten sammeln will
If not dict.exists dict.add ...

Gruß Thomas

CLASS KeyValuePair

'Unrestricted class just to hold pairs of values together and permit Dictionary object updating
Public key As String
Public Value As Variant

CLASS DICTIONARY VBA

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
    Dim oKVP As KeyValuePair
    Set oKVP = New KeyValuePair
    oKVP.key = key
    If IsObject(ITEM) Then
        Set oKVP.Value = ITEM
    Else
        Let oKVP.Value = ITEM
    End If
    KeyValuePairs.Add ITEM:=oKVP, key:=key
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() 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
    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

[Diese Nachricht wurde von rexxitall am 28. Okt. 2016 editiert.]

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

Ingenieur Studio HOLLAUS
Mitglied
CAD / CAFM / GIS Beratung-Programmierung-Schulung


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

Beiträge: 1049
Registriert: 06.11.2008

Autocad 2 bis Autocad 2020 (+Map3D, +Civil3D, +Infraworks)
RKV .... CAFM+mehr
HMap ... Vermessung und Verkehr
OoC .... Raumplanung
CBox ... Tools für AutoCAD und BricsCAD (kostenfrei)

erstellt am: 28. Okt. 2016 23:34    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 doubleq23 10 Unities + Antwort hilfreich

Achtung: wenn ich es richtig gesehen habe, dann ist hier nirgends berücksichtigt, dass ein Block skaliert eingefügt sein könnte; das würde aber das Volumen beeinflussen.

------------------


www.cars4fun.at

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: 29. Okt. 2016 15:16    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 doubleq23 10 Unities + Antwort hilfreich

Hi,
Guter Einwand, insbesondere da acad für Blöcke insgesamt 6 Skalierungsfunktionen hat, nebst dynamischen Parametern.

Und natürlich könnte ein Block ja auch nicht nur als Block sondern als Blockarray eingefügt worden sein, oder der Block hat auch noch Sichtbarkeitsparameter.

Nicht zu vergessen LISP Reaktoren die anhand des Sonnenstandes und der Elektrosmogneigung den Block sekündlich random skalieren mit Parametern, die auf nem russischen Server von Aliens fremdaktualisiert werden.  

Wnn die Volumen in einem Block skaliert worden sind, und das auch noch in xyz unterschiedlich, müsste man dessen Blockreferenz explodieren um das Volumen rauszubekommen.

Ferner könnten diese Volumina sich auch gegenseitig durchdringen, weil sie nicht vereinigt worden sind usw.
Aber ich vermute mal das diese Routine nicht für die NASA gedacht ist 

Also mann kann das ganze wiklich beliebig verkomplizieren  

Gruß Thomas


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

[Diese Nachricht wurde von rexxitall am 29. Okt. 2016 editiert.]

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

cadffm
Ehrenmitglied V.I.P. h.c.
良い精神



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

Beiträge: 21533
Registriert: 03.06.2002

System: F1
und Google

erstellt am: 29. Okt. 2016 17: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 Nur für doubleq23 10 Unities + Antwort hilfreich

Abgesehen davon das die Skalierung schon angesprochen wurde am Anfang:
Vergesst bitte die Meinfüge nicht, wenn die Nasa anfragt.

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

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

Brischke
Ehrenmitglied V.I.P. h.c.
CAD on demand GmbH



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

Beiträge: 4171
Registriert: 17.05.2001

ACAD20XX, defun-tools

erstellt am: 05. Nov. 2016 12:51    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 doubleq23 10 Unities + Antwort hilfreich

Zitat:
Original erstellt von rexxitall:
... Das mit den verschachtelten Blöcken hab ich früher mal mit Rekursion angegangen. Wenn man etwas drüber nachdenkt ist das grober Unfug 
Wenn an einfach alle Blöcke die es so gibt, erschlägt man auch die verschachtelten automatisch. ...

Sorry, das ist ja nun wirklicher Unfug, was du da schreibst. Natürlich bekommst du das Volumen aller innerhalb einer Blockdefinition vorhandenen Volumenkörper raus, wenn man die Blocktabelle durchläuft. Für diesen Schritt ist tatsächlich keine Rekursion erforderlich.
Ohne Rekursion kommst du allerdings niemals aus, wenn du das tatsächliche Volumen aller im Modellbereich letztendlich sichtbaren Elemente ermitteln möchtest.
Stell dir mal vor:
Block-A ist 2x innerhalb des Block-B verschachtelt und Block-B ist 3x innerhalb Block-C enthalten. Block-C ist 4x im Modellbereich eingefügt.
Block-A wäre dann über die Abfrage der Referenzen in der Zeichnungsdatenbank lediglich 2x zu finden. Im Modellbereich ist Block-A allerdings 24x zu8 sehen.
Wie willst du diese nun vollkommenen alltägliche Situation ohne Rekursion verarbeiten und am Ende das korrekte, sichtbare Volumen ermittelt haben?

Zitat:
Original erstellt von rexxitall:
Also mann kann das ganze wiklich beliebig verkomplizieren   


Sorry, auch diese Aussage kann ich absolut nicht teilen. Wenn irgendjemand aufgrund des ermittelten Gewichts einen Preis berechnet, ist das Projekt von Beginn an falsch kalkuliert. Wer hat Schuld? Wenn ich ein Programm rausgebe, von dem es heißt, dass es das Volumen der Geometrie berechnet, dann sollte das Ergebnis stimmen und die mit AutoCAD möglichen Arbeitsweisen auch berücksichtigen. Wenn ich die Ermittlung des korrekten Ergebnisses mit allerlei Einschränkungen der Arbeitsweise des Anwenders belege, dann braucht man nicht eine Zeile Code produzieren, denn das Ergebnis wird immer angezweifelt werden. Denn wer kann schon mit Sicherheit sagen, dass nicht doch irgendjemand im Laufe der Bearbeitung irgendeine nicht zulässige Form der Bearbeitung begangen hat?

Wenn man also mit einer Programmierung nicht sicher stellen kann, dass das Ergebnis stimmt ... kann man es auch gleich lassen. Einzige Ausnahme: ich, bin gleichzeitig Ersteller des Programms und der Zeichnung - nur in diesem Fall kann ich eine Bewertung des Ergebnis in richtig oder falsch vornehmen.

Grüße!
Holger

------------------
Holger Brischke
CAD on demand GmbH
Individuelle Lösungen von Heute auf Morgen.


defun-tools Das Download-Portal für AutoCAD-Zusatzprogramme!


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. Nov. 2016 19:23    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 doubleq23 10 Unities + Antwort hilfreich

Lieber Holger,
Ich weiß nicht warum du dich so künstlich aufregst.
Die Frage nach dem Umfang der Berechnung und dem Genauigkeitsanspruch würd ich der Einfachheit halber mal dem Programmaufsteller überlassen  Könnt ja sein das der nur Backsteine zählen will.

Nebebei bemerkt, kam von dir als Vollprofi recht wenig konstruktives zu einem möglichem Lösungsansatz.

In disem Sinne, schönes Restwochenende
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

Brischke
Ehrenmitglied V.I.P. h.c.
CAD on demand GmbH



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

Beiträge: 4171
Registriert: 17.05.2001

ACAD20XX, defun-tools

erstellt am: 07. Nov. 2016 09: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 Nur für doubleq23 10 Unities + Antwort hilfreich

Hallo Thomas,

ich rege mich nicht auf - ich habe eine Meinung (in diesem Fall zu dem, was du geschrieben hast), und diese Meinung habe ich kundgetan.
Dass mich Dinge im Forum aufregen, die Zeiten sind lange vorbei.

Dass du monierst, dass von mir kein Lösungsansatz kam, nur so viel: Ich habe ein Leben neben CAD.de, ich 'schlafe' auch nicht im Forum, so dass ich tatsächlich nicht immer als erster von einer Fragestellung etwas mitbekomme. Zum anderen wüsste ich auch nicht, dass ich mit meiner Anmeldung bei CAD.de und der freiwilligen und unentgeltlichen Moderatorentätigkeit irgendeine Verpflichtung eingegangen wäre, mein Wissen in jedem Fall zu teilen.
Abgesehen davon: VBA ist nun wirklich nicht meins.

Grüße!
Holger

------------------
Holger Brischke
CAD on demand GmbH
Individuelle Lösungen von Heute auf Morgen.


defun-tools Das Download-Portal für AutoCAD-Zusatzprogramme!


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