Hot News:

Unser Angebot:

  Foren auf CAD.de (alle Foren)
  AutoCAD VBA
  Layerfilter löschen

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
Autor Thema:   Layerfilter löschen (990 mal gelesen)
otm
Mitglied
Bauingenieur


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

Beiträge: 131
Registriert: 26.08.2009

MS Win 10
AutoCAD Civil 3D 2019.3 Update
VBA Enabler 2019
MS Access Database Enginge X64
MSO 2016 (64bit)

erstellt am: 03. Aug. 2017 14:04    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

Liebes Forum,

ich versuche in C3D 2017 alle Layerfilter der aktuellen DWG mit folgendem Code zu löschen.

Code:

        Dim ent As AcadDictionary
        Dim strNames As String
        Dim blnLayFilter As Boolean
       
        Dim dict As AcadDictionary
        Set dict = ThisDrawing.Layers.GetExtensionDictionary("ACAD_LAYERFILTERS")

       
        If ThisDrawing.Layers.HasExtensionDictionary Then
       
            For Each ent In dict
                strNames = strNames & vbCrLf & ent.Name
                ent.Delete
                blnLayFilter = True
            Next ent
           
            If blnLayFilter Then
                MsgBox "Folgende Filter wurden aus der Zeichnung entfernt." & strNames, vbOKOnly, "Filter entfernt"
            Else
                MsgBox "Es gibt keine entfernbaren Layerfilter.", vbOKOnly, "Keine Filter"
            End If
        Else
            MsgBox "Es gibt gar keinen Layerfilter in der Zeichnung.", vbOKOnly, "Keine Filter"
        End If


Leider funktioniert es nicht.
Kann mir jemand sagen, woran das liegt?

------------------
Grüße aus München
Christian

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

KlaK
Ehrenmitglied V.I.P. h.c.
Dipl. Ing. Vermessung, CAD- und Netz-Admin



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

Beiträge: 2253
Registriert: 02.05.2006

AutoCAD LandDesktop R2 bis 2004
Civil 3D 2005 - 2020
Plateia, Canalis
Visual Basic

erstellt am: 08. Aug. 2017 18:57    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 Nur für otm 10 Unities + Antwort hilfreich

Hallo Christian,
im Prinzip lagst Du gar nicht so falsch, nur hast Du das verkehrte Dictionary aufgerufen. Dein "ACAD_LAYERFILTERS" gab es bis Acad 2004, jetzt heißt es "ACLYDICTIONARY"

Außerdem kann man den Namen des Filters nicht direkt lesen sondern muß ihn über den XRecord ermitteln

Hoffe es hilft,
Grüße
Klaus 

Code:

Sub DelLayerFilters()

        Dim ent As Variant
        Dim strNames As String
        Dim blnLayFilter As Boolean
     
        Dim dict As AcadDictionary
       
        Dim TrackingDictionary As AcadDictionary, TrackingXRecord As AcadXRecord
        Dim XRecordDataType As Variant, XRecordData As Variant
        Dim ArraySize As Long, iCount As Long
        Dim DataType As Integer, Data As String, msg As String

        If ThisDrawing.Layers.HasExtensionDictionary Then
       
          'Set dict = ThisDrawing.Layers.GetExtensionDictionary("ACAD_LAYERFILTERS")
          Set dict = ThisDrawing.Layers.GetExtensionDictionary("ACLYDICTIONARY")
          If dict.Count > 0 Then
            Set TrackingDictionary = dict ' ("ACLYDICTIONARY")
            For Each ent In dict
                Set TrackingXRecord = TrackingDictionary.GetObject(ent.Name)
                TrackingXRecord.GetXRecordData XRecordDataType, XRecordData
                ArraySize = UBound(XRecordDataType)
                ' Retrieve and display stored XRecordData
                For iCount = 0 To ArraySize
                ' Get information for this element
                  DataType = XRecordDataType(iCount)
                  Data = XRecordData(iCount)
                  Debug.Print DataType; " : "; Data
                  If DataType = 300 Then
                    strNames = strNames & vbCrLf & Data
                  End If
                Next
                ent.Delete
                blnLayFilter = True
            Next ent
          End If ' dict.Count
         
          If blnLayFilter Then
              MsgBox "Folgende Filter wurden aus der Zeichnung entfernt." & strNames, vbOKOnly, "Filter entfernt"
          Else
              MsgBox "Es gibt keine entfernbaren Layerfilter.", vbOKOnly, "Keine Filter"
          End If
        Else
            MsgBox "Es gibt gar keinen Layerfilter in der Zeichnung.", vbOKOnly, "Keine Filter"
        End If
        Exit Sub
