;;  Programm:      ACM-LAYERINHALT.LSP
;;  Befehlsaufruf: ACM-LAYERINHALT
;;  Funktion:      Listet alle auf einem Layer liegenden Objekttypen auf.
;;  Autor:         Gerhard Rampf
;;                 Kundenspezifische Anpassungen für AutoCAD und ZWCAD
;;                 Liebigstr. 3 A
;;                 86399 Bobingen
;;                 E-Mail: rampf@geracad.de
;;  Datum:         18.06.2023
;;  Plattform:     Alle AutoCAD-Versionen ab Version 2005
(defun c:acm-layerinhalt ( / lai27 ial01 ial02 ial03 ial04 ial05 ial06 ial07 ial08 ial09 ial10 ial11 ial12 ial13 ial14 ial15)
    (defun c:acm-Wiederherstellen ( / lai08 lai09)
        (if (= (type wsna7_ka99-no1_2023) 'LIST)
          (progn
            (setq lai08 (vla-get-Layers (vla-get-ActiveDocument (vlax-get-acad-object))))
              (while wsna7_ka99-no1_2023
                (setq lai09 (car wsna7_ka99-no1_2023))
                  (if (tblsearch "LAYER" (car lai09))
                    (vl-catch-all-apply 'vla-put-LayerOn (list (vla-Item lai08 (car lai09)) (cdr lai09)))
                  )
                (setq wsna7_ka99-no1_2023 (cdr wsna7_ka99-no1_2023))
              )
          )
          (alert "Aktuell ist kein Zeichnungszustand durch das Tool \042acm-layerinhalt\042 gespeichert.")
        )
      (princ)
    )
    (defun ial01 ( / lai11 lai12)
      (if
        (and
          (setq lai11 (ial14))
          (= (cadr lai11) "1")
        )
          (progn
            (setq lai12 (car lai11))
            (ial04 lai12)
            (prompt (strcat "\n*Layer \042" lai12 "\042 isoliert. Mit dem Befehlsaufruf ACM-WIEDERHERSTELLEN können Sie den vorherigen Zeichnungszustand wiederherstellen.* "))
          )
      )
    )
    (defun ial02 ( / lai13)
      (setq lai13 (strcase (getvar "PRODUCT")))
        (if
          (and
            (= lai13 "AUTOCAD")
            (getvar "HPDRAWORDER")
          )
            (setq lai14 T)
            (setq lai14 nil)
        )
        (if (not lai14)
          (alert "\042acm-layerinhalt\042 kann nur unter AutoCAD ab Version 2005 verwendet werden.")
        )
      lai14
    )
    (defun ial03 ( / lai15 lai16 lai17)
      (if
        (and
          (setq lai15 (vl-filename-mktemp "acm.dcl"))
          (setq lai16 (open lai15 "w"))
        )
          (progn
            (setq lai17
              (list
                "acm_layerinhalt"
                ":dialog{label=\042Layerinhalt\042;initial_focus=\042b_02\042;"
                ":spacer{height=0;}"
                ":row{"
                ":column{"
                ":text{label=\042Lay&er:\042;}"
                ":list_box{key=\042lb_01\042;width=33;}"
                ":text{}}"
                ":column{"
                ":text{label=\042Enthaltene Objekttypen:\042;}"
                ":list_box{key=\042lb_02\042;width=25;}"
                ":text{key=\042t_02\042;}}}"
                ":spacer{height=0.7;}"
                ":row{"
                ":toggle{key=\042tg_01\042;label=\042Ge&wählten Layer isolieren\042;}"
                ":button{key=\042b_00\042;label=\042&?\042;width=0;fixed_width=true;}"
                ":spacer{width=20;}}"
                ":spacer{height=0.5;}"
                ":row{"
                ":spacer{width=4;}"
                ":button{key=\042b_01\042;label=\042Schließen + Isolieren\042;width=17;fixed_width=true;is_default=true;}"
                ":button{key=\042b_02\042;label=\042&Schließen\042;width=17;fixed_width=true;is_cancel=true;}"
                ":spacer{width=4;}}}"
              )
            )
              (while lai17
                (write-line (car lai17) lai16)
                (setq lai17 (cdr lai17))
              )
            (setq lai16 (close lai16))
            lai15
          )
          nil
      )
    )
    (defun ial04 (lai01 / lai08 lai18)
      (if (tblsearch "LAYER" lai01)
        (progn
          (setq lai08 (vla-get-Layers (vla-get-ActiveDocument (vlax-get-acad-object))))
          (setq wsna7_ka99-no1_2023 (ial05))
          (ial06)
          (setq lai18 (vla-Item lai08 lai01))
          (vl-catch-all-apply 'vla-put-LayerOn (list lai18 :vlax-true))
          (vl-catch-all-apply 'vla-put-Freeze (list lai18 :vlax-false))
        )
      )
    )
    (defun ial05 ( / lai19 lai08 lai62 lai20)
      (setq lai19 (ial11))
      (setq lai08 (vla-get-Layers (vla-get-ActiveDocument (vlax-get-acad-object))))
        (vlax-for lai62 lai08
          (setq lai20 (cons (cons (vla-get-Name lai62) (vla-get-LayerOn lai62)) lai20))
        )
      lai20
    )
    (defun ial06 ( / lai21 lai22)
      (setq lai21 (getvar "CMDECHO"))
      (setvar "CMDECHO" 0)
      (setq lai22 (getvar "EXPERT"))
      (setvar "EXPERT" 5)
      (command "._-layer" "_off" "*")
        (while (vl-string-search "LAYER" (strcase (getvar "CMDNAMES")))
          (command "")
        )
      (setvar "EXPERT" lai22)
      (setvar "CMDECHO" lai21)
    )
    (defun ial07 (lai02 lai03 / lai23 lai24)
      (if
        (and
          (= (type lai02) 'STR)
          (= (type lai03) 'STR)
        )
          (progn
            (setq lai02 (vl-string-trim lai03 lai02))
            (setq lai02 (vl-string-trim " " lai02))
              (while (setq lai23 (vl-string-search lai03 lai02))
                (setq lai24 (append lai24 (list (substr lai02 1 lai23))))
                (setq lai02 (vl-string-left-trim lai03 (substr lai02 (1+ lai23))))
              )
            (setq lai24 (append lai24 (list lai02)))
          )
      )
      lai24
    )
    (defun ial08 (lai04 / lai25 lai14)
        (setq lai25
          (list
            (cons "ACDB2DPOLYLINE" "2D-Polylinie")
            (cons "ACDBFACE" "3D-Fläche")
            (cons "ACDB3DPOLYLINE" "3D-Polylinie")
            (cons "ACDB3DSOLID" "3D-Volumenkörper")
            (cons "ACDBVIEWPORT" "Ansichtsfenster")
            (cons "ACDBATTRIBUTE" "Attribut")
            (cons "ACDBATTRIBUTEDEFINITION" "Attributdefinition")
            (cons "ACDBTRACE" "Band")
            (cons "ACDBROTATEDDIMENSION" "Gedrehte Bemaßung")
            (cons "ACDBALIGNEDDIMENSION" "Ausgerichtete Bemaßung")
            (cons "ACDBRADIALDIMENSION" "Radiusbemassung")
            (cons "ACDBDIAMETRICDIMENSION" "Durchmesserbemassung")
            (cons "ACDB2LINEANGULARDIMENSION" "Winkelbemassung")
            (cons "ACDB3POINTANGULARDIMENSION" "3-Punkt-Winkelbemassung")
            (cons "ACDBORDINATEDIMENSION" "Koordinatenbemassung")
            (cons "ACDBBLOCKREFERENCE" "Blockreferenz")
            (cons "ACDBARC" "Bogen")
            (cons "ACDBARCDIMENSION" "Bogenbemaßung")
            (cons "ACDBARCALIGNEDTEXT" "Bogentext")
            (cons "ACDBDWFUNDERLAY" "DWF-Unterlage")
            (cons "ACDBELLIPSE" "Ellipse")
            (cons "ACDBXREF" "Externe Referenz")
            (cons "ACDBLEADER" "Führung")
            (cons "ACDBCAMERA" "Kamera")
            (cons "ACDBXLINE" "Klinie")
            (cons "ACDBCIRCLE" "Kreis")
            (cons "ACDBLIGHT" "Licht")
            (cons "ACDBLINE" "Linie")
            (cons "ACDBMINSERTBLOCK" "Meinfüg Block")
            (cons "ACDBMTEXT" "MText")
            (cons "ACDBMLEADER" "Multi-Führungslinie")
            (cons "ACDBMLINE" "Multilinie")
            (cons "ACDBSUBDMESH" "Netz")
            (cons "ACDBRASTERIMAGE" "Pixelbild")
            (cons "ACDBPOLYGONMESH" "Polygonnetz")
            (cons "ACDBPOLYLINE" "Polylinie")
            (cons "ACDBPOINT" "Punkt")
            (cons "ACDBREGION" "Region")
            (cons "ACDBSECTIONOBJECT" "Schnittobjekt")
            (cons "ACDBHATCH" "Schraffur")
            (cons "ACDBSOLID" "Solid")
            (cons "ACDBHELIX" "Spirale")
            (cons "ACDBSPLINE" "Spline")
            (cons "ACDBRAY" "Strahl")
            (cons "ACDBSHAPE" "Symbol")
            (cons "ACDBTABLE" "Tabelle")
            (cons "ACDBTEXT" "Text")
            (cons "ACDBFCF" "Toleranz")
            (cons "ACDBRADIALDIMENSIONLARGE" "Verkürzte Radiusbemaßung")
            (cons "ACDBPOLYFACEMESH" "Vielflächennetz")
            (cons "ACDBBODY" "Volumenkörper")
            (cons "ACDBWIPEOUT" "Wipeout")
          )
        )
        (if (not (setq lai14 (cdr (assoc (strcase lai04) lai25))))
          (setq lai14 lai04)
        )
      lai14
    )
    (defun ial09 (lai05 / lai26)
      (setq lai26 (vla-get-ObjectName lai05))
        (if (= (strcase lai26) "ACDBBLOCKREFERENCE")
          (progn
            (if (/= (type (vl-catch-all-apply 'vlax-get (list lai05 'Path))) 'VL-CATCH-ALL-APPLY-ERROR)
              (setq lai26 "AcDbXref")
            )
          )
        )
      lai26
    )
    (defun ial10 ( / lai27 lai08 lai62 lai29)
      (setq lai27 (vla-get-ActiveDocument (vlax-get-acad-object)))
      (setq lai08 (vla-get-Layers lai27))
        (vlax-for lai62 lai08
          (if (not (vl-string-search "|" (setq lai28 (vlax-get lai62 'Name))))
            (setq lai29 (cons lai28 lai29))
          )
        )
      (acad_strlsort lai29)
    )
    (defun ial11 ( / lai27 lai08 lai62 lai29)
      (setq lai27 (vla-get-ActiveDocument (vlax-get-acad-object)))
      (setq lai08 (vla-get-Layers lai27))
        (vlax-for lai62 lai08
          (setq lai29 (cons (vlax-get lai62 'Name) lai29))
        )
      (acad_strlsort lai29)
    )
    (defun ial12 (lai06 lai07 / lai30)
      (setq lai30 0)
        (while lai06
            (if (= (car lai06) lai07)
              (setq lai30 (1+ lai30))
            )
          (setq lai06 (cdr lai06))
        )
      lai30
    )
    (defun ial13 ( / lai31 lai32 lai33 lai34 lai35 lai36 lai37 lai38 lai39 lai40 lai41 lai42 lai43 lai44)
      (setq lai31 (ial10))
        (while lai31
          (setq lai32 nil)
          (setq lai33 nil)
          (setq lai34 "")
          (setq lai35 (ssget "_x" (list (cons 8 (setq lai36 (car lai31))))))
            (if lai35
              (progn
                (setq lai37 -1)
                (setq lai38 (sslength lai35))
                  (repeat lai38
                    (setq lai39 (ssname lai35 (setq lai37 (1+ lai37))))
                    (setq lai40 (ial08 (ial09 (vlax-ename->vla-object lai39))))
                    (setq lai33 (cons lai40 lai33))
                      (if (not (vl-position lai40 lai32))
                        (setq lai32 (cons lai40 lai32))
                      )
                  )
                  (while lai32
                    (setq lai41 (car lai32))
                    (setq lai42 (ial12 lai33 lai41))
                    (setq lai33 (vl-remove lai41 lai33))
                    (setq lai34 (strcat lai34 (strcat lai41 " (" (itoa lai42) ")") "|"))
                    (setq lai32 (cdr lai32))
                  )
                (setq lai43 (cons (cons lai36 (vl-string-right-trim "|" lai34)) lai43))
                (setq lai44 (cons (cons lai36 lai38) lai44))
              )
              (progn
                (setq lai43 (cons (cons lai36 "Keine Objekte auf gew. Layer") lai43))
                (setq lai44 (cons (cons lai36 0) lai44))
              )
            )
          (setq lai31 (cdr lai31))
        )
      (list lai43 lai44)
    )
    (defun ial14 ( / lai46 lai47 lai48 lai49 lai50 lai51 lai52 lai53 lai54 lai55 lai56 lai57 lai58 lai59 lai60 lai61)
        (if (not (vl-position wsna7_ka99-no2_2023 (list "0" "1")))
          (setq wsna7_ka99-no2_2023 "0")
        )
      (setq lai46 (ial10))
      (setq lai47 (getvar "CLAYER"))
      (setq lai48 (vl-position lai47 lai46))
      (setq lai49 (car (setq lai50 (ial13))))
      (setq lai51 (cadr lai50))
        (if (setq lai52 (ial03))
          (progn
            (setq lai53 (load_dialog lai52))
              (if (not (new_dialog "acm_layerinhalt" lai53))
                (exit)
              )
            (vl-catch-all-apply 'vl-file-delete (list lai52))
            (start_list "lb_01")
            (mapcar 'add_list lai46)
            (end_list)
            (set_tile "lb_01" (itoa lai48))
            (setq lai54 lai47)
            (setq lai55 (cdr (assoc lai54 lai49)))
            (setq lai56 (acad_strlsort (ial07 lai55 "|")))
            (setq lai57 (cdr (assoc lai54 lai51)))
              (if (< lai57 2)
                (set_tile "t_02" (strcat (itoa lai57) " Objekt gesamt"))
                (set_tile "t_02" (strcat (itoa lai57) " Objekte gesamt"))
              )
            (start_list "lb_02")
            (mapcar 'add_list lai56)
            (end_list)
            (set_tile "tg_01" wsna7_ka99-no2_2023)
              (if (= (getvar "TILEMODE") 0)
                (progn
                  (mode_tile "tg_01" 1)
                  (set_tile "tg_01" "0")
                )
              )
            (mode_tile "b_01" (nth (atoi (get_tile "tg_01")) (list 1 0)))
            (action_tile "tg_01" "(mode_tile \"b_01\" (nth (atoi $value) (list 1 0)))")
            (action_tile "b_00" "(ial15)")
              (action_tile "lb_01" "(setq lai54 (nth (atoi $value) lai46))
                (setq lai55 (cdr (assoc lai54 lai49)))
                (setq lai56 (acad_strlsort (ial07 lai55 \"|\")))
                (start_list \"lb_02\")
                (mapcar 'add_list lai56)
                (end_list)
                (setq lai57 (cdr (assoc lai54 lai51)))
                  (if (= lai57 1)
                    (set_tile \"t_02\" (strcat (itoa lai57) \" Objekt gesamt\"))
                    (set_tile \"t_02\" (strcat (itoa lai57) \" Objekte gesamt\"))
                  )"
              )
              (action_tile "lb_02" "(setq lai58 $value) (setq lai54 (nth (atoi (setq lai59 (get_tile \"lb_01\"))) lai46))
                (setq lai55 (cdr (assoc lai54 lai49)))
                (setq lai56 (acad_strlsort (ial07 lai55 \"|\")))
                (start_list $key)
                (mapcar 'add_list lai56)
                (end_list)
                (mode_tile \"lb_01\" 2)
                (set_tile \"lb_01\" lai59)"
              )
              (action_tile "b_01" "(setq lai60 (list (nth (atoi (get_tile \"lb_01\")) lai46)
                (setq lai61 (get_tile \"tg_01\"))))
                  (if (= (getvar \"TILEMODE\") 1)
                    (setq wsna7_ka99-no2_2023 lai61)
                  )
                (done_dialog)"
              )
              (action_tile "b_02" "(setq lai60 nil)
                  (if (= (getvar \"TILEMODE\") 1)
                    (setq wsna7_ka99-no2_2023 (get_tile \"tg_01\"))
                  )
                (done_dialog)"
              )
            (start_dialog)
            (unload_dialog lai53)
          )
        )
      lai60
    )
    (defun ial15 ( / )
      (if (= (getvar "TILEMODE") 1)
        (alert "Isoliert den gewählten Layer, indem alle\nanderen Layer ausgeschaltet werden. Mit\ndem Befehl \042acm-wiederherstellen\042 kann\nder vorherige Zeichnungszustand wieder-\nhergestellt werden.")
        (alert "Die Option \042Gewählten Layer isolieren\042 steht\nnur im Modellbereich zur Verfügung.")
      )
    )
  (if (ial02)
    (progn
      (vl-load-com)
      (setq lai27 (vla-get-ActiveDocument (vlax-get-acad-object)))
      (vla-EndUndoMark lai27)
      (vla-StartUndoMark lai27)
      (ial01)
      (vla-EndUndoMark lai27)
    )
  )
  (princ)
)
(terpri)
(princ "\nAutoLISP-Tool ACM-LAYERINHALT (Copyright © 2023 Gerhard Rampf) geladen.")
(princ "\nRufen Sie den Befehl mit ACM-LAYERINHALT auf.")
