---

Hallo,

ich benötige die Blockreferenzen aller Blöcke die 'Punkt' heissen
die der Benutzer in der Zeichnung ausgewählt hat.
Das habe ich mir in etwa so vorgestellt:

Code:

---

Dim acDoc As Document = Application.DocumentManager.MdiActiveDocument
Dim acCurDb As Database = acDoc.Database

Using tr As Transaction = acCurDb.TransactionManager.StartTransaction()
    Dim acSSPrompt As PromptSelectionResult = acDoc.Editor.GetSelection()
    If acSSPrompt.Status = PromptStatus.OK Then
        Dim acSSet As SelectionSet = acSSPrompt.Value
        For Each acSSObj As SelectedObject In acSSet

            Dim block As BlockReference = ????????  ' Hier fehlt mir was 

            If UCase(block.Name) = "PUNKT" Then
              ' mache dies und das

            End If
        Next
        tr.Commit()
    End If
End Using

---

Kann man das so machen oder muss man über die Blockdefinitionen
an die Blöcke rangehen ?

mfg, bccad

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

---

Hi,

guck mal >>>hier<<< wie SelectionSets gefiltert werden können.
Mit dem Suchbegriff SelectionSet lässt sich hier schon recht viel finden, kannst schon einiges darüber lesen. 

>> oder muss man über die Blockdefinitionen an die Blöcke rangehen ?

Obiges mit SelectionSet ist ein Weg, aber auch von der Blockdefinition kannst Du zu den BlockReferenzen kommen, siehe dazu die Funktion <BlockTableRecord>.GetBlockReferenceIds ==> liefert alle ObjectIDs der BlockReferenzen dieses Blocktyps.

Viel Erfolg, - alfred -

------------------
www.hollaus.at

---

Hallo Alfred,

mit dem ersten Vorschlag über Filter im Selectionset bin ich nicht klar gekommen. Deshalb habe ich den zweiten
Weg gewählt. Ich hab den Code mal rangehängt, vielleicht hilft es ja einem anderen.
Ich habe in VB.net deutlich mehr Schwierigkeiten mich da einzuarbeiten als in VBA für Autocad.
Gibt es aus Deiner Sicht Literatur die du empehlen könntest wo man wenigstens die Grundlagen vermittelt bekommt ?
Ich hänge nämlich schon wieder am nächsten Problem. Wie zoomt man auf Grenzen ohne SendCommand ?

mfg bccad

Code:

---

   
Dim doc As Document = Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument
Dim db As Database = HostApplicationServices.WorkingDatabase
Using tr As Transaction = doc.TransactionManager.StartTransaction

    ' Der erste Prgrammteil durchsucht alle Blockdefinitionen nach dem Block 'Punkt' und erzeugt
    ' eine Liste mit den IDs aller in der Zeichnung enthaltenen Blockreferenzen des Blockes 'Punkt'

    Dim oc As ObjectIdCollection = Nothing
    Dim bt As BlockTable = DirectCast(tr.GetObject(db.BlockTableId, OpenMode.ForRead, False), BlockTable)
    For Each id As ObjectId In bt
        If (id.IsValid) AndAlso (Not id.IsErased) Then
            Dim btr As BlockTableRecord = DirectCast(tr.GetObject(id, OpenMode.ForRead, False), BlockTableRecord)
            If UCase(btr.Name) = "PUNKT" Then
                oc = btr.GetBlockReferenceIds(False, True)
                Exit For
            End If
        End If
    Next

    ' Jetzt kann der Benutzer seine Auswahl treffen. Dann werden die ObjectID mit den IDs aus
    ' obriger Liste verglichen. Wenn es einen Treffer gibt wird die Blockreferenz ermittelt
    ' und kann entsprechend bearbeitet werden.

    If (oc IsNot Nothing) AndAlso (oc.Count > 0) Then
        Dim psr As PromptSelectionResult = doc.Editor.GetSelection()
        If psr.Status = PromptStatus.OK Then
            Dim ss As SelectionSet = psr.Value
            For Each so As SelectedObject In ss
                For Each oid As ObjectId In oc
                    If oid = so.ObjectId Then
                        Dim br As BlockReference = CType(tr.GetObject(oid, OpenMode.ForRead), BlockReference)

                        ' hier Beispiel-Code zum Attribute lesen
                       
                        For Each aid As ObjectId In br.AttributeCollection
                            Dim ar As AttributeReference = DirectCast(tr.GetObject(aid, OpenMode.ForRead),_
                                                                                        AttributeReference)
                            Dim tag As String = ar.Tag
                            Dim txt As String = ar.TextString
                        Next

                        Exit For
                    End If
                Next
            Next
        End If
        tr.Commit()
    End If
End Using

---

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

---

Hi,

hier ein Beispiel eines gefilterten SelectionSets.

gefiltert für Geometrietyp = BLOCKREFERENCE ("INSERT")
gefiltert für Blockname = "PUNKT"

Code:

---

Dim tAcadDoc As ApplicationServices.Document = ApplicationServices.Application.DocumentManager.MdiActiveDocument
Dim tTrAct As DatabaseServices.Transaction = Nothing
Try
  'Filter für Selektion bauen .... Filtern auf Typ = BLOCK .... Filtern auf Blockname = PUNKT
  Dim tSelFilterValues() As DatabaseServices.TypedValue =
    {New DatabaseServices.TypedValue(DatabaseServices.DxfCode.Start, "INSERT"),
    New DatabaseServices.TypedValue(DatabaseServices.DxfCode.BlockName, "PUNKT")
    }
  Dim tSelFilter As EditorInput.SelectionFilter = New EditorInput.SelectionFilter(tSelFilterValues)

  'selektieren
  Dim tSelRes As EditorInput.PromptSelectionResult = tAcadDoc.Editor.SelectAll(tSelFilter)
  If (tSelRes IsNot Nothing) AndAlso (tSelRes.Status = EditorInput.PromptStatus.OK) AndAlso (tSelRes.Value IsNot Nothing) Then
    tTrAct = tAcadDoc.TransactionManager.StartTransaction
    For Each tObjID As DatabaseServices.ObjectId In tSelRes.Value.GetObjectIds
      Dim tBlRef As DatabaseServices.BlockReference = CType(tTrAct.GetObject(tObjID, DatabaseServices.OpenMode.ForRead), DatabaseServices.BlockReference)
      If (tBlRef.AttributeCollection IsNot Nothing) AndAlso (tBlRef.AttributeCollection.Count > 0) Then
        For Each tAttRefID As DatabaseServices.ObjectId In tBlRef.AttributeCollection
          Dim tAttRef As DatabaseServices.AttributeReference = CType(tTrAct.GetObject(tAttRefID, DatabaseServices.OpenMode.ForRead), DatabaseServices.AttributeReference)
          'da ist jetzt die Attributreferenz
        Next
      End If
    Next
  Else
    tAcadDoc.Editor.WriteMessage("Keine gültige Objektselektion" & vbNewLine)
  End If

Catch ex As Exception
  Call MsgBox("Fehler aufgetreten (Position: 'CADde_SelSetFilterSample')" & vbNewLine & ex.Message)
Finally
  If tTrAct IsNot Nothing Then tTrAct.Dispose() : tTrAct = Nothing
End Try

---

- alfred -

------------------
www.hollaus.at

---

Hallo Alfred,

vielen Dank für Deine Hilfe. Obwohl ich mein Problem schon auf anderem Weg gelöst habe kann ich
Deine Lösung bestimmt noch gut gebrauchen.

mfg bccad

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