;;;   Programm:      ACM-LAYEINSTELL.LSP
;;;   Befehlsaufruf: ACM-LAYEINSTELL
;;;   Funktion:      Layereinstellungen per Namenfilter ändern
;;;   Autor:         Gerhard Rampf
;;;                  Kundenspezifische Anpassungen für AutoCAD und ZWCAD
;;;                  Liebigstr. 3 A
;;;                  86399 Bobingen
;;;                  E-Mail: rampf@geracad.de
;;;   Datum:         22.03.2025
;;;   Plattform:     Alle AutoCAD-Versionen ab Version 2005
(defun c:acm-layeinstell ( / tda41 tda58 dta01 dta02 dta04 dta05 dta06 dta07 dta08 dta09 dta10 dta11)
(defun dta01 (tda01 tda02 tda03 / tda09 tda10 tda12 tda13 tda14 tda15 tda16 tda17 tda18)
(if
(and
(= (type tda02) 'STR)
(= (type tda01) 'STR)
(>= (setq tda09 (strlen tda02)) (setq tda10 (strlen tda01))))
(progn
(if (> tda10 0)
(progn
(setq tda11 tda01)
(setq tda12 tda02)
(if (= tda03 1)
(progn
(setq tda11 (strcase tda11))
(setq tda12 (strcase tda12))))
(while (>= (strlen tda12) tda10)
(setq tda13 (substr tda12 1 tda10))
(setq tda14 (cons tda13 tda14))
(setq tda12 (substr tda12 2)))
(setq tda14 (reverse tda14))
(if (setq tda15 (member tda11 tda14))
(progn
(setq tda16 (length tda14))
(setq tda17 (length tda15))
(setq tda18 (- tda16 tda17)))
(setq tda18 nil)))
(setq tda18 0)))
(setq tda18 nil))
tda18)
(defun dta02 ( / tda23 tda24 tda27 tda25 tda26 tda29 tda28 dta03)
(defun dta03 (tda04 / tda19 tda20 tda21 tda22 p47_12)
(setq tda19 nil)
(setq tda20 0)
(setq tda21 (strcat "y_$x" (itoa tda20) ".txt"))
(while (findfile (strcat tda04 tda21))
(setq tda20 (1+ tda20))
(setq tda21 (strcat "y_$x" (itoa tda20) ".txt")))
(if (setq tda22 (open (strcat tda04 tda21) "w"))
(progn
(setq tda22 (close tda22))
(setq tda19 T))
(setq tda19 nil))
(vl-file-delete (strcat tda04 tda21))
tda19)
(setq tda23 nil)
(setq tda24 nil)
(if (setq tda25 (getenv "ACAD"))
(progn
(if (setq tda26 (dta01 "\073" tda25 1))
(setq tda27 (substr tda25 1 tda26))
(setq tda27 tda25))
(if (dta03 (setq tda27 (strcat tda27 "\\")))
(setq tda24 tda27)
(setq tda24 nil)))
(setq tda24 nil))
(if (not tda24)
(progn
(if
(and
(setq tda23 (findfile "acad.exe"))
(setq tda27 (substr tda23 1 (- (strlen tda23) 8)))
(dta03 tda27))
(setq tda24 tda27)
(setq tda24 nil tda23 nil tda27 nil))))
(if (not tda24)
(progn
(if
(and
(setq tda23 (findfile "acad.mnu"))
(setq tda27 (substr tda23 1 (- (strlen tda23) 8)))
(dta03 tda27))
(setq tda24 tda27)
(setq tda24 nil tda23 nil tda27 nil))))
(if (not tda24)
(progn
(if
(and
(setq tda23 (findfile "acad.cui"))
(setq tda27 (substr tda23 1 (- (strlen tda23) 8)))
(dta03 tda27))
(setq tda24 tda27)
(setq tda24 nil tda23 nil tda27 nil))))
(if (not tda24)
(progn
(if
(and
(setq tda23 (findfile "acad.cuix"))
(setq tda27 (substr tda23 1 (- (strlen tda23) 9)))
(dta03 tda27))
(setq tda24 tda27)
(setq tda24 nil tda23 nil tda27 nil))))
(if (not tda24)
(progn
(if
(and
(setq tda23 (findfile "acad.mnl"))
(setq tda27 (substr tda23 1 (- (strlen tda23) 8)))
(dta03 tda27))
(setq tda24 tda27)
(setq tda24 nil tda23 nil tda27 nil))))
(if (not tda24)
(progn
(if (dta03 (getvar "DWGPREFIX"))
(setq tda24 (getvar "DWGPREFIX")))))
(if (not tda24)
(setq tda28 nil)
(progn
(setq tda29 0)
(while (findfile (setq tda28 (strcat tda24 (strcat "acm" (itoa tda29) ".dcl"))))
(setq tda29 (1+ tda29)))))
tda28)
(defun dta04 ( / tda32 tda30 tda31)
(if
(and
(setq tda30 (dta02))
(setq tda31 (open tda30 "w")))
(progn
(setq tda32
(list
"ausblenden"
":dialog{label=\042Layereinstellung ändern\042;initial_focus=\042eb_01\042;"
":spacer{height=0.2;}"
":text{label=\042Filter&zeichenfolge für Layerwahl:\042;}"
":edit_box{key=\042eb_01\042;allow_accept=true;}"
":spacer{height=0.3;}"
":boxed_column{label=\042Aktion wählen\042;"
":row{"
":column{"
":radio_button{key=\042rb_01\042;label=\042&Einschalten\042;}"
":radio_button{key=\042rb_03\042;label=\042&Tauen\042;}"
":radio_button{key=\042rb_05\042;label=\042E&ntsperren\042;}"
":radio_button{key=\042rb_07\042;label=\042&Plotbar setzen\042;}}"
":column{"
":radio_button{key=\042rb_02\042;label=\042&Ausschalten\042;}"
":radio_button{key=\042rb_04\042;label=\042&Frieren\042;}"
":radio_button{key=\042rb_06\042;label=\042&Sperren\042;}"
":radio_button{key=\042rb_08\042;label=\042&Unplotbar setzen\042;}}}}"
":spacer{height=0.3;}"
":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 tda32
(write-line (car tda32) tda31)
(setq tda32 (cdr tda32)))
(setq tda31 (close tda31))
tda30)
nil))
(defun dta05 ( / tda33 tda34 tda37 tda38 tda39)
(if (setq tda33 (dta04))
(progn
(setq tda34 (load_dialog tda33))
(if (not (new_dialog "ausblenden" tda34))
(exit))
(vl-catch-all-apply 'vl-file-delete (list tda33))
(if (/= (type tda35) 'STR)
(setq tda35 ""))
(set_tile "eb_01" tda35)
(if (not (vl-position tda36 (list 0 1 2 3 4 5 6 7)))
(setq tda36 0))
(if (= tda36 0)
(set_tile "rb_01" "1"))
(if (= tda36 1)
(set_tile "rb_02" "1"))
(if (= tda36 2)
(set_tile "rb_03" "1"))
(if (= tda36 3)
(set_tile "rb_04" "1"))
(if (= tda36 4)
(set_tile "rb_05" "1"))
(if (= tda36 5)
(set_tile "rb_06" "1"))
(if (= tda36 6)
(set_tile "rb_07" "1"))
(if (= tda36 7)
(set_tile "rb_08" "1"))
(action_tile "rb_01" "(set_tile \"rb_02\" \"0\")
(set_tile \"rb_03\" \"0\")
(set_tile \"rb_04\" \"0\")
(set_tile \"rb_05\" \"0\")
(set_tile \"rb_06\" \"0\")
(set_tile \"rb_07\" \"0\")
(set_tile \"rb_08\" \"0\")")
(action_tile "rb_02" "(set_tile \"rb_01\" \"0\")
(set_tile \"rb_03\" \"0\")
(set_tile \"rb_04\" \"0\")
(set_tile \"rb_05\" \"0\")
(set_tile \"rb_06\" \"0\")
(set_tile \"rb_07\" \"0\")
(set_tile \"rb_08\" \"0\")")
(action_tile "rb_03" "(set_tile \"rb_01\" \"0\")
(set_tile \"rb_02\" \"0\")
(set_tile \"rb_04\" \"0\")
(set_tile \"rb_05\" \"0\")
(set_tile \"rb_06\" \"0\")
(set_tile \"rb_07\" \"0\")
(set_tile \"rb_08\" \"0\")")
(action_tile "rb_04" "(set_tile \"rb_01\" \"0\")
(set_tile \"rb_02\" \"0\")
(set_tile \"rb_03\" \"0\")
(set_tile \"rb_05\" \"0\")
(set_tile \"rb_06\" \"0\")
(set_tile \"rb_07\" \"0\")
(set_tile \"rb_08\" \"0\")")
(action_tile "rb_05" "(set_tile \"rb_01\" \"0\")
(set_tile \"rb_02\" \"0\")
(set_tile \"rb_03\" \"0\")
(set_tile \"rb_04\" \"0\")
(set_tile \"rb_06\" \"0\")
(set_tile \"rb_07\" \"0\")
(set_tile \"rb_08\" \"0\")")
(action_tile "rb_06" "(set_tile \"rb_01\" \"0\")
(set_tile \"rb_02\" \"0\")
(set_tile \"rb_03\" \"0\")
(set_tile \"rb_04\" \"0\")
(set_tile \"rb_05\" \"0\")
(set_tile \"rb_07\" \"0\")
(set_tile \"rb_08\" \"0\")")
(action_tile "rb_07" "(set_tile \"rb_01\" \"0\")
(set_tile \"rb_02\" \"0\")
(set_tile \"rb_03\" \"0\")
(set_tile \"rb_04\" \"0\")
(set_tile \"rb_05\" \"0\")
(set_tile \"rb_06\" \"0\")
(set_tile \"rb_08\" \"0\")")
(action_tile "rb_08" "(set_tile \"rb_01\" \"0\")
(set_tile \"rb_02\" \"0\")
(set_tile \"rb_03\" \"0\")
(set_tile \"rb_04\" \"0\")
(set_tile \"rb_05\" \"0\")
(set_tile \"rb_06\" \"0\")
(set_tile \"rb_07\" \"0\")")
(action_tile "b_01" "(if (= (setq tda37 (get_tile \"eb_01\")) \"\")
(progn
(alert \"Bitte Filterzeichenfolge eingeben.\")
(mode_tile \"eb_01\" 2))
(progn
(if (= (get_tile \"rb_01\") \"1\")
(setq tda38 0))
(if (= (get_tile \"rb_02\") \"1\")
(setq tda38 1))
(if (= (get_tile \"rb_03\") \"1\")
(setq tda38 2))
(if (= (get_tile \"rb_04\") \"1\")
(setq tda38 3))
(if (= (get_tile \"rb_05\") \"1\")
(setq tda38 4))
(if (= (get_tile \"rb_06\") \"1\")
(setq tda38 5))
(if (= (get_tile \"rb_07\") \"1\")
(setq tda38 6))
(if (= (get_tile \"rb_08\") \"1\")
(setq tda38 7))
(setq tda39 (list (setq tda35 tda37) (setq tda36 tda38)))
(done_dialog)))")
(action_tile "b_02" "(done_dialog)")
(start_dialog)
(unload_dialog tda34)))
tda39)
(defun dta06 ( / tda40 tda41 tda42 tda99 tda43 tda44 tda45)
(setq tda40 (vlax-get-acad-object))
(setq tda41 (vla-get-ActiveDocument tda40))
(setq tda42 (vlax-get tda41 'Layers))
(vlax-for tda99 tda42
(setq tda43 (cons (vlax-get tda99 'Name) tda43)))
(while tda43
(setq tda44 (car tda43))
(setq tda45 (cons (strcase tda44 1) tda45))
(setq tda43 (cdr tda43)))
tda45)
(defun dta07 (tda05 / tda43 tda46 tda47 tda48)
(setq tda43 (dta06))
(setq tda46 (strcase tda05 1))
(while tda43
(setq tda47 (car tda43))
(if (dta01 tda46 tda47 1)
(setq tda48 (cons tda47 tda48)))
(setq tda43 (cdr tda43)))
tda48)
(defun dta08 (tda06 tda07 / tda47 tda49 tda50 tda51 tda52 tda53 tda54)
(while tda06
(setq tda47 (car tda06))
(setq tda49 (vlax-ename->vla-object (tblobjname "LAYER" tda47)))
(if (= tda07 0)
(if (= (type (vl-catch-all-apply 'vla-put-LayerOn (list tda49 :vlax-true))) 'VL-CATCH-ALL-APPLY-ERROR)
(setq tda50 (cons tda47 tda50))
(setq tda51 (cons tda47 tda51))))
(if (= tda07 1)
(if (= (type (vl-catch-all-apply 'vla-put-LayerOn (list tda49 :vlax-false))) 'VL-CATCH-ALL-APPLY-ERROR)
(setq tda50 (cons tda47 tda50))
(setq tda51 (cons tda47 tda51))))
(if
(and
(= tda07 2)
(/= (strcase (getvar "CLAYER") 1) tda47))
(if (= (type (vl-catch-all-apply 'vla-put-Freeze (list tda49 :vlax-false))) 'VL-CATCH-ALL-APPLY-ERROR)
(setq tda50 (cons tda47 tda50))
(setq tda51 (cons tda47 tda51))))
(if (= tda07 3)
(if (= (type (vl-catch-all-apply 'vla-put-Freeze (list tda49 :vlax-true))) 'VL-CATCH-ALL-APPLY-ERROR)
(setq tda50 (cons tda47 tda50))
(setq tda51 (cons tda47 tda51))))
(if (= tda07 4)
(if (= (type (vl-catch-all-apply 'vla-put-Lock (list tda49 :vlax-false))) 'VL-CATCH-ALL-APPLY-ERROR)
(setq tda50 (cons tda47 tda50))
(setq tda51 (cons tda47 tda51))))
(if (= tda07 5)
(if (= (type (vl-catch-all-apply 'vla-put-Lock (list tda49 :vlax-true))) 'VL-CATCH-ALL-APPLY-ERROR)
(setq tda50 (cons tda47 tda50))
(setq tda51 (cons tda47 tda51))))
(if (= tda07 6)
(if (= (type (vl-catch-all-apply 'vla-put-Plottable (list tda49 :vlax-true))) 'VL-CATCH-ALL-APPLY-ERROR)
(setq tda50 (cons tda47 tda50))
(setq tda51 (cons tda47 tda51))))
(if (= tda07 7)
(if (= (type (vl-catch-all-apply 'vla-put-Plottable (list tda49 :vlax-false))) 'VL-CATCH-ALL-APPLY-ERROR)
(setq tda50 (cons tda47 tda50))
(setq tda51 (cons tda47 tda51))))
(setq tda06 (cdr tda06)))
(setq tda52 (list "einschaltet" "ausschaltet" "getaut" "gefroren" "entsperrt" "gesperrt" "plotbar gesetzt" "unplotbar gesetzt"))
(if (> (setq tda53 (length tda51)) 0)
(progn
(setq tda51 (acad_strlsort tda51))
(prompt "\n\n*****")
(prompt (strcat "\n" (itoa tda53) " Layer wurde(n) " (nth tda07 tda52) ": "))
(while tda51
(prompt (strcat "\n" (vlax-get (vlax-ename->vla-object (tblobjname "LAYER" (car tda51))) 'Name) " "))
(setq tda51 (cdr tda51)))
(prompt "\n*****\n")))
(if (> (setq tda54 (length tda50)) 0)
(progn
(setq tda50 (acad_strlsort tda50))
(prompt "\n\n*****")
(prompt (strcat "\n" (itoa tda54) " Layer konnte(n) nicht " (nth tda07 tda52) " werden: "))
(while tda50
(prompt (strcat "\n" (vlax-get (vlax-ename->vla-object (tblobjname "LAYER" (car tda50))) 'Name) " "))
(setq tda50 (cdr tda50)))
(prompt "\n*****\n"))))
(defun dta09 ( / tda55 tda56)
(if
(and
(setq tda55 (dta05))
(setq tda56 (dta07 (car tda55))))
(dta08 tda56 (cadr tda55))))
(defun dta10 (tda08 / )
(if tda58 (setq *error* tda58))
(vla-EndUndoMark (vla-get-ActiveDocument (vlax-get-acad-object)))
(princ))
(defun dta11 ( / tda57)
(setq tda57 (strcase (getvar "PRODUCT")))
(if
(and
(= tda57 "AUTOCAD")
(getvar "HPDRAWORDER"))
(setq tda39 T)
(setq tda39 nil))
(if (not tda39)
(alert "\042vacm-layeinstell\042 kann nur unter AutoCAD ab Version 2005 verwendet werden."))
tda39)
(if (dta11)
(progn
(vl-load-com)
(sssetfirst nil nil)
(setq tda41 (vla-get-ActiveDocument (vlax-get-acad-object)))
(setq tda58 *error*)
(setq *error* dta10)
(vla-EndUndoMark tda41)
(vla-StartUndoMark tda41)
(dta09)
(if tda58
(setq *error* tda58)
(setq *error* nil))
(vla-EndUndoMark tda41)))
(princ))
(terpri)
(princ (strcat "\nAutoLISP-Tool ACM-LAYEINSTELL (Copyright © " (substr (rtos (getvar "CDATE")) 1 4) " Gerhard Rampf) geladen. "))
(princ "\nRufen Sie den Befehl mit ACM-LAYEINSTELL auf.")