ErrHandler:
        Debug.Print "Fehler : " & Err.Number & " : " & Err.Description
        Stop
        Resume Next
End Sub


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

otm
Mitglied
Bauingenieur


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

Beiträge: 131
Registriert: 26.08.2009

MS Win 10
AutoCAD Civil 3D 2019.3 Update
VBA Enabler 2019
MS Access Database Enginge X64
MSO 2016 (64bit)

erstellt am: 11. Sep. 2020 23:02    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

Hallo Klaus,

auch wenn der Beitrag schon sehr alt ist, hätte ich dazu noch eine Frage.

Wenn ich einen Eigenschaftsfilter (AB) habe, der wiederum einen  Unter-Eigenschaftsfilter (A) hat, dann ist die Anzahl der ermittelten Filter 2. Es wird aber nur die unterste Ebene (A) gelöscht und ist im Layermanager auch nicht mehr zu sehen.
Das Programm schreibt aber der Obere Filter (AB) sei gelöscht worden.
Der Filter (A) wird nicht erwähnt.

Lasse ich das Programm nochmals laufen ermittelt der Code 0 Layerfilter und entfernt somit auch keinen.
Der Filter (AB) ist aber immer noch da und funktioniert auch.
Auch nach dem Speichern und wieder Öffnen ändert sich nix.

Bilde ich in einer neuen Zeichnung nur einen Eigenschaftsfilter und lasse den Code laufen, wird ein Filter gefunden und als gelöscht ausgegeben, im Layermanager sehe ich den Filter aber immer noch.
Auch nach dem Speichern und wieder Öffnen ändert sich nix.

Woran kann das liegen?


------------------
Grüße aus München
Christian

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

KlaK
Ehrenmitglied V.I.P. h.c.
Dipl. Ing. Vermessung, CAD- und Netz-Admin



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

Beiträge: 2253
Registriert: 02.05.2006

AutoCAD LandDesktop R2 bis 2004
Civil 3D 2005 - 2020
Plateia, Canalis
Visual Basic

erstellt am: 12. Sep. 2020 17:02    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 Nur für otm 10 Unities + Antwort hilfreich

Hallo Christian,

Muß ich mir nächste Woche im Büro noch einmal ansehen.
Aber vermutlich liegt es daran dass wir nur ein Dictionary durchsucht haben und nicht beide ("ACAD_LAYERFILTERS" und "ACLYDICTIONARY")
Zumindest findet man hier den Hinweis darauf

Grüße
Klaus 

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

otm
Mitglied
Bauingenieur


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

Beiträge: 131
Registriert: 26.08.2009

MS Win 10
AutoCAD Civil 3D 2019.3 Update
VBA Enabler 2019
MS Access Database Enginge X64
MSO 2016 (64bit)

erstellt am: 13. Sep. 2020 21:46    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

Hallo Klaus,

danke für die Antwort.

Das lisp-Programm von CAD-Wiesel funktioniert einwandfrei.

http://ww3.cad.de/foren/ubb/Forum54/HTML/000991.shtml#000028

Auch mit mehreren Ebenen.

Vielleicht hilft das weiter?.

------------------
Grüße aus München
Christian

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

KlaK
Ehrenmitglied V.I.P. h.c.
Dipl. Ing. Vermessung, CAD- und Netz-Admin



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

Beiträge: 2253
Registriert: 02.05.2006

AutoCAD LandDesktop R2 bis 2004
Civil 3D 2005 - 2020
Plateia, Canalis
Visual Basic

erstellt am: 14. Sep. 2020 11:11    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 Nur für otm 10 Unities + Antwort hilfreich

Hallo Christian,
Ist im Prinzip der gleiche Code wie im ObjectARX-Code, beide Dictionarys werden geleert.
Aber wenn das Lisp läuft, brauchst Du ja den VBA-Code nicht mehr (Ich brauch ihn eh nicht  ).
Falls doch melde Dich einfach nochmal.

Grüße
Klaus 

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

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)2020 CAD.de | Impressum | Datenschutz