Hot News:

Mit Unterstützung durch:

  Foren auf CAD.de (alle Foren)
  AutoCAD ObjectARX und .NET
  Layer Filter

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:  Layer Filter (2534 mal gelesen)
DrCNC
Mitglied



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

Beiträge: 96
Registriert: 04.01.2011

erstellt am: 04. Jan. 2011 23: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

Möchte mit VB.net Layer in der aktuellen Zeichnung Filtern (nach bestimmten Namen) oder auch Blöcke (mit Namen)
kann mir jemand helfen
danke im voraus!

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


Ex-Mitglied

erstellt am: 04. Jan. 2011 23:33    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat

Hi,

guck Dir bitte die Objektarten 'LayerTable', 'LayerTableRecord', 'BlockTable', 'BlockTableRecord' an (übergeordnet bzw. abgeleitet von 'SymbolTableRecord').
Diese helfen Dir sowohl beim Durchlesen durch die Layer wie auch der Blockdefinitionen.

Bleibst Du bei COM, dann hast Du (aus Deinem vorigen Codeschnippsel) die Zugriffe über:
ThisDrawing.Layers
ThisDrawing.Blocks

- alfred -

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

DrCNC
Mitglied



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

Beiträge: 96
Registriert: 04.01.2011

erstellt am: 06. Jan. 2011 00:53    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

Hi
Bringe das mit dem Layerfiltern nicht hin, habe diesen Code in VBA erfolgreich verwendet und in VB.net umgeschrieben.

Imports Autodesk.AutoCAD.Interop
Imports Autodesk.AutoCAD.Interop.Common
Imports Autodesk.AutoCAD.ApplicationServices

Module Z_Sonstiges
    Public ReadOnly Property ThisDrawing() As AcadDocument
        Get
            Return Autodesk.AutoCAD. _
                ApplicationServices.Application. _
                DocumentManager.MdiActiveDocument. _
                AcadDocument
        End Get
    End Property
   
      Public Function LayerAbfrage(ByVal LayerName As String)
        Dim ssAllLayObj As AcadSelectionSet
        Dim Objekt As AcadObject
        Dim FilterType(0) As Double
        Dim FilterData(0) As Object
        'Auswahlsatz löschen, falls vorhanden. Fehlerabfang, wenn nicht vorhanden
        On Error Resume Next
        ThisDrawing.SelectionSets.Item("AllLayerObj").Delete()
        'On Error GoTo 0
        'Auswahlsatz neu bilden
        ssAllLayObj = ThisDrawing.SelectionSets.Add("AllLayerObj")
        FilterType(0) = 8        'Filter nach Layer
        FilterData(0) = LayerName  'Layername
        'Alle Objekte des Layers in den Auswahlsatz aufnehmen
        ssAllLayObj.Select(AcSelect.acSelectionSetAll, , , FilterType, FilterData)
        LayerAbfrage = ssAllLayObj.Count
    End Function

Habe bereits nach deiner Idee auch dies probiert.

    Public Function LayerAbfrage(ByVal LayerName As String)
        Dim acDoc As Document = Application.DocumentManager.MdiActiveDocument
        Dim acCurDb As Database = acDoc.Database
        Using acTrans As Transaction = acCurDb.TransactionManager.StartTransaction()
            Dim acLyrTbl As LayerTable
            acLyrTbl = acTrans.GetObject(acCurDb.LayerTableId, _
                                OpenMode.ForRead)
            If Not acLyrTbl.Has(LayerName) Then
                LayerAbfrage = 0
            Else
                LayerAbfrage = 1
                'acDoc.Editor.WriteMessage(vbLf & "'MyLayer' ist vorhanden")
            End If
        End Using
    End Function

Kann Layer damit finden, aber auch leere (ohne Objekte)
Wenn kein Objekt auf diesen Layer ist soll er 0 oder false zurückgeben.
danke im voraus
DrCNC

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


Ex-Mitglied

erstellt am: 07. Jan. 2011 16:33    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat

Hi,

