;;;   Programm:      ACM-TYPLOESCH.LSP
;;;   Befehlsaufruf: ACM-TYPLOESCH
;;;   Funktion:      Objekte löschen mit Objekttypfilter
;;;   Autor:         Gerhard Rampf
;;;                  Kundenspezifische Anpassungen für AutoCAD und ZWCAD
;;;                  Liebigstr. 3 A
;;;                  86399 Bobingen
;;;                  E-Mail: rampf@geracad.de
;;;   Datum:         15.09.2025
;;;   Plattform:     Alle AutoCAD-Versionen ab Version 2005
(defun c:acm-typloesch ( / lot76 lot77 lto01 lto02 lto03 lto04 lto05 lto06 lto07 lto08 lto09 lto10 lto11 lto12 lto13 lto14 lto15)
(defun lto01 (lot01 / )
(if lot77 (setq *error* lot77))
(vla-EndUndoMark (vla-get-ActiveDocument (vlax-get-acad-object)))
(princ))
(defun lto02 ( / lot19)
(setq lot19 (strcase (getvar "PRODUCT")))
(if
(and
(= lot19 "AUTOCAD")
(getvar "HPDRAWORDER"))
(setq lot20 T)
(setq lot20 nil))
(if (not lot20)
(alert "\042acm-typloesch\042 kann nur unter AutoCAD ab Version 2005 verwendet werden."))
lot20)
(defun lto03 (lot02 / lot21 lot22 lot23)
(setq lot21 lot02)
(setq lot22 "")
(while lot21
(setq lot23 (car lot21))
(setq lot22 (strcat lot22 lot23 ","))
(setq lot21 (cdr lot21)))
(setq lot22 (lto05 lot22 1))
(if (/= lot22 "")
(list (cons 6 lot22))
nil))
(defun lto04 (lot03 lot04 / lot24 lot25)
(if
(and
(= (type lot03) 'STR)
(= (type lot04) 'STR))
(progn
(setq lot03 (vl-string-trim lot04 lot03))
(setq lot03 (vl-string-trim " " lot03))
(while (setq lot24 (vl-string-search lot04 lot03))
(setq lot25 (append lot25 (list (substr lot03 1 lot24))))
(setq lot03 (vl-string-left-trim lot04 (substr lot03 (1+ lot24)))))
(setq lot25 (append lot25 (list lot03)))))
lot25)
(defun lto05 (lot05 lot06 / lot26 lot27)
(setq lot26 (strlen lot05))
(if (> lot06 lot26)
(setq lot06 lot26))
(setq lot27 (- lot26 lot06))
(setq lot05 (substr lot05 1 lot27)))
(defun lto06 (lot07 lot08 / lot26 lot28 lot23 lot24)
(setq lot26 (strlen lot07))
(setq lot28 1)
(while (<= lot28 lot26)
(setq lot23 (substr lot07 lot28 1))
(if (/= lot23 lot08)
(progn
(setq lot24 nil)
(setq lot28 (1+ lot28))))
(if (= lot23 lot08)
(progn
(setq lot24 lot28)
(setq lot28 (1+ lot26)))))
lot24)
(defun lto07 (lot07 lot09 / lot26 lot23 lot29 lot30)
(setq lot26 (strlen lot07))
(setq lot23 (substr lot07 1 1))
(setq lot29 0)
(while
(and
(/= (member lot23 lot09) nil)
(/= lot29 lot26))
(setq lot07 (substr lot07 2))
(setq lot23 (substr lot07 1 1))
(setq lot29 (+ lot29 1)))
(if (/= lot29 lot26)
(progn
(setq lot26 (strlen lot07))
(setq lot30 (substr lot07 lot26 1))
(setq lot29 lot26)
(while
(and
(/= (member lot30 lot09) nil)
(/= lot29 0))
(setq lot07 (substr lot07 1 lot29))
(setq lot30 (substr lot07 lot29 1))
(setq lot29 (- lot29 1)))))
lot07)
(defun lto08 (lot10 lot11 / lot31 lot32 lot33 lot29 lot35 lot34)
(if (= lot11 "")
(progn
(alert "Keine Eingabe für \042Suchen nach\042.")
(mode_tile "eb_01" 2))
(progn
(setq lot31 (mapcar 'strcase lot10))
(setq lot32 (strcase lot11))
(setq lot33 "")
(setq lot29 -1)
(setq lot34 0)
(repeat (length lot31)
(setq lot29 (1+ lot29))
(if (wcmatch (nth lot29 lot31) lot32)
(progn
(setq lot33 (strcat lot33 (itoa lot29) " "))
(setq lot34 (1+ lot34)))))
(if
(and
(<= lot34 250)
(/= (setq lot35 (vl-string-trim " " lot33)) ""))
(progn
(set_tile "lb_01" "")
(set_tile "lb_01" lot35)
(mode_tile "b_01" 0))
(progn
(set_tile "lb_01" "0")
(set_tile "lb_01" "")
(if (> lot34 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 lto09 (lot12 lot13 / lot36 lot24 lot37 lot20)
(if
(and
(= (type lot12) 'STR)
(= (type lot13) 'STR))
(progn
(setq lot36 (lto07 lot12 (list lot13)))
(setq lot24 (lto06 lot36 lot13))
(if lot24
(progn
(setq lot37 (substr lot36 1 (1- lot24)))
(setq lot36 (lto07 (substr lot36 (1+ (strlen lot37))) (list lot13)))
(setq lot20 (cons lot37 lot20))))
(setq lot24 (lto06 lot36 lot13))
(while lot24
(setq lot37 (substr lot36 1 (1- lot24)))
(setq lot36 (lto07 (substr lot36 (1+ (strlen lot37))) (list lot13)))
(setq lot20 (cons lot37 lot20))
(setq lot24 (lto06 lot36 lot13)))
(if (> (strlen lot36) 0)
(setq lot20 (cons lot36 lot20)))))
(if lot20
(reverse lot20)
nil))
(defun lto10 (lot14 / lot38 lot39 lot40 lot41 lot42 lot24 lot43 lot44 lot22 lot45 lot48 lot49 lot50 lot51 lot20)
(if (setq lot38 (lto11))
(progn
(setq lot39 (load_dialog lot38))
(if (not (new_dialog "acm725md" lot39))
(exit))
(vl-catch-all-apply 'vl-file-delete (list lot38))
(start_list "lb_01")
(mapcar 'add_list lot14)
(end_list)
(if
(and
(= (type j6nm_l27&-hs59mbgsk$3) 'LIST)
(setq lot40 (cdr (assoc 6 j6nm_l27&-hs59mbgsk$3))))
(progn
(setq lot41 (lto04 lot40 ","))
(setq lot41 (mapcar 'strcase lot41))
(setq lot42 (mapcar 'strcase lot14))
(while lot41
(if (setq lot24 (vl-position (car lot41) lot42))
(setq lot43 (cons lot24 lot43)))
(setq lot41 (cdr lot41)))
(if lot43
(progn
(setq lot44 (vl-sort lot43 '<))
(setq lot22 "")
(while lot44
(setq lot22 (strcat lot22 (itoa (car lot44)) " "))
(setq lot44 (cdr lot44)))
(setq lot45 (lto05 lot22 1)))
(setq lot45 nil)))
(setq lot45 nil))
(if lot45
(set_tile "lb_01" lot45))
(if (= (get_tile "lb_01") "")
(mode_tile "b_01" 1))
(if (not (vl-position j6nm_l27&-hs59mbgsk$1 (list "0" "1")))
(setq j6nm_l27&-hs59mbgsk$1 "0"))
(if (not (vl-position j6nm_l27&-hs59mbgsk$2 (list "0" "1")))
(setq j6nm_l27&-hs59mbgsk$2 "0"))
(set_tile "t_01" (strcat (itoa (length (lto09 (get_tile "lb_01") " "))) " Objekttyp(en) gewählt"))
(set_tile "tg_01" j6nm_l27&-hs59mbgsk$1)
(set_tile "tg_02" j6nm_l27&-hs59mbgsk$2)
(action_tile "lb_01" "(if (> (length (lto09 $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 (lto09 (get_tile \"lb_01\") \" \"))) \" Objekttyp(en) gewählt\"))")
(action_tile "b_00" "(set_tile \"eb_01\" (setq lot48 (vl-string-trim \" \" (get_tile \"eb_01\"))))
(lto08 lot14 lot48)
(set_tile \"t_01\" (strcat (itoa (length (lto09 (get_tile \"lb_01\") \" \"))) \" Objekttyp(en) gewählt\"))")
(action_tile "eb_01" "(if (= $reason 1)
(progn
(set_tile $key (setq lot49 (vl-string-trim \" \" $value)))
(lto08 lot14 lot49)
(set_tile \"t_01\" (strcat (itoa (length (lto09 (get_tile \"lb_01\") \" \"))) \" Objektyp(en) gewählt\")))
)")
(action_tile "b_01" "(setq lot50 (lto09 (setq lot51 (get_tile \"lb_01\")) \" \"))
(setq lot50 (mapcar 'atoi lot50))
(while lot50
(setq lot20 (cons (nth (car lot50) lot14) lot20))
(setq lot50 (cdr lot50)))
(setq lot20 (list (setq j6nm_l27&-hs59mbgsk$1 (get_tile \"tg_01\")) (setq j6nm_l27&-hs59mbgsk$2 (get_tile \"tg_02\")) (setq j6nm_l27&-hs59mbgsk$3 (lto03 (reverse lot20)))))
(done_dialog)")
(action_tile "b_02" "(setq lot20 nil) (done_dialog)")
(start_dialog)
(unload_dialog lot39)))
lot20)
(defun lto11 ( / lot53 lot54 lot55)
(if
(and
(setq lot53 (vl-filename-mktemp "acm.dcl"))
(setq lot54 (open lot53 "w")))
(progn
(setq lot55
(list
"acm725md"
":dialog{label=\042Zu löschende wählen\042;"
":spacer{height=0.4;}"
":list_box{key=\042lb_01\042;height=12;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=10;}}"
":spacer{height=0.2;}"
":toggle{key=\042tg_01\042;label=\042&Filter invertieren\042;}"
":toggle{key=\042tg_02\042;label=\042&Layersperrung ignorieren\042;}"
":spacer{height=0.4;}"
":row{"
":spacer{width=1;}"
":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=1;}}}"))
(while lot55
(write-line (car lot55) lot54)
(setq lot55 (cdr lot55)))
(setq lot54 (close lot54))
lot53)
nil))
(defun lto12 (lot15 / lot56 lot57)
(if (= (type lot15) 'ENAME)
(setq lot15 (vlax-ename->vla-object lot15)))
(setq lot56 (strcase (vlax-get lot15 'ObjectName)))
(if (= (type lot56) 'STR)
(progn
(if (equal lot56 "ACDB2DPOLYLINE")
(setq lot57 "2D-Polylinie"))
(if (equal lot56 "ACDBFACE")
(setq lot57 "3D-Fläche"))
(if (equal lot56 "ACDB3DPOLYLINE")
(setq lot57 "3D-Polylinie"))
(if (equal lot56 "ACDB3DSOLID")
(setq lot57 "3D-Volumenkörper"))
(if (equal lot56 "ACDBVIEWPORT")
(setq lot57 "Ansichtsfenster"))
(if (equal lot56 "ACDBATTRIBUTE")
(setq lot57 "Attribut"))
(if (equal lot56 "ACDBATTRIBUTEDEFINITION")
(setq lot57 "Attributdefinition"))
(if (equal lot56 "ACDBTRACE")
(setq lot57 "Band"))
(if (equal lot56 "ACDBROTATEDDIMENSION")
(setq lot57 "Linearbemaßung"))
(if (equal lot56 "ACDBALIGNEDDIMENSION")
(setq lot57 "Ausgerichtete Bemaßung"))
(if (equal lot56 "ACDBRADIALDIMENSION")
(setq lot57 "Radiusbemaßung"))
(if (equal lot56 "ACDBDIAMETRICDIMENSION")
(setq lot57 "Durchmesserbemaßung"))
(if (equal lot56 "ACDB2LINEANGULARDIMENSION")
(setq lot57 "Winkelbemaßung"))
(if (equal lot56 "ACDB3POINTANGULARDIMENSION")
(setq lot57 "3-Punkt-Winkelbemaßung"))
(if (equal lot56 "ACDBORDINATEDIMENSION")
(setq lot57 "Koordinatenbemaßung"))
(if (equal lot56 "ACDBBLOCKREFERENCE")
(progn
(if (= (type (vl-catch-all-apply 'vlax-get (list lot15 'Path))) 'VL-CATCH-ALL-APPLY-ERROR)
(setq lot57 "Blockreferenz")
(setq lot57 "Externe Referenz"))))
(if (equal lot56 "ACDBARC")
(setq lot57 "Bogen"))
(if (equal lot56 "ACDBARCDIMENSION")
(setq lot57 "Bogenbemaßung"))
(if (equal lot56 "ACDBARCALIGNEDTEXT")
(setq lot57 "Bogentext"))
(if (equal lot56 "ACDBDWFUNDERLAY")
(setq lot57 "DWF-Unterlage"))
(if (equal lot56 "ACDBELLIPSE")
(setq lot57 "Ellipse"))
(if (equal lot56 "ACDBLEADER")
(setq lot57 "Führung"))
(if (equal lot56 "ACDBCAMERA")
(setq lot57 "Kamera"))
(if (equal lot56 "ACDBXLINE")
(setq lot57 "Klinie"))
(if (equal lot56 "ACDBCIRCLE")
(setq lot57 "Kreis"))
(if (equal lot56 "ACDBLIGHT")
(setq lot57 "Licht"))
(if (equal lot56 "ACDBLINE")
(setq lot57 "Linie"))
(if (equal lot56 "ACDBMINSERTBLOCK")
(setq lot57 "Meinfüg Block"))
(if (equal lot56 "ACDBMTEXT")
(setq lot57 "MText"))
(if (equal lot56 "ACDBMLEADER")
(setq lot57 "Multi-Führungslinie"))
(if (equal lot56 "ACDBMLINE")
(setq lot57 "Multilinie"))
(if (equal lot56 "ACDBSUBDMESH")
(setq lot57 "Netz"))
(if (equal lot56 "ACDBRASTERIMAGE")
(setq lot57 "Pixelbild"))
(if (equal lot56 "ACDBPOLYGONMESH")
(setq lot57 "Polygonnetz"))
(if (equal lot56 "ACDBPOLYLINE")
(setq lot57 "Polylinie"))
(if (equal lot56 "ACDBPOINT")
(setq lot57 "Punkt"))
(if (equal lot56 "ACDBREGION")
(setq lot57 "Region"))
(if (equal lot56 "ACDBSECTIONOBJECT")
(setq lot57 "Schnittobjekt"))
(if (equal lot56 "ACDBHATCH")
(setq lot57 "Schraffur"))
(if (equal lot56 "ACDBSOLID")
(setq lot57 "Solid"))
(if (equal lot56 "ACDBHELIX")
(setq lot57 "Spirale"))
(if (equal lot56 "ACDBSPLINE")
(setq lot57 "Spline"))
(if (equal lot56 "ACDBRAY")
(setq lot57 "Strahl"))
(if (equal lot56 "ACDBSHAPE")
(setq lot57 "Symbol"))
(if (equal lot56 "ACDBTABLE")
(setq lot57 "Tabelle"))
(if (equal lot56 "ACDBTEXT")
(setq lot57 "Text"))
(if (equal lot56 "ACDBFCF")
(setq lot57 "Toleranz"))
(if (equal lot56 "ACDBRADIALDIMENSIONLARGE")
(setq lot57 "Verkürzte Radiusbemaßung"))
(if (equal lot56 "ACDBPOLYFACEMESH")
(setq lot57 "Vielflächennetz"))
(if (equal lot56 "ACDBBODY")
(setq lot57 "Volumenkörper"))
(if (equal lot56 "ACDBWIPEOUT")
(setq lot57 "Wipeout"))
(if lot57
(setq lot57 lot57)
(setq lot57 lot56))))
lot57)
(defun lto13 (lot16 / lot58 lot59 lot60 lot61 lot56 lot62)
(if (> (setq lot58 (sslength lot16)) 0)
(progn
(setq lot59 -1)
(repeat lot58
(setq lot59 (1+ lot59))
(setq lot60 (ssname lot16 lot59))
(setq lot61 (vlax-ename->vla-object lot60))
(setq lot56 (lto12 lot61))
(if (not (vl-position lot56 lot62))
(setq lot62 (cons lot56 lot62))))
(setq lot62 (acad_strlsort lot62))))
lot62)
(defun lto14 (lot16 lot17 / lot29 lot63 lot64 lot65 lot66 lot67 lot58 lot59 lot60 lot61 lot68 lot69)
(setq lot29 0)
(setq lot63 0)
(setq lot64 (car lot17))
(setq lot65 (cadr lot17))
(setq lot66 (cdr (assoc 6 (caddr lot17))))
(setq lot67 (lto04 lot66 ","))
(setq lot58 (sslength lot16))
(setq lot59 -1)
(repeat lot58
(setq lot59 (1+ lot59))
(setq lot60 (ssname lot16 lot59))
(setq lot61 (vlax-ename->vla-object lot60))
(setq lot68 (lto12 lot61))
(if (= lot64 "0")
(progn
(if (vl-position lot68 lot67)
(progn
(setq lot69 (lto15 lot61 lot65))
(setq lot29 (+ lot29 (car lot69)))
(setq lot63 (+ lot63 (cadr lot69))))))
(progn
(if (not (vl-position lot68 lot67))
(progn
(setq lot69 (lto15 lot61 lot65))
(setq lot29 (+ lot29 (car lot69)))
(setq lot63 (+ lot63 (cadr lot69))))))))
(if (> lot63 0)
(prompt (strcat "\n" (itoa lot29) " Objekt(e) gelöscht. " (itoa lot63) " war(en) auf einem gesperrten Layer. "))
(prompt (strcat "\n" (itoa lot29) " Objekt(e) gelöscht. "))))
(defun lto15 (lot15 lot18 / lot70 lot71 lot72 lot73 lot74 lot75)
(if (= (type lot15) 'ENAME)
(setq lot15 (vlax-ename->vla-object lot15)))
(setq lot70 0)
(setq lot71 0)
(setq lot72 (vlax-get lot15 'Layer))
(setq lot73 (tblobjname "LAYER" lot72))
(setq lot74 (vlax-ename->vla-object lot73))
(setq lot75 (vla-get-Lock lot74))
(if (= lot75 :vlax-false)
(progn
(vl-catch-all-apply 'vla-Delete (list lot15))
(setq lot70 1))
(progn
(if (= lot18 "1")
(progn
(vla-put-Lock lot74 :vlax-false)
(vl-catch-all-apply 'vla-Delete (list lot15))
(vla-put-Lock lot74 :vlax-true)
(setq lot70 1))
(setq lot71 1))))
(list lot70 lot71))
(if (lto02)
(progn
(vl-load-com)
(setq lot76 (vla-get-ActiveDocument (vlax-get-acad-object)))
(setq lot77 *error*)
(setq *error* lto01)
(vla-EndUndoMark lot76)
(vla-StartUndoMark lot76)
(if
(and
(setq lot78 (ssget))
(setq lot79 (lto13 lot78))
(setq lot80 (lto10 lot79)))
(lto14 lot78 lot80))
(if lot77
(setq *error* lot77)
(setq *error* nil))
(vla-EndUndoMark lot76)))
(princ))
(terpri)
(princ (strcat "\nAutoLISP-Tool ACM-TYPLOESCH (Copyright © " (substr (rtos (getvar "CDATE")) 1 4) " Gerhard Rampf) geladen. "))
(princ "\nRufen Sie den Befehl mit ACM-TYPLOESCH auf.")
