---

Hallo.

Ich habe folgendes Problem, ich füge mittels VBA einen Block in eine Zeichnung ein z.B. den Block "Buchetisch".
Nun möchte ich wenn dieser Block kopiert, oder mehrmals mit VBA eingefügt wurde zählen wie oft dieser Block in der Zeichnung vorkommt.

------------------
Gruß Dressler

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

---

Eine Block-Definition existiert nur einmal in einer Zeichnung. Das sichtbare in der Zeichnung sind Blockreferenzen, welche eine Art Visualisierung des Blockes darstellen. Und diese Blockreferenzen können natürlich dann mehrmals in der Zeichnung vorhanden sein. Und die sind es sicherlich auch , die du zählen möchtest.

Dafür kann ich dir eine "Lips"-zeile anbieten:

(sslength(ssget "_X" '((0 . "INSERT")(2 . "Tisch"))))

.. liefert dir die Anzahl der Blockreferenzen des Blockes namens "Tisch". Dürfte aber in VBA auch kein Problem sein..

------------------
- Thomas -

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

---

Hallo Thomas,

danke für die Antwort, nur suche ich das ganze halt für VBA.

------------------
Gruß Dressler

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

---

Hallo Dressler,

so ganz verkehrt ist die Antwort von Thomas nicht. Bezieht sich doch auch in VBA die Erstellung der Filterkriterien auf die AutoLISP-Syntax und DXF-Gruppencodes.
Folgend ein Bsp, welches leicht anzupassen ist, auf deine Belange:

Code:

---

Function test()
Dim All_E
Dim i As Integer
Dim Filter(9, 1) As Variant

Filter(0, 0) = -4
Filter(0, 1) = "<OR"
Filter(1, 0) = -4
Filter(1, 1) = "<AND"
Filter(2, 0) = 0
Filter(2, 1) = "Circle"
Filter(3, 0) = 8
Filter(3, 1) = "0"
Filter(4, 0) = -4
Filter(4, 1) = "AND>"
Filter(5, 0) = -4
Filter(5, 1) = "<AND"
Filter(6, 0) = 0
Filter(6, 1) = "Line"
Filter(7, 0) = 8
Filter(7, 1) = "1"
Filter(8, 0) = -4
Filter(8, 1) = "AND>"
Filter(9, 0) = -4
Filter(9, 1) = "OR>"

All_E = Select_All_Filter("All", Filter)
i = 0
End Function
Public Function Select_All_Filter(awsName As String, Optional GC_VG As Variant)
Dim awss As AcadSelectionSets
Dim aws As AcadSelectionSet
Dim i As Integer
Set aws = Nothing
'<AWS löschen
Set awss = ThisDrawing.SelectionSets
For i = 0 To awss.Count - 1
  If awss(i).Name = awsName Then
    awss(i).Delete
  End If
Next i
'AWS löschen>

'<Filter umsetzen
ReDim GC(0 To UBound(GC_VG)) As Integer
ReDim GC_Value(0 To UBound(GC_VG)) As Variant
For i = 0 To UBound(GC_VG)
    GC(i) = GC_VG(i, 0)
Next i
For i = 0 To UBound(GC_VG) '=Anzahl der gefundenen Elemente
    GC_Value(i) = GC_VG(i, 1)
Next i
'Filter umsetzen>

'<AWS setzen
Set aws = ThisDrawing.SelectionSets.Add(awsName)
aws.Select acSelectionSetAll, , , GC, GC_Value
'AWS setzen>
i = aws.Count - 1
ReDim elems(0 To i)
For i = 0 To aws.Count - 1
  Set elems(i) = aws.Item(i)
Next i

Select_All_Filter = elems
End Function

---

Bei Fragen ...

Grüße Holger

------------------
Holger Brischke
(defun - Lisp over night!
AutoLISP-Programmierung für AutoCAD
Da weiß man, wann man's hat!

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

---

Code:

---

'Anzahl der Blöcke in der Zeichnung mit der Bezeichnung BlockName
Public Function BlockCount(BlockName As String) As Long
    Dim SS As AcadSelectionSet
    Dim FltTypes(3) As Integer
    Dim FltData(3) As Variant

    Set SS = CreateSelectionSet("BlockAttUnvisibleAuswahl")

    FltTypes(0) = -4: FltData(0) = "<AND"
    FltTypes(1) = 0: FltData(1) = "INSERT"
    FltTypes(2) = 2: FltData(2) = BlockName
    FltTypes(3) = -4: FltData(3) = "AND>"
   
    ' Selectionset erstellen, Benutzer fragen und Filter anwenden
    SS.Clear
    SS.Select acSelectionSetAll, FilterType:=FltTypes, FilterData:=FltData
   
    BlockAnzahl = SS.Count
   
    SS.Clear
    Set SS = Nothing

End Function

Public Function CreateSelectionSet(Optional ssName As String = "SS") As AcadSelectionSet

    Dim objSelSet As AcadSelectionSet
    Dim objSelCol As AcadSelectionSets
   
    Set objSelCol = ThisDrawing.SelectionSets
    For Each objSelSet In objSelCol
      If objSelSet.Name = ssName Then
        objSelCol.Item(ssName).Delete
        Exit For
      End If
    Next
    Set objSelSet = objSelCol.Add(ssName)
    Set CreateSelectionSet = objSelSet

End Function

---

------------------
Roland

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

---

in Lisp eine Zeile .. in VBA eine Seite 

------------------
- Thomas -

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

---

grummel @ CADmium....
aber ich suche nunmal die VBA Variante.
Naja dann laß ich meinen Code mal weiter anwachsen.
Und Danke Roland für Deine Hilfe.

------------------
Gruß Dressler

[Diese Nachricht wurde von Dressler am 10. Mrz. 2004 editiert.]

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

---

Stimmt etwas an meiner Variante nicht?

------------------
Roland

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

---

Hallo Roland
ich bin noch nicht zum ausprobieren gekommen bisher, aber es sieht gut aus.

------------------
Gruß Dressler

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

---

Blockzahl.dvb.txt

Hier mal mein Versuch der so leider nocht nicht funktioniert:
> Modul1:

Public BlockAnzahl As Long

'Anzahl der Blöcke in der Zeichnung mit der Bezeichnung BlockName
Public Function BlockCount(BlockName As String) As Long
    Dim SS As AcadSelectionSet
    Dim FltTypes(3) As Integer
    Dim FltData(3) As Variant
    Set SS = CreateSelectionSet("BlockAttUnvisibleAuswahl")

    FltTypes(0) = -4: FltData(0) = "<AND"
    FltTypes(1) = 0: FltData(1) = "INSERT"
    FltTypes(2) = 2: FltData(2) = BlockName
    FltTypes(3) = -4: FltData(3) = "AND>"
   
    ' Selectionset erstellen, Benutzer fragen und Filter anwenden
    SS.Clear
    SS.Select acSelectionSetAll, FilterType:=FltTypes, FilterData:=FltData
   
    BlockAnzahl = SS.Count
   
    SS.Clear
    Set SS = Nothing

End Function

Public Function CreateSelectionSet(Optional ssName As String = "SS") As AcadSelectionSet

    Dim objSelSet As AcadSelectionSet
    Dim objSelCol As AcadSelectionSets
   
    Set objSelCol = ThisDrawing.SelectionSets
    For Each objSelSet In objSelCol
      If objSelSet.Name = ssName Then
        objSelCol.Item(ssName).Delete
        Exit For
      End If
    Next
    Set objSelSet = objSelCol.Add(ssName)
    Set CreateSelectionSet = objSelSet

End Function

> UserForm:

Private Sub CommandButton1_Click()
Modul1.BlockCount (A3) ' Blockname A3 soll gezählt werden
MsgBox BlockAnzahl
End Sub

Wo liegt denn nun der wahrscheinlich recht simple Fehler?

------------------
Gruß Dressler

[Diese Nachricht wurde von Dressler am 11. Mrz. 2004 editiert.]

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

---

Dein Code sollte so aussehen

Code:

---

Private Sub CommandButton1_Click()
    MsgBox BlockCount("A3")
End Sub

---

------------------
Roland

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

---

Hallo Thomas!
Hab diesen Beitrag grad gefunden und diese kleine LISP-Zeile

(sslength(ssget "_X" '((0 . "INSERT")(2 . "Tisch"))))

von Dir spart mir viel viel Arbeit (na ja, meinem Chef meine Arbeitszeit..  .) Drum vielen Dank dafür und auch wenns fast verjährt ist noch ein paar Us!

Grüße aus der sonnigen Sächsischen Schweiz!
Thomas   

------------------
Hinzufallen ist weder ein Unglück noch eine Schande. Liegenbleiben aber beides!

[Diese Nachricht wurde von Treppenflätz am 08. Aug. 2007 editiert.]

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