schau Dir mal dieses an und lass mich wissen, ob es das ist, was Du suchst.
Ich bin jetzt nicht soweit gegangen, dass ich alle Blockdefinitionen/Bemassungsstile/... durchsucht habe, ob diese auch Verweise auf dem gesuchten Layer haben, das ist noch zu machen, wenn Du es brauchst.

Code:
<Autodesk.AutoCAD.Runtime.CommandMethod("CADde_getLayerUsage")> _
Public Shared Sub CADde_getLayerUsage()
  Dim tAcadDoc As ApplicationServices.Document = ApplicationServices.Application.DocumentManager.MdiActiveDocument
  Dim tAcadDocDB As DatabaseServices.Database = tAcadDoc.Database
  Dim tTrAct As DatabaseServices.Transaction = Nothing
  Try
    tTrAct = tAcadDoc.TransactionManager.StartTransaction
    Dim tLayerName As String = "1"    'hier Deinen Layernamen einsetzen
    Dim tVal As Integer = getLayerUsage(tAcadDoc, tTrAct, tLayerName)
    Select Case tVal
      Case -1: Call MsgBox("Layer '" & tLayerName & "' nicht gefunden")
      Case 0:  Call MsgBox("Keine Elemente auf Layer '" & tLayerName & "' in Modellbereich oder Layouts gefunden, Layer existiert")
      Case Is > 0
        Call MsgBox(tVal.ToString & " Elemente auf Layer '" & tLayerName & "' in Modellbereich oder Layouts gefunden")
    End Select
  Catch ex As Exception
    Call MsgBox("Unbekannter Fehler aufgetreten" & vbNewLine & ex.Message)
  Finally
    If tTrAct IsNot Nothing Then tTrAct.Dispose() : tTrAct = Nothing
  End Try
End Sub

Private Shared Function getLayerUsage(ByRef AcadDoc As ApplicationServices.Document, ByVal TrAct As DatabaseServices.Transaction, ByVal LayerName As String) As Integer
  Dim tRetVal As Integer = -1  '-1 ==> unbekannt, möglicherweise Fehler im Ablauf aufgetreten
  Dim tAcadDB As DatabaseServices.Database = AcadDoc.Database
  Dim tLayTb As DatabaseServices.LayerTable = CType(TrAct.GetObject(tAcadDB.LayerTableId, DatabaseServices.OpenMode.ForRead), DatabaseServices.LayerTable)
  Dim tLayTbRec As DatabaseServices.LayerTableRecord = Nothing
  If tLayTb.Has(LayerName) Then
    'ok, wir wissen mal, dass es einen solchen Layer gibt
    Dim tLayTbRecID As DatabaseServices.ObjectId = tLayTb.Item(LayerName)
    If (tLayTbRecID.IsValid) AndAlso (Not tLayTbRecID.IsErased) Then
      'dieser LayerTableRecord ist gültig, nehmen wir
      tLayTbRec = CType(TrAct.GetObject(tLayTbRecID, DatabaseServices.OpenMode.ForRead), DatabaseServices.LayerTableRecord)
    Else
      'dann haben wir zwar einen Layernamen gefunden, der TableRecord ist aber gelöscht, dann durchscannen, bis wir den richtigen haben
      For Each tLayTbRecID In tLayTb
        If (tLayTbRecID.IsValid) AndAlso (tLayTbRecID.IsErased) Then
          Dim tLayTbRecTemp As DatabaseServices.LayerTableRecord = CType(TrAct.GetObject(tLayTbRecID, DatabaseServices.OpenMode.ForRead), DatabaseServices.LayerTableRecord)
          If tLayTbRecTemp.Name.ToUpper = LayerName.ToUpper Then
            'oh, es gibt doch einen mit dem richtigen Namen, der 'valid' ist
            tLayTbRec = tLayTbRecTemp
            Exit For
          End If
        End If
      Next
    End If
  End If

  'und sollten wir jetzt mal den gültigen Eintrag haben, dann weiter
  If tLayTbRec IsNot Nothing Then
    'ok, jetzt wissen wir, gelöscht kann der nicht werden
    'dann sehen wir noch nach, ob Elemente (Modellbereich oder Layouts) auf diesem Layer liegen
    Dim tSelSet As EditorInput.SelectionSet = getObjectsOnLayer(AcadDoc.Editor, TrAct, LayerName)
    If tSelSet IsNot Nothing Then
      tRetVal = tSelSet.Count
    Else
      tRetVal = 0 'Layer vorhanden, keine Elemente drauf
    End If
  End If

  Return tRetVal
