;;;   Programm:      ACM-LOESCHENLTF.LSP
;;;   Befehlsaufruf: ACM-LOESCHENLTF
;;;   Funktion:      Auswahlsatz löschen, der mittels eines Linientypfilters gebildet wurde.
;;;   Autor:         Gerhard Rampf
;;;                  Kundenspezifische Anpassungen für AutoCAD und ZWCAD
;;;                  Liebigstr. 3 A
;;;                  86399 Bobingen
;;;                  E-Mail: rampf@geracad.de
;;;   Datum:         16.07.2025
;;;   Plattform:     Alle AutoCAD-Versionen ab Version 2005
(defun c:acm-loeschenltf ( / lft78 lft79 ltf01 ltf02 ltf03 ltf04 ltf05 ltf06 ltf07 ltf08 ltf09 ltf10 ltf11 ltf12 ltf13 ltf14 ltf15 ltf16 ltf17 ltf18)
(defun ltf01 (lft01 lft02 / lft16 lft17 lft18 lft19 lft21 lft20)
(if (= lft02 "")
(progn
(alert "Keine Eingabe für \042Suchen nach\042.")
(mode_tile "eb_01" 2))
(progn
(setq lft16 (mapcar 'strcase lft01))
(setq lft17 (strcase lft02))
(setq lft18 "")
(setq lft19 -1)
(setq lft20 0)
(repeat (length lft16)
(setq lft19 (1+ lft19))
(if (wcmatch (nth lft19 lft16) lft17)
(progn
(setq lft18 (strcat lft18 (itoa lft19) " "))
(setq lft20 (1+ lft20)))))
(if
(and
(<= lft20 250)
(/= (setq lft21 (vl-string-trim " " lft18)) ""))
(progn
(set_tile "lb_01" "")
(set_tile "lb_01" lft21)
(mode_tile "b_01" 0))
(progn
(set_tile "lb_01" "0")
(set_tile "lb_01" "")
(if (> lft20 250)
(alert "Ungültige Auswahl. Mehr als 250 entsprechende Linientypen gefunden.")
(alert "Es wurden keine entsprechenden Linientypen gefunden."))
(mode_tile "eb_01" 2)
(mode_tile "b_01" 1))))))
(defun ltf02 ( / lft22)
(setq lft22 (strcase (getvar "PRODUCT")))
(if
(and
(= lft22 "AUTOCAD")
(getvar "HPDRAWORDER"))
(setq lft23 T)
(setq lft23 nil))
(if (not lft23)
(alert "\042acm-loeschenltf\042 kann nur unter AutoCAD ab Version 2005 verwendet werden."))
lft23)
(defun ltf03 (lft03 / )
(if lft77 (vl-catch-all-apply 'setvar (list "CMDECHO" lft77)))
(if lft79 (setq *error* lft79))
(vla-EndUndoMark (vla-get-ActiveDocument (vlax-get-acad-object)))
(princ))
(defun ltf04 ( / lft24 lft39 lft25 lft26)
(setq lft24 (vla-get-Linetypes (vla-get-ActiveDocument (vlax-get-acad-object))))
(vlax-for lft39 lft24
(setq lft25 (vlax-get lft39 'Name))
(if
(and
(not (vl-position (strcase lft25) (list "BYBLOCK" "BYLAYER")))
(not (vl-string-search "|" lft25)))
(setq lft26 (cons lft25 lft26))))
(if lft26
(setq lft26 (acad_strlsort lft26)))
(setq lft26 (append (list "ByLayer" "ByBlock") lft26)))
(defun ltf05 ( / lft27 lft28 lft29 lft30)
(setq lft27 (cdr (assoc 6 lft34)))
(setq lft28 (ltf07 lft27 ","))
(while lft28
(setq lft29 (car lft28))
(setq lft30 (cons lft29 lft30))
(setq lft28 (cdr lft28)))
(if lft30
(progn
(setq lft30 (acad_strlsort lft30))
(prompt "\n ")
(prompt (strcat "\n" (itoa (length lft30)) " Filterlinientyp(en) gewählt: "))
(while lft30
(prompt (strcat "\n" (car lft30) " "))
(setq lft30 (cdr lft30)))
(prompt "\n "))))
(defun ltf06 ( / lft27 lft28 lft29 lft31 lft32 lft33)
(if
(and
(ltf04)
(= (type lft34) 'LIST)
(setq lft27 (cdr (assoc 6 lft34))))
(progn
(setq lft24 (vla-get-Linetypes (vla-get-ActiveDocument (vlax-get-acad-object))))
(setq lft28 (ltf07 lft27 ","))
(while lft28
(if (tblsearch "LTYPE" (setq lft29 (car lft28)))
(setq lft31 (cons lft29 lft31)))
(setq lft28 (cdr lft28)))
(if lft31
(setq lft32 (acad_strlsort lft31))
(setq lft32 nil)))
(setq lft32 nil))
(if lft32
(progn
(setq lft33 "")
(while lft32
(setq lft29 (car lft32))
(setq lft33 (strcat lft33 lft29 ","))
(setq lft32 (cdr lft32)))
(setq lft33 (ltf13 lft33 1))
(setq lft34 (list (cons 6 lft33))))
(setq lft34 nil)))
(defun ltf07 (lft04 lft05 / lft35 lft36)
(if
(and
(= (type lft04) 'STR)
(= (type lft05) 'STR))
(progn
(setq lft04 (vl-string-trim lft05 lft04))
(setq lft04 (vl-string-trim " " lft04))
(while (setq lft35 (vl-string-search lft05 lft04))
(setq lft36 (append lft36 (list (substr lft04 1 lft35))))
(setq lft04 (vl-string-left-trim lft05 (substr lft04 (1+ lft35)))))
(setq lft36 (append lft36 (list lft04)))))
lft36)
(defun ltf08 (lft06 lft07 / lft37 lft38 lft39 lft35)
(setq lft37 (strlen lft06))
(setq lft38 1)
(while (<= lft38 lft37)
(setq lft39 (substr lft06 lft38 1))
(if (/= lft39 lft07)
(progn
(setq lft35 nil)
(setq lft38 (1+ lft38))))
(if (= lft39 lft07)
(progn
(setq lft35 lft38)
(setq lft38 (1+ lft37)))))
lft35)
(defun ltf09 (lft06 lft08 / lft37 lft39 lft19 lft40)
(setq lft37 (strlen lft06))
(setq lft39 (substr lft06 1 1))
(setq lft19 0)
(while
(and
(/= (member lft39 lft08) nil)
(/= lft19 lft37))
(setq lft06 (substr lft06 2))
(setq lft39 (substr lft06 1 1))
(setq lft19 (+ lft19 1)))
(if (/= lft19 lft37)
(progn
(setq lft37 (strlen lft06))
(setq lft40 (substr lft06 lft37 1))
(setq lft19 lft37)
(while
(and
(/= (member lft40 lft08) nil)
(/= lft19 0))
(setq lft06 (substr lft06 1 lft19))
(setq lft40 (substr lft06 lft19 1))
(setq lft19 (- lft19 1)))))
lft06)
(defun ltf10 (lft09 lft10 / lft41 lft35 lft42 lft23)
(if
(and
(= (type lft09) 'STR)
(= (type lft10) 'STR))
(progn
(setq lft41 (ltf09 lft09 (list lft10)))
(setq lft35 (ltf08 lft41 lft10))
(if lft35
(progn
(setq lft42 (substr lft41 1 (1- lft35)))
(setq lft41 (ltf09 (substr lft41 (1+ (strlen lft42))) (list lft10)))
(setq lft23 (cons lft42 lft23))))
(setq lft35 (ltf08 lft41 lft10))
(while lft35
(setq lft42 (substr lft41 1 (1- lft35)))
(setq lft41 (ltf09 (substr lft41 (1+ (strlen lft42))) (list lft10)))
(setq lft23 (cons lft42 lft23))
(setq lft35 (ltf08 lft41 lft10)))
(if (> (strlen lft41) 0)
(setq lft23 (cons lft41 lft23)))))
(if lft23
(reverse lft23)
nil))
(defun ltf11 ( / lft43 lft44 lft45)
(prompt "\nFilterlinientypen per Quellobjektewahl bestimmen ... ")
(if (setq lft43 (ssget))
(progn
(setq lft44 (ltf16 lft43))
(setq lft45 (ltf12 lft44))
(setq lft34 lft45))
(setq lft45 nil))
(if lft45
(list 1 lft45)
(progn
(prompt "\nKeine Filterlinientypen gewählt. ")
nil)))
(defun ltf12 (lft11 / lft46 lft33 lft39)
(setq lft46 lft11)
(setq lft33 "")
(while lft46
(setq lft39 (car lft46))
(setq lft33 (strcat lft33 lft39 ","))
(setq lft46 (cdr lft46)))
(setq lft33 (ltf13 lft33 1))
(if (/= lft33 "")
(list (cons 6 lft33))
nil))
(defun ltf13 (lft12 lft13 / lft37 lft47)
(setq lft37 (strlen lft12))
(if (> lft13 lft37)
(setq lft13 lft37))
(setq lft47 (- lft37 lft13))
(setq lft12 (substr lft12 1 lft47)))
(defun ltf14 (lft14 / lft48 lft49 lft27 lft50 lft51 lft35 lft52 lft53 lft33 lft54 lft55 lft56 lft57 lft58 lft23)
(if (setq lft48 (ltf15))
(progn
(setq lft49 (load_dialog lft48))
(if (not (new_dialog "acm624lo" lft49))
(exit))
(vl-catch-all-apply 'vl-file-delete (list lft48))
(start_list "lb_01")
(mapcar 'add_list lft14)
(end_list)
(if
(and
(= (type lft34) 'LIST)
(setq lft27 (cdr (assoc 6 lft34))))
(progn
(setq lft50 (ltf07 lft27 ","))
(setq lft50 (mapcar 'strcase lft50))
(setq lft51 (mapcar 'strcase lft14))
(while lft50
(if (setq lft35 (vl-position (car lft50) lft51))
(setq lft52 (cons lft35 lft52)))
(setq lft50 (cdr lft50)))
(if lft52
(progn
(setq lft53 (vl-sort lft52 '<))
(setq lft33 "")
(while lft53
(setq lft33 (strcat lft33 (itoa (car lft53)) " "))
(setq lft53 (cdr lft53)))
(setq lft54 (ltf13 lft33 1)))
(setq lft54 nil)))
(setq lft54 nil))
(if lft54
(set_tile "lb_01" lft54))
(if (= (get_tile "lb_01") "")
(mode_tile "b_01" 1))
(set_tile "t_01" (strcat (itoa (length (ltf10 (get_tile "lb_01") " "))) " Linientyp(en) gewählt"))
(action_tile "lb_01" "(if (> (length (ltf10 $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 (ltf10 (get_tile \"lb_01\") \" \"))) \" Linientyp(en) gewählt\"))")
(action_tile "b_00" "(set_tile \"eb_01\" (setq lft55 (vl-string-trim \" \" (get_tile \"eb_01\"))))
(ltf01 lft14 lft55)
(set_tile \"t_01\" (strcat (itoa (length (ltf10 (get_tile \"lb_01\") \" \"))) \" Linientyp(en) gewählt\"))")
(action_tile "eb_01" "(if (= $reason 1)
(progn
(set_tile $key (setq lft56 (vl-string-trim \" \" $value)))
(ltf01 lft14 lft56)
(set_tile \"t_01\" (strcat (itoa (length (ltf10 (get_tile \"lb_01\") \" \"))) \" Linientyp(en) gewählt\")))
)")
(action_tile "b_01" "(setq lft57 (ltf10 (setq lft58 (get_tile \"lb_01\")) \" \"))
(setq lft57 (mapcar 'atoi lft57))
(while lft57
(setq lft23 (cons (nth (car lft57) lft14) lft23))
(setq lft57 (cdr lft57)))
(setq lft23 (list 1 (setq lft34 (ltf12 (reverse lft23)))))
(done_dialog)")
(action_tile "b_02" "(setq lft23 nil) (done_dialog)")
(start_dialog)
(unload_dialog lft49)))
lft23)
(defun ltf15 ( / lft59 lft60 lft61)
(if
(and
(setq lft59 (vl-filename-mktemp "acm.dcl"))
(setq lft60 (open lft59 "w")))
(progn
(setq lft61
(list
"acm624lo"
":dialog{label=\042Filterlinientypen wählen\042;"
":spacer{height=0.4;}"
":list_box{key=\042lb_01\042;width=35;height=15;multiple_select=true;}"
":text{key=\042t_01\042;}"
":spacer{height=0;}"
":row{"
":button{key=\042b_00\042;label=\042&Suchen nach:\042;width=0;fixed_width=true;}"
":edit_box{key=\042eb_01\042;width=20;}}"
":spacer{height=0.4;}"
":row{"
":spacer{width=5;}"
":column{width=20;"
":button{key=\042b_01\042;label=\042OK\042;is_default=true;}"
":button{key=\042b_02\042;label=\042Abbrechen\042;is_cancel=true;}}"
":spacer{width=5;}}}"))
(while lft61
(write-line (car lft61) lft60)
(setq lft61 (cdr lft61)))
(setq lft60 (close lft60))
lft59)
nil))
(defun ltf16 (lft15 / lft62 lft63 lft64 lft65 lft66 lft67 lft28)
(setq lft62 (sslength lft15))
(setq lft63 -1)
(setq lft64 0)
(repeat lft62
(setq lft63 (1+ lft63))
(setq lft65 (ssname lft15 lft63))
(setq lft66 (vlax-ename->vla-object lft65))
(setq lft67 (vlax-get lft66 'Linetype))
(if (not (vl-position lft67 lft28))
(setq lft28 (cons lft67 lft28))))
lft28)
(defun ltf17 ( / lft69 lft70 lft71)
(if (not (vl-position lft68 (list 0 1 2)))
(setq lft68 0))
(if (= (type lft34) 'LIST)
(progn
(setq lft69 "Objektwahl Vorherige auSwahlliste")
(if (= lft68 0)
(setq lft70 "\nFilterlinientypen wählen durch [Objektwahl/Vorherige auswahl/auSwahlliste] <Objektwahl>: "))
(if (= lft68 1)
(setq lft70 "\nFilterlinientypen wählen durch [Objektwahl/Vorherige auswahl/auSwahlliste] <Vorherige auswahl>: "))
(if (= lft68 2)
(setq lft70 "\nFilterlinientypen wählen durch [Objektwahl/Vorherige auswahl/auSwahlliste] <auSwahlliste>: ")))
(progn
(if (not (vl-position lft68 (list 0 2)))
(setq lft68 0))
(setq lft69 "Objektwahl auSwahlliste")
(if (= lft68 0)
(setq lft70 "\nFilterlinientypen wählen durch [Objektwahl/auSwahlliste] <Objektwahl>: "))
(if (= lft68 2)
(setq lft70 "\nFilterlinientypen wählen durch [Objektwahl/auSwahlliste] <auSwahlliste>: "))))
(initget lft69)
(if (setq lft71 (getkword lft70))
(setq lft68 (nth (vl-position lft71 (list "Objektwahl" "Vorherige" "auSwahlliste")) (list 0 1 2))))
lft68)
(defun ltf18 ( / lft72 lft73 lft74 lft75 lft76 lft77 lft62)
(if (setq lft72 (ltf04))
(progn
(ltf06)
(setq lft73 (ltf17))
(if (= lft73 0)
(setq lft74 (ltf11)))
(if (= lft73 1)
(setq lft74 (list 1 lft34)))
(if (= lft73 2)
(setq lft74 (ltf14 lft72)))
(if (vl-position lft73 (list 0 1 2))
(progn
(if lft74
(progn
(setq lft34 (cadr lft74))
(ltf05)
(setq lft75 (cdr (assoc 6 lft34)))
(prompt "\nZu löschende Objekte wählen ... ")
(if (setq lft76 (ssget "_:L" lft34))
(progn
(setq lft77 (getvar "CMDECHO"))
(setvar "CMDECHO" 0)
(setq lft62 (sslength lft76))
(command "._erase" lft76 "")
(prompt (strcat "\n" (itoa lft62) " Objekt(e) wurde(n) gelöscht. "))
(setvar "CMDECHO" lft77))))))))))
(if (ltf02)
(progn
(vl-load-com)
(setq lft78 (vla-get-ActiveDocument (vlax-get-acad-object)))
(setq lft79 *error*)
(setq *error* ltf03)
(vla-EndUndoMark lft78)
(vla-StartUndoMark lft78)
(ltf18)
(if lft79
(setq *error* lft79)
(setq *error* nil))
(vla-EndUndoMark lft78)))
(princ))
(terpri)
(princ (strcat "\nAutoLISP-Tool ACM-LOESCHENLTF (Copyright © " (substr (rtos (getvar "CDATE")) 1 4) " Gerhard Rampf) geladen. "))
(princ "\nRufen Sie den Befehl mit ACM-LOESCHENLTF auf.")
