;;;   Programm:      ACM-LOESCHENLF.LSP
;;;   Befehlsaufruf: ACM-LOESCHENLF
;;;   Funktion:      Per Layerfilter gebildeten Auswahlsatz löschen.
;;;   Autor:         Gerhard Rampf
;;;                  Kundenspezifische Anpassungen für AutoCAD und ZWCAD
;;;                  Liebigstr. 3 A
;;;                  86399 Bobingen
;;;                  E-Mail: rampf@geracad.de
;;;   Datum:         06.05.2024
;;;   Plattform:     Alle AutoCAD-Versionen ab Version 2005
(defun c:acm-loeschenlf ( / llf78 llf79 lfl01 lfl02 lfl03 lfl04 lfl05 lfl06 lfl07 lfl08 lfl09 lfl10 lfl11 lfl12 lfl13 lfl14 lfl15 lfl16 lfl17 lfl18)
    (defun lfl01 (llf01 llf02 / llf16 llf17 llf18 llf19 llf21 llf20)
      (if (= llf02 "")
        (progn
          (alert "Keine Eingabe für \042Suchen nach\042.")
          (mode_tile "eb_01" 2)
        )
        (progn
          (setq llf16 (mapcar 'strcase llf01))
          (setq llf17 (strcase llf02))
          (setq llf18 "")
          (setq llf19 -1)
          (setq llf20 0)
            (repeat (length llf16)
              (setq llf19 (1+ llf19))
                (if (wcmatch (nth llf19 llf16) llf17)
                  (progn
                    (setq llf18 (strcat llf18 (itoa llf19) " "))
                    (setq llf20 (1+ llf20))
                  )
                )
            )
            (if
              (and
                (<= llf20 250)
                (/= (setq llf21 (vl-string-trim " " llf18)) "")
              )
                (progn
                  (set_tile "lb_01" "")
                  (set_tile "lb_01" llf21)
                  (mode_tile "b_01" 0)
                )
                (progn
                  (set_tile "lb_01" "0")
                  (set_tile "lb_01" "")
                    (if (> llf20 250)
                      (alert "Ungültige Auswahl. Mehr als 250 entsprechende Layer gefunden.")
                      (alert "Es wurden keine entsprechenden Layer gefunden.")
                    )
                  (mode_tile "eb_01" 2)
                  (mode_tile "b_01" 1)
                )
            )
        )
      )
    )
    (defun lfl02 ( / llf22)
      (setq llf22 (strcase (getvar "PRODUCT")))
        (if
          (and
            (= llf22 "AUTOCAD")
            (getvar "HPDRAWORDER")
          )
            (setq llf23 T)
            (setq llf23 nil)
        )
        (if (not llf23)
          (alert "\042acm-loeschenlf\042 kann nur unter AutoCAD ab Version 2005 verwendet werden.")
        )
      llf23
    )
    (defun lfl03 (llf03 / )
      (if llf79 (setq *error* llf79))
      (vla-EndUndoMark (vla-get-ActiveDocument (vlax-get-acad-object)))
      (princ)
    )
    (defun lfl04 ( / llf24 llf39 llf25 llf26)
      (setq llf24 (vla-get-Layers (vla-get-ActiveDocument (vlax-get-acad-object))))
        (vlax-for llf39 llf24
          (setq llf25 (vlax-get llf39 'Name))
            (if
              (and
                (/= (vla-get-Lock llf39) :vlax-true)
                (not (vl-string-search "|" llf25))
                (/= (strcase llf25) "DEFPOINTS")
              )
                (setq llf26 (cons llf25 llf26))
            )
        )
      (acad_strlsort llf26)
    )
    (defun lfl05 ( / llf27 llf28 llf29 llf30)
      (setq llf27 (cdr (assoc 8 ndl8a2_-kal3ah2-aa)))
      (setq llf28 (lfl07 llf27 ","))
        (while llf28
          (setq llf29 (car llf28))
          (setq llf30 (cons llf29 llf30))
          (setq llf28 (cdr llf28))
        )
        (if llf30
          (progn
            (setq llf30 (acad_strlsort llf30))
            (prompt "\n ")
            (prompt (strcat "\n" (itoa (length llf30)) " Filterlayer gewählt: "))
              (while llf30
                (prompt (strcat "\n" (car llf30) " "))
                (setq llf30 (cdr llf30))
              )
            (prompt "\n ")
          )
        )
    )
    (defun lfl06 ( / llf27 llf28 llf29 llf31 llf32 llf33)
        (if
          (and
            (lfl04)
            (= (type ndl8a2_-kal3ah2-aa) 'LIST)
            (setq llf27 (cdr (assoc 8 ndl8a2_-kal3ah2-aa)))
          )
            (progn
              (setq llf24 (vla-get-Layers (vla-get-ActiveDocument (vlax-get-acad-object))))
              (setq llf28 (lfl07 llf27 ","))
                (while llf28
                    (if
                      (and
                        (tblsearch "LAYER" (setq llf29 (car llf28)))
                        (/= (vla-get-Lock (vlax-ename->vla-object (tblobjname "LAYER" llf29))) :vlax-true)
                        (/= (strcase llf29) "DEFPOINTS")
                      )
                        (setq llf31 (cons llf29 llf31))
                    )
                  (setq llf28 (cdr llf28))
                )
                (if llf31
                  (setq llf32 (acad_strlsort llf31))
                  (setq llf32 nil)
                )
            )
            (setq llf32 nil)
        )
        (if llf32
          (progn
            (setq llf33 "")
              (while llf32
                (setq llf29 (car llf32))
                (setq llf33 (strcat llf33 llf29 ","))
                (setq llf32 (cdr llf32))
              )
            (setq llf33 (lfl13 llf33 1))
            (setq ndl8a2_-kal3ah2-aa (list (cons 8 llf33)))
          )
          (setq ndl8a2_-kal3ah2-aa nil)
        )
    )
    (defun lfl07 (llf04 llf05 / llf35 llf36)
      (if
        (and
          (= (type llf04) 'STR)
          (= (type llf05) 'STR)
        )
          (progn
            (setq llf04 (vl-string-trim llf05 llf04))
            (setq llf04 (vl-string-trim " " llf04))
              (while (setq llf35 (vl-string-search llf05 llf04))
                (setq llf36 (append llf36 (list (substr llf04 1 llf35))))
                (setq llf04 (vl-string-left-trim llf05 (substr llf04 (1+ llf35))))
              )
            (setq llf36 (append llf36 (list llf04)))
          )
      )
      llf36
    )
    (defun lfl08 (llf06 llf07 / llf37 llf38 llf39 llf35)
      (setq llf37 (strlen llf06))
      (setq llf38 1)
        (while (<= llf38 llf37)
          (setq llf39 (substr llf06 llf38 1))
            (if (/= llf39 llf07)
              (progn
                (setq llf35 nil)
                (setq llf38 (1+ llf38))
              )
            )
            (if (= llf39 llf07)
              (progn
                (setq llf35 llf38)
                (setq llf38 (1+ llf37))
              )
            )
        )
      llf35
    )
    (defun lfl09 (llf06 llf08 / llf37 llf39 llf19 llf40)
      (setq llf37 (strlen llf06))
      (setq llf39 (substr llf06 1 1))
      (setq llf19 0)
        (while
          (and
            (/= (member llf39 llf08) nil)
            (/= llf19 llf37)
          )
            (setq llf06 (substr llf06 2))
            (setq llf39 (substr llf06 1 1))
            (setq llf19 (+ llf19 1))
        )
        (if (/= llf19 llf37)
          (progn
            (setq llf37 (strlen llf06))
            (setq llf40 (substr llf06 llf37 1))
            (setq llf19 llf37)
              (while
                (and
                  (/= (member llf40 llf08) nil)
                  (/= llf19 0)
                )
                  (setq llf06 (substr llf06 1 llf19))
                  (setq llf40 (substr llf06 llf19 1))
                  (setq llf19 (- llf19 1))
              )
          )
        )
      llf06
    )
    (defun lfl10 (llf09 llf10 / llf41 llf35 llf42 llf23)
      (if
        (and
          (= (type llf09) 'STR)
          (= (type llf10) 'STR)
        )
          (progn
            (setq llf41 (lfl09 llf09 (list llf10)))
            (setq llf35 (lfl08 llf41 llf10))
              (if llf35
                (progn
                  (setq llf42 (substr llf41 1 (1- llf35)))
                  (setq llf41 (lfl09 (substr llf41 (1+ (strlen llf42))) (list llf10)))
                  (setq llf23 (cons llf42 llf23))
                )
              )
            (setq llf35 (lfl08 llf41 llf10))
              (while llf35
                (setq llf42 (substr llf41 1 (1- llf35)))
                (setq llf41 (lfl09 (substr llf41 (1+ (strlen llf42))) (list llf10)))
                (setq llf23 (cons llf42 llf23))
                (setq llf35 (lfl08 llf41 llf10))
              )
              (if (> (strlen llf41) 0)
                (setq llf23 (cons llf41 llf23))
              )
          )
      )
      (if llf23
        (reverse llf23)
        nil
      )
    )
    (defun lfl11 ( / llf43 llf44 llf45)
      (prompt "\nFilterlayer per Quellobjektewahl bestimmen ... ")
        (if (setq llf43 (ssget))
          (progn
            (setq llf44 (lfl16 llf43))
            (setq llf45 (lfl12 llf44))
            (setq ndl8a2_-kal3ah2-aa llf45)
          )
        (setq llf45 nil)
        )
        (if llf45
          (list 1 llf45)
          (progn
            (prompt "\nKeine(n) gültigen Filterlayer gewählt. ")
            nil
          )
        )
    )
    (defun lfl12 (llf11 / llf46 llf33 llf39)
      (setq llf46 llf11)
      (setq llf33 "")
        (while llf46
          (setq llf39 (car llf46))
          (setq llf33 (strcat llf33 llf39 ","))
          (setq llf46 (cdr llf46))
        )
      (setq llf33 (lfl13 llf33 1))
        (if (/= llf33 "")
          (list (cons 8 llf33))
          nil
        )
    )
    (defun lfl13 (llf12 llf13 / llf37 llf47)
      (setq llf37 (strlen llf12))
        (if (> llf13 llf37)
          (setq llf13 llf37)
        )
      (setq llf47 (- llf37 llf13))
      (setq llf12 (substr llf12 1 llf47))
    )
    (defun lfl14 (llf14 / llf48 llf49 llf27 llf50 llf51 llf35 llf52 llf53 llf33 llf54 llf55 llf56 llf57 llf58 llf23)
        (if (setq llf48 (lfl15))
          (progn
            (setq llf49 (load_dialog llf48))
              (if (not (new_dialog "acm424ll" llf49))
                (exit)
              )
            (vl-catch-all-apply 'vl-file-delete (list llf48))
            (start_list "lb_01")
            (mapcar 'add_list llf14)
            (end_list)
              (if
                (and
                  (= (type ndl8a2_-kal3ah2-aa) 'LIST)
                  (setq llf27 (cdr (assoc 8 ndl8a2_-kal3ah2-aa)))
                )
                  (progn
                    (setq llf50 (lfl07 llf27 ","))
                    (setq llf50 (mapcar 'strcase llf50))
                    (setq llf51 (mapcar 'strcase llf14))
                      (while llf50
                          (if (setq llf35 (vl-position (car llf50) llf51))
                            (setq llf52 (cons llf35 llf52))
                          )
                        (setq llf50 (cdr llf50))
                      )
                      (if llf52
                        (progn
                          (setq llf53 (vl-sort llf52 '<))
                          (setq llf33 "")
                            (while llf53
                              (setq llf33 (strcat llf33 (itoa (car llf53)) " "))
                              (setq llf53 (cdr llf53))
                            )
                          (setq llf54 (lfl13 llf33 1))
                        )
                        (setq llf54 nil)
                      )
                  )
                  (setq llf54 nil)
              )
              (if llf54
                (set_tile "lb_01" llf54)
              )
              (if (= (get_tile "lb_01") "")
                (mode_tile "b_01" 1)
              )
            (set_tile "t_01" (strcat (itoa (length (lfl10 (get_tile "lb_01") " "))) " Layer gewählt"))
              (action_tile "lb_01" "(if (> (length (lfl10 $value \" \")) 250) 
                  (progn 
                    (alert \"Ungültige Auswahl. Bitte maximal 250 Einträge wählen.\") 
                    (set_tile $key \"0\") 
                    (set_tile $key \"\") 
                    (mode_tile \"b_01\" 1)
                  ) 
                  (progn 
                      (if (= (get_tile \"lb_01\") \"\") 
                        (mode_tile \"b_01\" 1) 
                        (mode_tile \"b_01\" 0)
                      )
                  )
                )
                (set_tile \"t_01\" (strcat (itoa (length (lfl10 (get_tile \"lb_01\") \" \"))) \" Layer gewählt\"))"
              )
              (action_tile "b_00" "(set_tile \"eb_01\" (setq llf55 (vl-string-trim \" \" (get_tile \"eb_01\"))))
                (lfl01 llf14 llf55)
                (set_tile \"t_01\" (strcat (itoa (length (lfl10 (get_tile \"lb_01\") \" \"))) \" Layer gewählt\"))"
              )
              (action_tile "eb_01" "(if (= $reason 1)
                  (progn
                    (set_tile $key (setq llf56 (vl-string-trim \" \" $value)))
                    (lfl01 llf14 llf56)
                    (set_tile \"t_01\" (strcat (itoa (length (lfl10 (get_tile \"lb_01\") \" \"))) \" Layer gewählt\"))
                  )
                )"
              )
              (action_tile "b_01" "(setq llf57 (lfl10 (setq llf58 (get_tile \"lb_01\")) \" \"))
                (setq llf57 (mapcar 'atoi llf57))
                  (while llf57
                    (setq llf23 (cons (nth (car llf57) llf14) llf23))
                    (setq llf57 (cdr llf57))
                  )
                (setq llf23 (list 1 (setq ndl8a2_-kal3ah2-aa (lfl12 (reverse llf23)))))
                (done_dialog)"
              )
            (action_tile "b_02" "(setq llf23 nil) (done_dialog)")
            (start_dialog)
            (unload_dialog llf49)
          )
        )
      llf23
    )
    (defun lfl15 ( / llf59 llf60 llf61)
      (if
        (and
          (setq llf59 (vl-filename-mktemp "acm.dcl"))
          (setq llf60 (open llf59 "w"))
        )
          (progn
            (setq llf61
              (list
                "acm424ll"
                ":dialog{label=\042Layer wählen\042;"
                ":spacer{height=0.4;}"
                ":list_box{key=\042lb_01\042;width=25;height=9;multiple_select=true;}"
                ":text{key=\042t_01\042;}"
                ":row{"
                ":button{key=\042b_00\042;label=\042&Suchen nach:\042;width=0;fixed_width=true;}"
                ":edit_box{key=\042eb_01\042;width=15;}}"
                ":spacer{height=0.4;}"
                ":row{"
                ":spacer{width=9;}"
                ":column{width=0;"
                ":button{key=\042b_01\042;label=\042OK\042;is_default=true;}"
                ":button{key=\042b_02\042;label=\042Abbrechen\042;is_cancel=true;}}"
                ":spacer{width=9;}}}"
              )
            )
              (while llf61
                (write-line (car llf61) llf60)
                (setq llf61 (cdr llf61))
              )
            (setq llf60 (close llf60))
            llf59
          )
          nil
      )
    )
    (defun lfl16 (llf15 / llf62 llf63 llf64 llf65 llf66 llf67 llf68 llf69 llf28)
      (setq llf62 (sslength llf15))
      (setq llf63 -1)
      (setq llf64 0)
        (repeat llf62
          (setq llf63 (1+ llf63))
          (setq llf65 (ssname llf15 llf63))
          (setq llf66 (vlax-ename->vla-object llf65))
          (setq llf67 (vlax-get llf66 'Layer))
            (if
              (and
                (setq llf68 (/= (vla-get-Lock (vlax-ename->vla-object (tblobjname "LAYER" llf67))) :vlax-true))
                (not (vl-string-search "|" llf67))
                (not (vl-position llf67 llf28))
                (/= (strcase llf67) "DEFPOINTS")
              )
                (setq llf28 (cons llf67 llf28))
                (progn
                  (if
                    (and
                      (not llf68)
                      (not (vl-position llf67 llf69))
                    )
                      (progn
                        (setq llf69 (cons llf67 llf69))
                        (setq llf64 (1+ llf64))
                      )
                  )
                )
            )
        )
        (if (> llf64 0)
          (prompt (strcat "\n" (itoa llf64) " Layer war(en) gesperrt. "))
        )
      llf28
    )
    (defun lfl17 ( / llf71 llf72 llf73)
        (if (not (vl-position ndl8a2_-kal3ah2_aa (list 0 1 2)))
          (setq ndl8a2_-kal3ah2_aa 0)
        )
        (if (= (type ndl8a2_-kal3ah2-aa) 'LIST)
          (progn
            (setq llf71 "Objektwahl Vorherige Auswahlliste")
              (if (= ndl8a2_-kal3ah2_aa 0)
                (setq llf72 "\nFilterlayer wählen durch [Objektwahl/Vorherige auswahl/Auswahlliste] <Objektwahl>: ")
              )
              (if (= ndl8a2_-kal3ah2_aa 1)
                (setq llf72 "\nFilterlayer wählen durch [Objektwahl/Vorherige auswahl/Auswahlliste] <Vorherige auswahl>: ")
              )
              (if (= ndl8a2_-kal3ah2_aa 2)
                (setq llf72 "\nFilterlayer wählen durch [Objektwahl/Vorherige auswahl/Auswahlliste] <Auswahlliste>: ")
              )
          )
          (progn
              (if (not (vl-position ndl8a2_-kal3ah2_aa (list 0 2)))
                (setq ndl8a2_-kal3ah2_aa 0)
              )
            (setq llf71 "Objektwahl Auswahlliste")
              (if (= ndl8a2_-kal3ah2_aa 0)
                (setq llf72 "\nFilterlayer wählen durch [Objektwahl/Auswahlliste] <Objektwahl>: ")
              )
              (if (= ndl8a2_-kal3ah2_aa 2)
                (setq llf72 "\nFilterlayer wählen durch [Objektwahl/Auswahlliste] <Auswahlliste>: ")
              )
          )
        )
      (initget llf71)
        (if (setq llf73 (getkword llf72))
          (setq ndl8a2_-kal3ah2_aa (nth (vl-position llf73 (list "Objektwahl" "Vorherige" "Auswahlliste")) (list 0 1 2)))
        )
      ndl8a2_-kal3ah2_aa
    )
    (defun lfl18 ( / llf74 llf75 llf76 llf77)
        (if (setq llf74 (lfl04))
          (progn
            (lfl06)
            (setq llf75 (lfl17))
              (if (= llf75 0)
                (setq llf76 (lfl11))
              )
              (if (= llf75 1)
                (setq llf76 (list 1 ndl8a2_-kal3ah2-aa))
              )
              (if (= llf75 2)
                (setq llf76 (lfl14 llf74))
              )
              (if llf76
                (progn
                  (setq ndl8a2_-kal3ah2-aa (cadr llf76))
                  (lfl05)
                  (prompt "\nZu löschende Objekte per gefilterter Objektwahl wählen ... ")
                    (if (setq llf77 (ssget ndl8a2_-kal3ah2-aa))
                      (progn
                        (vl-cmdf "._erase" llf77 "")
                        (prompt (strcat "\n" (itoa (sslength llf77)) " Objekt(e) gelöscht. "))
                      )
                      (prompt "\n0 Objekte gelöscht. ")
                    )
                )
              )
          )
          (alert "Aktuell ist keine Filterlayerauswahl möglich.")
        )
    )
  (if (lfl02)
    (progn
      (vl-load-com)
      (setq llf78 (vla-get-ActiveDocument (vlax-get-acad-object)))
      (setq llf79 *error*)
      (setq *error* lfl03)
      (vla-EndUndoMark llf78)
      (vla-StartUndoMark llf78)
      (lfl18)
        (if llf79
          (setq *error* llf79)
          (setq *error* nil)
        )
      (vla-EndUndoMark llf78)
    )
  )
  (princ)
)
(terpri)
(princ "\nAutoLISP-Tool ACM-LOESCHENLF (Copyright © 2024 Gerhard Rampf) geladen.")
(princ "\nRufen Sie den Befehl mit ACM-LOESCHENLF auf.")
