;;;   Programm:      ACM-LAYERUNPLOTBAR.LSP
;;;   Befehlsaufruf: ACM-LAYERUNPLOTBAR
;;;   Funktion:      Layer unplotbar setzen per Quellobjektwahl, Auswahlliste oder Optionen
;;;                  "Vorherige Auswahl" und "Alle".
;;;   Autor:         Gerhard Rampf
;;;                  Kundenspezifische Anpassungen für AutoCAD und ZWCAD
;;;                  Liebigstr. 3 A
;;;                  86399 Bobingen
;;;                  E-Mail: rampf@geracad.de
;;;   Datum:         19.02.2026
;;;   Plattform:     Alle AutoCAD-Versionen ab Version 2005
(defun c:acm-layerunplotbar ( / upb79 upb80 ubp01 ubp02 ubp03 ubp04 ubp05 ubp06 ubp07 ubp08 ubp09 ubp10 ubp11 ubp12 ubp13 ubp14 ubp15 ubp16 ubp17 ubp18)
(defun ubp01 (upb01 upb02 / upb16 upb17 upb18 upb19 upb21 upb20)
(if (= upb02 "")
(progn
(alert "Keine Eingabe für \042Suchen nach\042.")
(mode_tile "eb_01" 2))
(progn
(setq upb16 (mapcar 'strcase upb01))
(setq upb17 (strcase upb02))
(setq upb18 "")
(setq upb19 -1)
(setq upb20 0)
(repeat (length upb16)
(setq upb19 (1+ upb19))
(if (wcmatch (nth upb19 upb16) upb17)
(progn
(setq upb18 (strcat upb18 (itoa upb19) " "))
(setq upb20 (1+ upb20)))))
(if
(and
(<= upb20 250)
(/= (setq upb21 (vl-string-trim " " upb18)) ""))
(progn
(set_tile "lb_01" "")
(set_tile "lb_01" upb21)
(mode_tile "b_01" 0))
(progn
(set_tile "lb_01" "0")
(set_tile "lb_01" "")
(if (> upb20 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 ubp02 ( / upb22)
(setq upb22 (strcase (getvar "PRODUCT")))
(if
(and
(= upb22 "AUTOCAD")
(getvar "HPDRAWORDER"))
(setq upb23 T)
(setq upb23 nil))
(if (not upb23)
(alert "\042acm-layerunplotbar\042 kann nur unter AutoCAD ab Version 2005 verwendet werden."))
upb23)
(defun ubp03 (upb03 / )
(if upb77 (vl-catch-all-apply 'setvar (list "CMDECHO" upb77)))
(if upb78 (vl-catch-all-apply 'setvar (list "EXPERT" upb78)))
(if upb80 (setq *error* upb80))
(vla-EndUndoMark (vla-get-ActiveDocument (vlax-get-acad-object)))
(princ))
(defun ubp04 ( / upb24 upb39 upb25 upb26)
(setq upb24 (vla-get-Layers (vla-get-ActiveDocument (vlax-get-acad-object))))
(vlax-for upb39 upb24
(if (= (vla-get-Plottable upb39) :vlax-true)
(progn
(setq upb25 (vlax-get upb39 'Name))
(setq upb26 (cons upb25 upb26)))))
(if upb26
(acad_strlsort upb26)
nil))
(defun ubp05 ( / upb27 upb28 upb29 upb30)
(setq upb27 (cdr (assoc 8 ddh62lk&cc_mka$a)))
(setq upb28 (ubp07 upb27 ","))
(while upb28
(setq upb29 (car upb28))
(setq upb30 (cons upb29 upb30))
(setq upb28 (cdr upb28)))
(if upb30
(progn
(setq upb30 (acad_strlsort upb30))
(prompt "\n ")
(prompt (strcat "\n" (itoa (length upb30)) " Layer wurde(n) unplotbar gesetzt: "))
(while upb30
(prompt (strcat "\n" (car upb30) " "))
(setq upb30 (cdr upb30)))
(prompt "\n "))))
(defun ubp06 ( / upb27 upb28 upb29 upb31 upb32 upb33)
(if
(and
(ubp04)
(= (type ddh62lk&cc_mka$a) 'LIST)
(setq upb27 (cdr (assoc 8 ddh62lk&cc_mka$a))))
(progn
(setq upb24 (vla-get-Layers (vla-get-ActiveDocument (vlax-get-acad-object))))
(setq upb28 (ubp07 upb27 ","))
(while upb28
(if (tblsearch "LAYER" (setq upb29 (car upb28)))
(setq upb31 (cons upb29 upb31)))
(setq upb28 (cdr upb28)))
(if upb31
(setq upb32 (acad_strlsort upb31))
(setq upb32 nil)))
(setq upb32 nil))
(if upb32
(progn
(setq upb33 "")
(while upb32
(setq upb29 (car upb32))
(setq upb33 (strcat upb33 upb29 ","))
(setq upb32 (cdr upb32)))
(setq upb33 (ubp13 upb33 1))
(setq ddh62lk&cc_mka$a (list (cons 8 upb33))))
(setq ddh62lk&cc_mka$a nil)))
(defun ubp07 (upb04 upb05 / upb35 upb36)
(if
(and
(= (type upb04) 'STR)
(= (type upb05) 'STR))
(progn
(setq upb04 (vl-string-trim upb05 upb04))
(setq upb04 (vl-string-trim " " upb04))
(while (setq upb35 (vl-string-search upb05 upb04))
(setq upb36 (append upb36 (list (substr upb04 1 upb35))))
(setq upb04 (vl-string-left-trim upb05 (substr upb04 (1+ upb35)))))
(setq upb36 (append upb36 (list upb04)))))
upb36)
(defun ubp08 (upb06 upb07 / upb37 upb38 upb39 upb35)
(setq upb37 (strlen upb06))
(setq upb38 1)
(while (<= upb38 upb37)
(setq upb39 (substr upb06 upb38 1))
(if (/= upb39 upb07)
(progn
(setq upb35 nil)
(setq upb38 (1+ upb38))))
(if (= upb39 upb07)
(progn
(setq upb35 upb38)
(setq upb38 (1+ upb37)))))
upb35)
(defun ubp09 (upb06 upb08 / upb37 upb39 upb19 upb40)
(setq upb37 (strlen upb06))
(setq upb39 (substr upb06 1 1))
(setq upb19 0)
(while
(and
(/= (member upb39 upb08) nil)
(/= upb19 upb37))
(setq upb06 (substr upb06 2))
(setq upb39 (substr upb06 1 1))
(setq upb19 (+ upb19 1)))
(if (/= upb19 upb37)
(progn
(setq upb37 (strlen upb06))
(setq upb40 (substr upb06 upb37 1))
(setq upb19 upb37)
(while
(and
(/= (member upb40 upb08) nil)
(/= upb19 0))
(setq upb06 (substr upb06 1 upb19))
(setq upb40 (substr upb06 upb19 1))
(setq upb19 (- upb19 1)))))
upb06)
(defun ubp10 (upb09 upb10 / upb41 upb35 upb42 upb23)
(if
(and
(= (type upb09) 'STR)
(= (type upb10) 'STR))
(progn
(setq upb41 (ubp09 upb09 (list upb10)))
(setq upb35 (ubp08 upb41 upb10))
(if upb35
(progn
(setq upb42 (substr upb41 1 (1- upb35)))
(setq upb41 (ubp09 (substr upb41 (1+ (strlen upb42))) (list upb10)))
(setq upb23 (cons upb42 upb23))))
(setq upb35 (ubp08 upb41 upb10))
(while upb35
(setq upb42 (substr upb41 1 (1- upb35)))
(setq upb41 (ubp09 (substr upb41 (1+ (strlen upb42))) (list upb10)))
(setq upb23 (cons upb42 upb23))
(setq upb35 (ubp08 upb41 upb10)))
(if (> (strlen upb41) 0)
(setq upb23 (cons upb41 upb23)))))
(if upb23
(reverse upb23)
nil))
(defun ubp11 ( / upb43 upb44 upb45)
(prompt "\nUnplotbar zu setzende Layer per Quellobjektewahl bestimmen ... ")
(if (setq upb43 (ssget))
(progn
(setq upb44 (ubp16 upb43))
(setq upb45 (ubp12 upb44))
(setq ddh62lk&cc_mka$a upb45))
(setq upb45 nil))
(if upb45
(list 1 upb45)
(progn
(prompt "\nKeine unplotbar zu setzenden Layer gewählt. ")
nil)))
(defun ubp12 (upb11 / upb46 upb33 upb39)
(setq upb46 upb11)
(setq upb33 "")
(while upb46
(setq upb39 (car upb46))
(setq upb33 (strcat upb33 upb39 ","))
(setq upb46 (cdr upb46)))
(setq upb33 (ubp13 upb33 1))
(if (/= upb33 "")
(list (cons 8 upb33))
nil))
(defun ubp13 (upb12 upb13 / upb37 upb47)
(setq upb37 (strlen upb12))
(if (> upb13 upb37)
(setq upb13 upb37))
(setq upb47 (- upb37 upb13))
(setq upb12 (substr upb12 1 upb47)))
(defun ubp14 (upb14 / upb48 upb49 upb27 upb50 upb51 upb35 upb52 upb53 upb33 upb54 upb55 upb56 upb57 upb58 upb23)
(if (setq upb48 (ubp15))
(progn
(setq upb49 (load_dialog upb48))
(if (not (new_dialog "acm624lo" upb49))
(exit))
(vl-catch-all-apply 'vl-file-delete (list upb48))
(start_list "lb_01")
(mapcar 'add_list upb14)
(end_list)
(if
(and
(= (type ddh62lk&cc_mka$a) 'LIST)
(setq upb27 (cdr (assoc 8 ddh62lk&cc_mka$a))))
(progn
(setq upb50 (ubp07 upb27 ","))
(setq upb50 (mapcar 'strcase upb50))
(setq upb51 (mapcar 'strcase upb14))
(while upb50
(if (setq upb35 (vl-position (car upb50) upb51))
(setq upb52 (cons upb35 upb52)))
(setq upb50 (cdr upb50)))
(if upb52
(progn
(setq upb53 (vl-sort upb52 '<))
(setq upb33 "")
(while upb53
(setq upb33 (strcat upb33 (itoa (car upb53)) " "))
(setq upb53 (cdr upb53)))
(setq upb54 (ubp13 upb33 1)))
(setq upb54 nil)))
(setq upb54 nil))
(if upb54
(set_tile "lb_01" upb54))
(if (= (get_tile "lb_01") "")
(mode_tile "b_01" 1))
(set_tile "t_01" (strcat (itoa (length (ubp10 (get_tile "lb_01") " "))) " Layer gewählt"))
(action_tile "lb_01" "(if (> (length (ubp10 $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 (ubp10 (get_tile \"lb_01\") \" \"))) \" Layer gewählt\"))")
(action_tile "b_00" "(set_tile \"eb_01\" (setq upb55 (vl-string-trim \" \" (get_tile \"eb_01\"))))
(ubp01 upb14 upb55)
(set_tile \"t_01\" (strcat (itoa (length (ubp10 (get_tile \"lb_01\") \" \"))) \" Layer gewählt\"))")
(action_tile "eb_01" "(if (= $reason 1)
(progn
(set_tile $key (setq upb56 (vl-string-trim \" \" $value)))
(ubp01 upb14 upb56)
(set_tile \"t_01\" (strcat (itoa (length (ubp10 (get_tile \"lb_01\") \" \"))) \" Layer gewählt\")))
)")
(action_tile "b_01" "(setq upb57 (ubp10 (setq upb58 (get_tile \"lb_01\")) \" \"))
(setq upb57 (mapcar 'atoi upb57))
(while upb57
(setq upb23 (cons (nth (car upb57) upb14) upb23))
(setq upb57 (cdr upb57)))
(setq upb23 (list 1 (setq ddh62lk&cc_mka$a (ubp12 (reverse upb23)))))
(done_dialog)")
(action_tile "b_02" "(setq upb23 nil) (done_dialog)")
(start_dialog)
(unload_dialog upb49)))
upb23)
(defun ubp15 ( / upb59 upb60 upb61)
(if
(and
(setq upb59 (vl-filename-mktemp "acm.dcl"))
(setq upb60 (open upb59 "w")))
(progn
(setq upb61
(list
"acm624lo"
":dialog{label=\042Layer 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 upb61
(write-line (car upb61) upb60)
(setq upb61 (cdr upb61)))
(setq upb60 (close upb60))
upb59)
nil))
(defun ubp16 (upb15 / upb62 upb63 upb64 upb65 upb66 upb67 upb28)
(setq upb62 (sslength upb15))
(setq upb63 -1)
(setq upb64 0)
(repeat upb62
(setq upb63 (1+ upb63))
(setq upb65 (ssname upb15 upb63))
(setq upb66 (vlax-ename->vla-object upb65))
(setq upb67 (vlax-get upb66 'Layer))
(if (not (vl-position upb67 upb28))
(setq upb28 (cons upb67 upb28))))
upb28)
(defun ubp17 ( / upb69 upb70 upb71)
(if (not (vl-position ddh62lk&cc_mka$b (list 0 1 2 3)))
(setq ddh62lk&cc_mka$b 0))
(if (= (type ddh62lk&cc_mka$a) 'LIST)
(progn
(setq upb69 "Objektwahl Vorherige auSwahlliste Alle")
(if (= ddh62lk&cc_mka$b 0)
(setq upb70 "\nUnplotbar zu setzende Layer wählen durch [Objektwahl/Vorherige auswahl/auSwahlliste/Alle] <Objektwahl>: "))
(if (= ddh62lk&cc_mka$b 1)
(setq upb70 "\nUnplotbar zu setzende Layer wählen durch [Objektwahl/Vorherige auswahl/auSwahlliste/Alle] <Vorherige auswahl>: "))
(if (= ddh62lk&cc_mka$b 2)
(setq upb70 "\nUnplotbar zu setzende Layer wählen durch [Objektwahl/Vorherige auswahl/auSwahlliste/Alle] <auSwahlliste>: "))
(if (= ddh62lk&cc_mka$b 3)
(setq upb70 "\nUnplotbar zu setzende Layer wählen durch [Objektwahl/Vorherige auswahl/auSwahlliste/Alle] <Alle>: ")))
(progn
(if (not (vl-position ddh62lk&cc_mka$b (list 0 2 3)))
(setq ddh62lk&cc_mka$b 0))
(setq upb69 "Objektwahl auSwahlliste Alle")
(if (= ddh62lk&cc_mka$b 0)
(setq upb70 "\nUnplotbar zu setzende Layer wählen durch [Objektwahl/auSwahlliste/Alle] <Objektwahl>: "))
(if (= ddh62lk&cc_mka$b 2)
(setq upb70 "\nUnplotbar zu setzende Layer wählen durch [Objektwahl/auSwahlliste/Alle] <auSwahlliste>: "))
(if (= ddh62lk&cc_mka$b 3)
(setq upb70 "\nUnplotbar zu setzende Layer wählen durch [Objektwahl/auSwahlliste/Alle] <Alle>: "))))
(initget upb69)
(if (setq upb71 (getkword upb70))
(setq ddh62lk&cc_mka$b (nth (vl-position upb71 (list "Objektwahl" "Vorherige" "auSwahlliste" "Alle")) (list 0 1 2 3))))
ddh62lk&cc_mka$b)
(defun ubp18 ( / upb77 upb78 upb72 upb73 upb74 upb75 upb28 upb24 upb76)
(if (setq upb72 (ubp04))
(progn
(ubp06)
(setq upb73 (ubp17))
(if (= upb73 0)
(setq upb74 (ubp11)))
(if (= upb73 1)
(setq upb74 (list 1 ddh62lk&cc_mka$a)))
(if (= upb73 2)
(setq upb74 (ubp14 upb72)))
(if (vl-position upb73 (list 0 1 2))
(progn
(if upb74
(progn
(setq ddh62lk&cc_mka$a (cadr upb74))
(ubp05)
(setq upb75 (cdr (assoc 8 ddh62lk&cc_mka$a)))
(setq upb28 (ubp07 upb75 ","))
(setq upb24 (vla-get-Layers (vla-get-ActiveDocument (vlax-get-acad-object))))
(while upb28
(setq upb76 (vla-Item upb24 (car upb28)))
(vl-catch-all-apply 'vla-put-Plottable (list upb76 :vlax-false))
(setq upb28 (cdr upb28))))))
(progn
(if (= upb73 3)
(progn
(setq upb77 (getvar "CMDECHO"))
(setvar "CMDECHO" 0)
(setq upb78 (getvar "EXPERT"))
(setvar "EXPERT" 5)
(vl-cmdf "._-layer" "_plot" "_no" "*" "")
(setvar "EXPERT" upb78)
(setvar "CMDECHO" upb77)
(prompt "\nAlle Layer wurden unplotbar gesetzt. "))))))
(alert "Alle Layer sind bereits unplotbar gesetzt.")))
(if (ubp02)
(progn
(vl-load-com)
(setq upb79 (vla-get-ActiveDocument (vlax-get-acad-object)))
(setq upb80 *error*)
(setq *error* ubp03)
(vla-EndUndoMark upb79)
(vla-StartUndoMark upb79)
(ubp18)
(if upb80
(setq *error* upb80)
(setq *error* nil))
(vla-EndUndoMark upb79)))
(princ))
(terpri)
(princ (strcat "\nAutoLISP-Tool ACM-LAYERUNPLOTBAR (Copyright © " (substr (rtos (getvar "CDATE")) 1 4) " Gerhard Rampf) geladen. "))
(princ "\nRufen Sie den Befehl mit ACM-LAYERUNPLOTBAR auf.")
