---

Ich habe einen Block auf einem Layer eingefügt. Wenn ich den Layer ausblende verschwindet der Block, d.h. er muss schon auf diesem layer liegen. Wenn ich aber in VBA versuche über ein Selectionsset den eingefügten Block zu finden klappt das nicht. hat jemand einen Tip ? Hier die Funktion:

Public Static Function GetLimitFromBlock(newDoc As AcadDocument) As Boolean
Dim sset As Object, Entity As AcadObject
Dim fType%(1), fData(1)

    On Error Resume Next
   
    Set sset = newDoc.SelectionSets("Rahmen")
    If Err.Number Then
      Set sset = newDoc.SelectionSets.Add("Rahmen")
    End If
    fType(0) = 0
    fData(0) = "INSERT"
    fType(0) = 8
    fData(0) = "vuski"
       
    sset.Select acSelectionSetAll, , , fType, fData
    For Each Entity In sset
  If Entity.EntityType = acBlock Then
              ' Hier kommt er nie an ?
        Print Entity.InsertionPoint
    End If
    Next
    sset.Delete
       
 
End Function

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

---

Hi,

Wie wäre es, wenn du den Filter so definierst:

Code:

---

    fType(0) = 0
    fData(0) = "INSERT"
    fType(1) = 8
    fData(1) = "vuski"

---

Gruß, Carsten

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

---

Gute Idee. Ich hatte zwischenzeitlich versucht mir alle Objekte auf vuski ausgeben zu lassen, daher der Fehler. Geht aber auch nicht wenn man 1 reinschreibt.
Noch ne Ide?

Freudi

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

---

Hi Freudi,

Hier noch ein Beispiel:

Public Sub test()
Dim sset As AcadSelectionSet
Dim Entity As AcadEntity
Dim fType%(0), fData(0)

    On Error Resume Next
 
    Set sset = ThisDrawing.SelectionSets("Rahmen")
    If Err.Number Then
      Set sset = ThisDrawing.SelectionSets.Add("Rahmen")
    End If
    fType(0) = 0
    fData(0) = "INSERT"
    fType(1) = 8
    fData(1) = "vuski"
     
    sset.Select acSelectionSetAll ', , , fType, fData
    For Each Entity In sset
  If Entity.EntityType = "IAcadBlockReference" Then
              ' Hier kommt er nie an ?
        MsgBox "Test"
    End If
    Next
    sset.Delete
End Sub

Gruß, Carsten

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

---

Geht auch nicht. Komischerweise findet er lauter LineObjecte obwohl er doch Inserts suchen soll. Ich iteriere jetzt durch alle Objecte der zeichnung , da findet er das.
Das reicht mir. Finde ich aber komisch das das mit Selektionen nicht geht.

Danke für die Hilfe
Freudi

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

---

Hallo Freudi,

dann mach mal den Kommentar aus Carstens Code vor dem Filter weg.
Und bevor du die Selektion anwendest machst du mal ein Zoom Grenzen.

Seltsamerweise werden nur sichtbare Objekte in das Selectionset übernommen.

Wilfried Stelberg

------------------
Warum lisp'eln wenn's auch anders geht.
www.ib-stelberg.de

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

---

Das macht wiedre Sinn. Mit Kommentar bekomme ich die Linien und ohne garnichts. Irgendwie sind die Kommentare in Autocad nicht gefärbt wie in meiner VB Umgebung. Das muss mich mal ändern dann wäre mir das gleich aufgefallen. Im Block sind 4 Linien die gruppiert sind, 3 davon sind sichtbar. Ich probiere es nochmal.

Danke

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

---

Hallo Freudi,

vielleicht hast du was mit dem Block falsch gemacht ?
Bei mir läuft es so:

Code:

---

Public Sub test()
Dim sset As AcadSelectionSet
Dim Entity As AcadEntity
Dim fType%(1), fData(1)

    On Error Resume Next
 
    Set sset = ThisDrawing.SelectionSets("Rahmen")
    If Err.Number Then
      Set sset = ThisDrawing.SelectionSets.Add("Rahmen")
    End If
    On Error GoTo 0
   
    fType(0) = 0
    fData(0) = "INSERT"
    fType(1) = 8  ' Layer
    fData(1) = "Layer1"
    fType(1) = 2  ' Blockname
    fData(1) = "Testblock"
   
    sset.Select acSelectionSetAll, , , fType, fData
    For Each Entity In sset
        If Entity.ObjectName = "AcDbBlockReference" Then
              ' Hier kommt er nie an ?
          MsgBox Entity.Name
        End If
    Next
    sset.Delete
End Sub

---

Wilfried Stelberg

------------------
Warum lisp'eln wenn's auch anders geht.
www.ib-stelberg.de

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

---

Sorry aber ich habe das jetzt wieder umstellen lassen und LWPOLYLINES anstatt Blöcken verwendet. Das hat zwar den Nachteil das wieder 4 Linien daraus werden wenn man es in eine andere Zeichnung kopiert ( ist mir auch ein Rätsel ) aber die 4 Linien sind dannn die längsten in der Zeichnung und so erkenne ich sie. Ich versuche es nochmal mit einer alter Zeichnung aber das ist mir zu unsicher. Irgendwie finde ich auch blöd das man Entitys keinen Namen geben kann. Dann könnte der Zeicher sagen die Linien die soundso heissen haben die und die Funktion und dann könnte per Programm prima wiederfinden. Das hatte ich schon mal in einem anderen Thread gefragt, aber das scheint nicht zu gehen.
Danke für die Hilfe
Freudi

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

---

Hallo Freudi,

du kannst schon einen Namen geben. Versuchs doch mal so

Code:

---

Public Sub MakeGroup()
    Dim ss As AcadSelectionSet
    Dim objGroup As AcadGroup
    Dim objEntitys() As AcadEntity
   
    On Error Resume Next
    Set ss = ThisDrawing.SelectionSets("GroupSel")
    If Err.Number Then
      Set ss = ThisDrawing.SelectionSets.Add("GroupSel")
    End If
    On Error GoTo 0
   
    ThisDrawing.Utility.Prompt Chr(10) & "Elemente der Gruppe wählen:"
    ss.SelectOnScreen
   
    Debug.Print ss.Count
    If ss.Count > 1 Then
      On Error Resume Next
      Set objGroup = ThisDrawing.Groups("MyGroup")
      If Err.Number Then
            ' Gruppe gab es noch nicht
            Set objGroup = ThisDrawing.Groups.Add("MyGroup")
      Else
            On Error GoTo 0
            ' Elemente entfernen
            If objGroup.Count > 0 Then
                ReDim objEntitys(0 To objGroup.Count - 1)
                For i = 0 To objGroup.Count - 1
                    Set objEntitys(i) = objGroup(i)
                Next i
                objGroup.RemoveItems objEntitys
            End If
      End If
      On Error GoTo 0
     
     
      ReDim objEntitys(0 To ss.Count - 1)
      For i = 0 To ss.Count - 1
          Set objEntitys(i) = ss(i)
      Next i
      objGroup.AppendItems objEntitys
         
    End If
   
End Sub

---

Dann kannst du einfach die Elemente der Gruppe lesen.

Wilfried Stelberg

------------------
Warum lisp'eln wenn's auch anders geht.
www.ib-stelberg.de

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

---

Ja das ist auch ne Möglichkeit der Zeichner kann sicher solche Gruppe über normale Menübefehle anlegen und ich Programmierer identfiziere diese dann mittels ThisDrawing.Groups("MyGroup").

Das ist doch noch mal ne Möglichkeit.

Danke
Freudi

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