| | | 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 (2546 mal gelesen)
|
DrCNC Mitglied
Beiträge: 96 Registriert: 04.01.2011
|
erstellt am: 04. Jan. 2011 23:23 <-- editieren / zitieren --> Unities abgeben:
|
Ex-Mitglied
|
erstellt am: 04. Jan. 2011 23:33 <-- editieren / zitieren -->
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
Beiträge: 96 Registriert: 04.01.2011
|
erstellt am: 06. Jan. 2011 00:53 <-- editieren / zitieren --> Unities abgeben:
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 / zitieren -->
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 SubPrivate 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
Beiträge: 96 Registriert: 04.01.2011
|
erstellt am: 08. Jan. 2011 12:19 <-- editieren / zitieren --> Unities abgeben:
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 / zitieren -->
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 >>)
|