End Function

Private Shared Function getObjectsOnLayer(ByRef Ed As EditorInput.Editor, ByVal TrAct As DatabaseServices.Transaction, ByVal LayerName As String) As EditorInput.SelectionSet
  Dim tRetVal As EditorInput.SelectionSet = Nothing
  Dim tFilterVal As DatabaseServices.TypedValue = New DatabaseServices.TypedValue(DatabaseServices.DxfCode.LayerName, LayerName)
  Dim tFilter As EditorInput.SelectionFilter = New EditorInput.SelectionFilter(New DatabaseServices.TypedValue() {tFilterVal})
  Try
    Dim tSelRes As EditorInput.PromptSelectionResult = Ed.SelectAll(tFilter)
    If tSelRes.Status = EditorInput.PromptStatus.OK Then
      tRetVal = tSelRes.Value
    Else
      'dann ist was nicht korrekt, voraussichtlich kein Layer, da dies der einzige Filter ist
    End If
  Catch ex As Exception
    'Fehler aufgetreten, damit ReturnValue auf Nothing setzen
    tRetVal = Nothing
  End Try
  Return tRetVal
End Function



- alfred -

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

DrCNC
Mitglied



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

Beiträge: 96
Registriert: 04.01.2011

erstellt am: 08. Jan. 2011 12:19    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

Hi,
Dein Code hat bestens funktioniert, besten Dank noch einmal.

ich habe aber dann noch mit deiner Funktion noch etwas anderes probiert.

    Public Function LayerAbfrage(ByVal LayerName As String)
        Dim acDoc As Document = Application.DocumentManager.MdiActiveDocument
        Dim acCurDb As Database = acDoc.Database
        Dim TrAct As DatabaseServices.Transaction = Nothing
        Dim tAcadDoc As ApplicationServices.Document = ApplicationServices.Application.DocumentManager.MdiActiveDocument
        Using acTrans As Transaction = acCurDb.TransactionManager.StartTransaction()
            Dim acLyrTbl As LayerTable
            acLyrTbl = acTrans.GetObject(acCurDb.LayerTableId, _
                                OpenMode.ForRead)
            If Not acLyrTbl.Has(LayerName) Then
                LayerAbfrage = 0
            Else
                Dim tSelSet As EditorInput.SelectionSet = getObjectsOnLayer(tAcadDoc.Editor, TrAct, LayerName)
                If tSelSet IsNot Nothing Then
                    LayerAbfrage = 1
                Else
                    LayerAbfrage = 0
                End If
            End If
        End Using
    End Function

Hat auch gut funktioniert und ist etwas kürzer.
Mit den Blöcken hat deine Funktion (DXF filter auf Blockname)auch bestens funktioniert.
Leider fehlen mir die Grundlagen (komme aus der Produktion, Handwerk und Industrie) mein Englisch ist auch sehr dürftig.
Danke
DrCNC

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


Ex-Mitglied

erstellt am: 08. Jan. 2011 18:09    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat

Hi,

ich habe die Schleife durchaus bewusst gemacht, die prüft, ob ein Layer vorhanden ist.

Folgender Fall: lege einen Layer 'A' an, lösche diesen wieder. ==> Du bekommst bei  acLyrTbl.Has(LayerName)  TRUE zurück, solange Du noch in der gleichen Session bist bzw. die DWG noch nicht geschlossen und wieder geöffnet hat.

Hat also schon Sinn, um zu erkennen, ob ein Layer (aus der Sicht des Anwenders) vorhanden ist oder nicht.

- alfred -

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

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