;;  Programm:      ACM-LAYERSETZEN.LSP
;;  Befehlsaufruf: ACM-LAYERSETZEN
;;  Funktion:      Aktuellen Layer per Quellobjektwahl oder Auswahlliste setzen.
;;  Autor:         Gerhard Rampf
;;                 Kundenspezifische Anpassungen für AutoCAD und ZWCAD
;;                 Liebigstr. 3 A
;;                 86399 Bobingen
;;                 E-Mail: rampf@geracad.de
;;  Datum:         14.06.2024
;;  Plattform:     Alle AutoCAD-Versionen ab Version 2005
(defun c:acm-layersetzen ( / tra159 tra072 tra160 tra161 tra162 tar003 tar004 tar005 tar006 tar007 tar008 tar009 tar010 tar011 tar012 tar014 tar015 tar017 tar018 tar019 tar020 tar021 tar027 tar028)
  (defun tar001 ( / tra028 tra026 tra027)
    (if
      (and
        (setq tra026 (vl-filename-mktemp "acm.dcl"))
        (setq tra027 (open tra026 "w"))
      )
        (progn
          (setq tra028
            (list
              "acm524"
              ":dialog{label=\042Einstellungen\042;"
              ":spacer{height=0.2;}"
              ":popup_list{key=\042pl_01\042;label=\042&Pickbox-Größe:\042;edit_width=8;}"
              ":spacer{height=0.3;}"
              ":toggle{key=\042tg_01\042;label=\042&Blockelemente wählbar\042;}"
              ":spacer{height=0.3;}"
              ":row{"
              ":spacer{width=0;}"
              ":column{width=0;fixed_width=true;"
              ":button{key=\042b_01\042;label=\042OK\042;is_default=true;}"
              ":button{key=\042b_02\042;label=\042Abbrechen\042;is_cancel=true;}}"
              ":spacer{width=0;}}}"
            )
          )
            (while tra028
              (write-line (car tra028) tra027)
              (setq tra028 (cdr tra028))
            )
          (setq tra027 (close tra027))
          tra026
        )
        nil
    )
  )
  (defun tar002 ( / tra029 tra030 tra031 tra034)
      (if (setq tra029 (tar001))
        (progn
          (setq tra030 (load_dialog tra029))
            (if (not (new_dialog "acm524" tra030))
              (exit)
            )
          (vl-catch-all-apply 'vl-file-delete (list tra029))
          (start_list "pl_01")
          (mapcar 'add_list (list (strcat "Akt. (" (itoa (getvar "PICKBOX")) ")") "1" "2" "3" "4" "5" "6" "7" "8" "9" "10" "11" "12" "13" "14" "15" "16" "17" "18" "19" "20"))
          (end_list)
          (set_tile "tg_01" (itoa ndk55s_-mcm618ddg4))
            (if (= ndk55s_-mam618ddg4 0)
              (set_tile "pl_01" "0")
              (set_tile "pl_01" (itoa ndk55s_-mbm618ddg4))
            )
            (action_tile "b_01" "(setq tra031 (atoi (get_tile \"pl_01\")))
                (if (= tra031 0)
                  (progn
                    (setq ndk55s_-mam618ddg4 0)
                    (setq ndk55s_-mbm618ddg4 (getvar \"PICKBOX\"))
                  )
                  (progn
                    (setq ndk55s_-mam618ddg4 1)
                    (setq ndk55s_-mbm618ddg4 tra031)
                  )
                )
              (setq tra034 (list (setq ndk55s_-mcm618ddg4 (atoi (get_tile \"tg_01\"))) ndk55s_-mam618ddg4 ndk55s_-mbm618ddg4))
              (done_dialog)
              (tar028)"
            )
          (action_tile "b_02" "(setq tra034 nil) (done_dialog)")
          (start_dialog)
          (unload_dialog tra030)
        )
      )
    tra034
  )
  (defun tar003 (tra001 / )
      (if tra147
        (vl-catch-all-apply 'setvar (list "PICKBOX" tra147))
      )
      (if tra160
        (setq *error* tra160)
        (setq *error* nil)
      )
    (vla-EndUndoMark (vla-get-ActiveDocument (vlax-get-acad-object)))
      (if tra161
        (progn
          (if command-s
            (command-s "._undo" "1")
            (command "._undo" "1")
          )
        )
      )
      (if tra159
        (vl-catch-all-apply 'setvar (list "CMDECHO" tra159))
      )
    (princ)
  )
  (defun tar004 ( / tra036)
    (setq tra036 (strcase (getvar "PRODUCT")))
      (if
        (or
          (and
            (= tra036 "AUTOCAD")
            (getvar "HPDRAWORDER")
          )
             (= tra036 "ZWCAD")
         )
          (setq tra037 T)
          (setq tra037 nil)
      )
      (if (not tra037)
        (alert "\042acm-layersetzen\042 kann nur unter AutoCAD ab Version 2005 sowie ZWCAD verwendet werden.")
      )
    tra037
  )
  (defun tar005 ( / tra028 tra038 tra030 tra039 tra040 tra041 tra042 tra044 tra045 tra034)
    (setq tra028
      (list
        "acm524"
        ":dialog{label=\042Layer wählen\042;width=45;"
        ":spacer{height=0.2;}"
        ":list_box{key=\042lb_01\042;height=12;allow_accept=true;}"
        ":spacer{height=0.7;}"
        ":row{"
        ":spacer{width=5;}"
        ":column{width=19;"
        ":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;}}}"
      )
    )
      (if (setq tra038 (tar021 tra028 "cmnl" "dcl"))
        (progn
          (setq tra030 (load_dialog tra038))
            (if (not (new_dialog "acm524" tra030))
              (exit)
            )
          (vl-catch-all-apply 'vl-file-delete (list tra038))
          (setq tra039 (tar006))
          (start_list "lb_01")
          (mapcar 'add_list tra039)
          (add_list "- Neuen Layer anlegen...")
          (end_list)
          (setq tra040 (mapcar 'strcase tra039))
            (if
              (and
                (= (type ndk55s_-mem618ddg4) 'STR)
                (setq tra041 (vl-position (strcase ndk55s_-mem618ddg4) tra040))
              )
                (set_tile "lb_01" (itoa tra041))
                (set_tile "lb_01" "0")
            )
          (setq tra042 (get_tile "lb_01"))
            (if (not (vl-position ndk55s_-mdm618ddg4 (list "0" "1")))
              (setq ndk55s_-mdm618ddg4 "0")
            )
            (action_tile "lb_01"
              "(setq tra044 nil)
                 (if (= (atoi $value) (length tra039))
                   (progn
                     (if (setq tra044 (tar010 1))
                       (progn
                         (tar008 tra044)
                         (setq tra045 (car tra044))
                         (setq tra039 (acad_strlsort (cons tra045 tra039)))
                         (start_list $key)
                         (mapcar 'add_list tra039)
                         (add_list \"- Neuen Layer anlegen...\")
                         (end_list)
                         (set_tile $key (setq tra042 (itoa (vl-position tra045 tra039))))
                       )
                       (progn
                         (set_tile $key tra042)
                         (setq tra042 $value)
                       )
                     )
                   )
                   (setq tra042 $value)
                 )"
            )
            (action_tile "b_01"
              "(setq tra034 (list (setq ndk55s_-mem618ddg4 (nth (atoi (get_tile \"lb_01\")) tra039))))
               (done_dialog)"
            )
            (action_tile "b_02" "(setq tra034 nil) (done_dialog)")
          (start_dialog)
          (unload_dialog tra030)
        )
      )
    tra034
  )
  (defun tar006 ( / tra047 tra048 tra050 tra049)
    (setq tra047 (tblnext "LAYER" T))
    (setq tra048 (cdr (assoc 2 tra047)))
    (setq tra049 (list tra048))
    (setq tra050 (tblnext "LAYER"))
      (while tra050
        (setq tra048 (cdr (assoc 2 tra050)))
          (if (not (vl-string-search "|" tra048))
            (setq tra049 (cons tra048 tra049))
          )
        (setq tra050 (tblnext "LAYER"))
      )
      (if tra049
        (acad_strlsort tra049)
        nil
      )
  )
  (defun tar007 (tra002 / tra051 tra052 tra053 tra054 tra055 tra056 tra057 tra058 tra059)
    (vl-load-com)
      (if
        (and
          (setq tra051 (getvar "PRODUCT"))
          (= (type tra051) 'STR)
          (= (strcase tra051) "ZWCAD")
        )
          (setq tra052 "ZWCAD.ZcCmColor")
          (progn
            (setq tra053 (substr (getvar "ACADVER") 1 2))
              (if (< (atoi tra053) 16)
                (setq tra053 "16")
              )
            (setq tra052 (strcat "AutoCAD.AcCmColor." tra053))
          )
      )
      (if
        (and
          (= (type tra002) 'STR)
          (setq tra054 (vl-string-search "$" tra002))
          (setq tra055 (substr tra002 1 tra054))
          (setq tra056 (substr tra002 (+ tra054 2)))
          (setq tra057 (vla-GetInterfaceObject (vlax-get-acad-object) tra052))
          (not (vl-catch-all-error-p (vl-catch-all-apply 'vla-SetColorBookColor (list tra057 tra055 tra056))))
        )
          (progn
            (setq tra058 (+ (lsh (fix (vla-get-Red tra057)) 16) (lsh (fix (vla-get-Green tra057)) 8) (fix (vla-get-Blue tra057))))
              (if (not (vl-catch-all-error-p (vl-catch-all-apply 'vla-SetRGB (cons tra057 (list (lsh (fix tra058) -16) (lsh (lsh (fix tra058) 16) -24) (lsh (lsh (fix tra058) 24) -24))))))
                (setq tra059 (vla-get-ColorIndex tra057))
                (setq tra059 nil)
              )
          )
      )
    tra059
  )
  (defun tar008 (tra003 / tra060 tra061 tra062 tra063 tra064 tra065 tra066 tra067 tra036 tra068 tra069 tra070)
    (if
      (and
        (not (tblsearch "LTYPE" (setq tra060 (nth 2 tra003))))
        (not (tar009 tra060))
      )
        (progn
          (if (tblsearch "LTYPE" "Continuous")
            (setq tra060 "Continuous")
            (setq tra060 (cdr (assoc 6 (tblsearch "LAYER" (getvar "CLAYER")))))
          )
        )
    )
    (if (= (car (nth 1 tra003)) 430)
      (progn
        (if (< (atoi (nth 4 tra003)) 1)
          (setq tra061 (cons 62 (tar007 (cdr (nth 1 tra003)))))
          (setq tra061 (cons 62 (* (tar007 (cdr (nth 1 tra003))) -1)))
        )
        (setq tra062 (list tra061 (cons 420 (tar012 (cdr (nth 1 tra003)))) (nth 1 tra003)))
      )
    )
    (if (= (car (nth 1 tra003)) 420)
      (progn
        (if (< (atoi (nth 4 tra003)) 1)
          (setq tra061 (cons 62 (tar015 (cdr (nth 1 tra003)))))
          (setq tra061 (cons 62 (* (tar015 (cdr (nth 1 tra003))) -1)))
        )
        (setq tra062 (list tra061 (nth 1 tra003)))
      )
    )
    (if (= (car (nth 1 tra003)) 62)
      (progn
        (if (< (atoi (nth 4 tra003)) 1)
          (setq tra061 (cons 62 (cdr (nth 1 tra003))))
          (setq tra061 (cons 62 (* (cdr (nth 1 tra003)) -1)))
        )
        (setq tra062 (list tra061))
      )
    )
    (if (< (atoi (nth 5 tra003)) 1)
      (setq tra063 0)
      (setq tra063 4)
    )
    (if (< (atoi (nth 6 tra003)) 1)
      (setq tra064 1)
      (setq tra064 0)
    )
    (if (vl-position (strcase (nth 0 tra003)) '("DEFPOINTS"))
      (setq tra064 0)
    )
    (if (< (atoi (nth 7 tra003)) 1)
      (setq tra065 0)
      (setq tra065 1)
    )
    (setq tra066 (list (cons 0 "LAYER") (cons 100 "AcDbSymbolTableRecord") (cons 100 "AcDbLayerTableRecord") (cons 2 (nth 0 tra003)) (cons 70 (+ tra063 tra065)) (cons 6 tra060) (cons 290 tra064) (cons 370 (nth 3 tra003))))
    (setq tra066 (append tra066 tra062))
      (if
        (and
          (setq tra067 (nth 9 tra003))
          (>= tra067 0)
          (<= tra067 90)
          (getvar "CETRANSPARENCY")
          (setq tra036 (getvar "PRODUCT"))
          (= (type tra036) 'STR)
          (vl-position (strcase tra036) '("AUTOCAD"))
        )
          (progn
            (regapp "AcCmTransparency")
              (setq tra068 '(33554687 33554684 33554681 33554679 33554676 33554674 33554671 33554669 33554666 33554664 33554661 33554658 33554656 33554653 33554651 33554648 33554646 33554643 33554641 33554638 33554636 33554633 33554630 33554628 33554625 33554623 33554620 33554618 33554615 33554613 33554610 33554607 33554605 33554602 33554600 33554597 33554595 33554592 33554590 33554587 33554585 33554582 33554579 33554577 33554574 33554572 33554569 33554567 33554564 33554562 33554559 33554556 33554554 33554551 33554549 33554546 33554544 33554541 33554539 33554536 33554534 33554531 33554528 33554526 33554523 33554521 33554518 33554516 33554513 33554511 33554508 33554505 33554503 33554500 33554498 33554495 33554493 33554490 33554488 33554485 33554483 33554480 33554477 33554475 33554472 33554470 33554467 33554465 33554462 33554460 33554457))
              (setq tra069 (list -3 (setq tra070 (list "AcCmTransparency" (cons 1071 (nth tra067 tra068))))))
              (setq tra066 (append tra066 (list tra069)))
          )
      )
    (vl-catch-all-apply 'entmake (list tra066))
      (if (tblsearch "LAYER" (car tra003))
        (car tra003)
        nil
      )
  )
  (defun tar009 (tra004 / tra071 tra072 tra073 tra074 tra075 tra076 tra077 tra078 tra079 tra080 tra081 tra082 tra034)
    (if
      (and
        (= (type tra004) 'STR)
        (snvalid tra004)
        (not (tblsearch "LTYPE" tra004))
      )
        (progn
          (setq tra071 (vlax-get-acad-object))
          (setq tra072 (vla-get-ActiveDocument tra071))
          (setq tra073 (vla-get-Linetypes tra072))
            (if
              (and
                (not (vl-catch-all-error-p (setq tra074 (vl-catch-all-apply 'vla-get-Preferences (list tra071)))))
                (not (vl-catch-all-error-p (setq tra075 (vl-catch-all-apply 'vla-get-Files (list tra074)))))
                (not (vl-catch-all-error-p (setq tra076 (vl-catch-all-apply 'vla-get-SupportPath (list tra075)))))
              )
                (setq tra077 (tar017 tra076 ";" 1))
                (progn
                  (if (setq tra078 (getenv "ACAD"))
                    (setq tra077 (tar017 tra078 ";" 1))
                  )
                  (if
                    (and
                      (not tra077)
                      (setq tra078 (getenv "ZWCAD"))
                    )
                      (setq tra077 (tar017 tra078 ";" 1))
                  )
                )
            )
            (while tra077
              (setq tra079 (append tra079 (vl-directory-files (car tra077) "*.lin" 1)))
              (setq tra077 (cdr tra077))
            )
            (while tra079
              (if (vl-string-search "iso.lin" (setq tra080 (car tra079)))
                (setq tra081 (append tra081 (list tra080)))
                (setq tra082 (append tra082 (list tra080)))
              )
              (setq tra079 (cdr tra079))
            )
            (if (< (getvar "MEASUREINIT") 1)
              (setq tra034 (append tra082 tra081))
              (setq tra034 (append tra081 tra082))
            )
            (while
              (and
                (not (tblsearch "LTYPE" tra004))
                tra034
              )
                (vl-catch-all-apply 'vla-Load (list tra073 tra004 (car tra034)))
                (setq tra034 (cdr tra034))
            )
          (tblsearch "LTYPE" tra004)
        )
    )
    (if (= (type tra004) 'STR)
      (tblsearch "LTYPE" tra004)
      nil
    )
  )
  (defun tar010 (tra005 / tra083 tra084 tra085 tra086 tra028 tra051 tra087 tra038 tra030 tra088 tra089 tra090 tra091 tra092 tra094 tra095 tra096 tra097 tra068 tra098 tra099 tra101 tra102 tra103 tra104 tra105 tra106 tra107 tra108 tra109 tra110 tra111 tra114)
    (vl-load-com)
    (setq tra083 ndk55s_-mfm618ddg4)
    (setq tra084 ndk55s_-mgm618ddg4)
    (setq tra085 ndk55s_-mhm618ddg4)
    (setq tra086 ndk55s_-mim618ddg4)
    (setq tra028
      (list
        "acm524"
        ":dialog{key=\042title\042;initial_focus=\042eb_01\042;"
        ":spacer{height=0;}"
        ":text{label=\042&Name:\042;}"
        ":edit_box{key=\042eb_01\042;edit_limit=255;allow_accept=true;}"
        ":spacer{height=0.5;}"
        ":row{"
        ":button{key=\042b_01\042;label=\042&Farbe...\042;width=16;fixed_width=true;}"
        ":column{"
        ":spacer{height=0.1;}"
        ":image_button{key=\042ib_01\042;width=2.9;fixed_width=true;height=1.3;fixed_height=true;color=dialog_background;}"
        ":spacer{height=0;}}"
        ":text{key=\042t_02\042;width=26.2;fixed_width=true;}}"
        ":popup_list{key=\042pl_01\042;label=\042&Linientyp:\042;width=49;edit_width=28.2;fixed_width=true;}"
        ":popup_list{key=\042pl_02\042;label=\042Linien&stärke:\042;width=49;edit_width=28.2;fixed_width=true;}"
      )
    )
      (if
        (and
          (getvar "CETRANSPARENCY")
          (setq tra051 (getvar "PRODUCT"))
          (= (type tra051) 'STR)
          (vl-position (strcase tra051) '("AUTOCAD" "ZWCAD"))
        )
          (progn
            (setq tra028 (append tra028 (list ":popup_list{key=\042pl_03\042;label=\042&Transparenz:\042;width=49;edit_width=28.2;fixed_width=true;}")))
            (setq tra087 1)
          )
          (setq tra087 0)
      )
    (setq tra028
      (append tra028
        (list 
          ":spacer{height=1.2;}"
          ":row{"
          ":spacer{width=1;}"
          ":column{width=10;fixed_width=true;"
          ":button{key=\042b_02\042;label=\042OK\042;is_default=true;}"
          ":button{key=\042b_03\042;label=\042Abbrechen\042;is_cancel=true;}}"
          ":spacer{width=1;}}}"
        )
      )
    )
      (if (setq tra038 (tar021 tra028 "ccnl" "dcl"))
        (progn
          (setq tra030 (load_dialog tra038))
            (if (not (new_dialog "acm524" tra030))
              (exit)
            )
          (vl-catch-all-apply 'vl-file-delete (list tra038))
          (set_tile "title" "Neuen Layer anlegen")
          (setq tra088 1)
            (while (tblsearch "LAYER" (setq tra089 (strcat "Layer" (itoa tra088))))
              (setq tra088 (1+ tra088))
            )
          (set_tile "eb_01" tra089)
          (setq tra090 (tar020))
          (start_list "pl_01")
          (mapcar 'add_list tra090)
          (end_list)
          (setq tra091 (mapcar 'strcase tra090))
            (if
              (and
                (= (type ndk55s_-mfm618ddg4) 'STR)
                (setq tra092 (vl-position (strcase ndk55s_-mfm618ddg4) tra091))
              )
                (set_tile "pl_01" (itoa tra092))
                (progn
                  (setq ndk55s_-mfm618ddg4 "Continuous")
                    (if (setq tra092 (vl-position (strcase ndk55s_-mfm618ddg4) tra091))
                      (set_tile "pl_01" (itoa tra092))
                    )
                )
            )
            (if (< (getvar "LWUNITS") 1)
              (setq tra094 '("Vorgabe" "0.000''" "0.002''" "0.004''" "0.005''" "0.006''" "0.007''" "0.008''" "0.010''" "0.012''" "0.014''" "0.016''" "0.020''" "0.021''" "0.024''" "0.028''" "0.031''" "0.035''" "0.039''" "0.042''" "0.047''" "0.055''" "0.062''" "0.079''" "0.083''"))
              (setq tra094 '("Vorgabe" "0.00 mm" "0.05 mm" "0.09 mm" "0.13 mm" "0.15 mm" "0.18 mm" "0.20 mm" "0.25 mm" "0.30 mm" "0.35 mm" "0.40 mm" "0.50 mm" "0.53 mm" "0.60 mm" "0.70 mm" "0.80 mm" "0.90 mm" "1.00 mm" "1.06 mm" "1.20 mm" "1.40 mm" "1.58 mm" "2.00 mm" "2.11 mm"))
            )
          (setq tra095 '("Rot" "Gelb" "Grün" "Cyan" "Blau" "Magenta" "Weiß"))
          (setq tra096 '(-3 0 5 9 13 15 18 20 25 30 35 40 50 53 60 70 80 90 100 106 120 140 158 200 211))
          (start_list "pl_02")
          (mapcar 'add_list tra094)
          (end_list)
            (if
              (and
                (= (type ndk55s_-mhm618ddg4) 'INT)
                (setq tra097 (vl-position ndk55s_-mhm618ddg4 tra096))
              )
                (set_tile "pl_02" (itoa tra097))
            )
            (if (> tra087 0)
              (progn
                (setq tra068 '("0" "1" "2" "3" "4" "5" "6" "7" "8" "9" "10" "11" "12" "13" "14" "15" "16" "17" "18" "19" "20" "21" "22" "23" "24" "25" "26" "27" "28" "29" "30" "31" "32" "33" "34" "35" "36" "37" "38" "39" "40" "41" "42" "43" "44" "45" "46" "47" "48" "49" "50" "51" "52" "53" "54" "55" "56" "57" "58" "59" "60" "61" "62" "63" "64" "65" "66" "67" "68" "69" "70" "71" "72" "73" "74" "75" "76" "77" "78" "79" "80" "81" "82" "83" "84" "85" "86" "87" "88" "89" "90"))
                (start_list "pl_03")
                (mapcar 'add_list tra068)
                (end_list)
                  (if
                    (and
                      (= (type ndk55s_-mim618ddg4) 'STR)
                      (setq tra098 (vl-position ndk55s_-mim618ddg4 tra068))
                    )
                      (set_tile "pl_03" (itoa tra098))
                  )
              )
            )
          (setq tra099 (tar019 ndk55s_-mgm618ddg4 0 0))
          (setq ndk55s_-mgm618ddg4 tra099)
          (setq tra101 (car tra099))
          (setq tra102 (cdr tra099))
            (if (= tra101 62)
              (progn
                (if (< tra102 8)
                  (set_tile "t_02" (nth (1- tra102) tra095))
                  (set_tile "t_02" (strcat "Farbe " (itoa tra102)))
                )
                (start_image "ib_01")
                (fill_image 0 0 (dimx_tile "ib_01") (dimy_tile "ib_01") tra102)
                (end_image)
              )
            )
            (if (= tra101 420)
              (progn
                (set_tile "t_02" (tar018 tra102))
                (start_image "ib_01")
                (fill_image 0 0 (dimx_tile "ib_01") (dimy_tile "ib_01") (tar015 tra102))
                (end_image)
              )
            )
            (if (= tra101 430)
              (progn
                (if (setq tra103 (vl-string-search "$" tra102))
                  (set_tile "t_02" (tar014 (substr tra102 (+ 2 tra103)) 17))
                )
                (start_image "ib_01")
                (fill_image 0 0 (dimx_tile "ib_01") (dimy_tile "ib_01") (tar015 (tar012 tra102)))
                (end_image)
              )
            )
            (action_tile "b_01" "(if (setq tra104 (tar011 (list ndk55s_-mgm618ddg4 nil)))
              (progn
                (setq ndk55s_-mgm618ddg4 (setq tra105 (last tra104)))
                (start_image \"ib_01\")
                (fill_image 0 0 (dimx_tile \"ib_01\") (dimy_tile \"ib_01\") (cdr (car tra104)))
                (end_image)
                (setq tra106 (car tra105))
                (setq tra107 (cdr tra105))
                  (if (= tra106 430)
                    (progn
                      (if (setq tra103 (vl-string-search \"$\" tra107))
                        (set_tile \"t_02\" (tar014 (substr tra107 (+ 2 tra103)) 17))
                      )
                    )
                  )
                  (if (= tra106 420)
                    (set_tile \"t_02\" (tar018 tra107))
                  )
                  (if (= tra106 62)
                    (progn
                      (if (< tra107 8)
                        (set_tile \"t_02\" (nth (1- tra107) tra095))
                        (set_tile \"t_02\" (strcat \"Farbe \" (itoa tra107)))
                      )
                    )
                  )
              ))"
            )
            (action_tile "ib_01" "(if (setq tra104 (tar011 (list ndk55s_-mgm618ddg4 nil)))
              (progn
                (setq ndk55s_-mgm618ddg4 (setq tra105 (last tra104)))
                (start_image $key)
                (fill_image 0 0 (dimx_tile $key) (dimy_tile $key) (cdr (car tra104)))
                (end_image)
                (setq tra106 (car tra105))
                (setq tra107 (cdr tra105))
                  (if (= tra106 430)
                    (progn
                      (if (setq tra103 (vl-string-search \"$\" tra107))
                        (set_tile \"t_02\" (tar014 (substr tra107 (+ 2 tra103)) 17))
                      )
                    )
                  )
                  (if (= tra106 420)
                    (set_tile \"t_02\" (tar018 tra107))
                  )
                  (if (= tra106 62)
                    (progn
                      (if (< tra107 8)
                        (set_tile \"t_02\" (nth (1- tra107) tra095))
                        (set_tile \"t_02\" (strcat \"Farbe \" (itoa tra107)))
                      )
                    )
                  )
              ))"
            )
          (setq tra108 "Der eingegebene Name ist ungültig.")
            (action_tile "b_02" "(setq tra109 nil)
              (setq tra110 (vl-string-trim \" \" (get_tile \"eb_01\")))
                (if (= tra110 \"\")
                  (progn
                    (alert \"Bitte geben Sie einen Namen ein.\")
                    (mode_tile \"eb_01\" 2)
                  )
                  (progn
                    (if
                      (and
                        (not (tblsearch \"LAYER\" tra110))
                        (snvalid tra110)
                      )
                        (setq tra109 T)
                        (progn
                          (if (tblsearch \"LAYER\" tra110)
                            (alert \"Der eingegebene Name wird bereits verwendet.\")
                            (alert tra108)
                          )
                          (mode_tile \"eb_01\" 2)
                        )
                    )
                  )
                )
                (if tra109
                  (progn
                    (setq tra111
                      (list
                        tra110
                        ndk55s_-mgm618ddg4
                        (setq ndk55s_-mfm618ddg4 (nth (atoi (get_tile \"pl_01\")) tra090))
                        (setq ndk55s_-mhm618ddg4 (nth (atoi (get_tile \"pl_02\")) tra096))
                      )
                    )
                    (if (> tra087 0)
                      (setq tra111 (append tra111 (list (atoi (setq ndk55s_-mim618ddg4 (nth (atoi (get_tile \"pl_03\")) tra068))))))
                    )
                    (done_dialog)
                  )
                )"
            )
            (action_tile "b_03" "(setq tra111 nil) 
              (setq ndk55s_-mfm618ddg4 tra083)
              (setq ndk55s_-mgm618ddg4 tra084)
              (setq ndk55s_-mhm618ddg4 tra085)
              (setq ndk55s_-mim618ddg4 tra086)
              (done_dialog)"
            )
          (start_dialog)
          (unload_dialog tra030)
        )
      )
    (if (and tra111 (> tra005 0))
      (progn
        (setq tra114 (nth 4 tra111))
        (setq tra111
          (list
            (nth 0 tra111)
            (nth 1 tra111)
            (nth 2 tra111)
            (nth 3 tra111)
            "0"
            "0"
            "0"
            "0"
            "0"
          )
        )
          (if tra114
            (setq tra111 (reverse (cons tra114 (reverse tra111))))
          )
      )
    )
    tra111
  )
  (defun tar011 (tra006 / tra115 tra051 tra062)
    (setq tra115 (length tra006))
    (if
      (and
        (setq tra051 (getvar "PRODUCT"))
        (= (type tra051) 'STR)
        (vl-position (strcase tra051) '("AUTOCAD" "ZWCAD"))
      )
        (progn
          (if (= tra115 1)
            (setq tra062 (vl-catch-all-apply 'acad_truecolordlg (list (car tra006))))
          )
          (if (= tra115 2)
            (setq tra062 (vl-catch-all-apply 'acad_truecolordlg (list (car tra006) (cadr tra006))))
          )
          (if (>= tra115 3)
            (setq tra062 (vl-catch-all-apply 'acad_truecolordlg (list (car tra006) (cadr tra006) (caddr tra006))))
          )
        )
        (progn
          (if (= tra115 1)
            (setq tra062 (vl-catch-all-apply 'acad_truecolordlg (list (car tra006))))
          )
          (if (>= tra115 2)
            (setq tra062 (vl-catch-all-apply 'acad_truecolordlg (list (car tra006) (cadr tra006))))
          )
        )
    )
    tra062
  )
  (defun tar012 (tra007 / tra116 tra051 tra117 tra118 tra119 tra120 tra121 tra122 tar013)
    (vl-load-com)
    (defun tar013 ( tra008 tra009 tra010 / )
      (+ (lsh (fix tra008) 16) (lsh (fix tra009) 8) (fix tra010))
    )
    (setq tra116 (substr (getvar "ACADVER") 1 2))
      (if (< (atoi tra116) 16)
        (setq tra116 "16")
      )
      (if
        (and
          (setq tra051 (getvar "PRODUCT"))
          (= (type tra051) 'STR)
          (= (strcase tra051) "ZWCAD")
        )
          (setq tra117 "ZWCAD.ZcCmColor")
          (setq tra117 (strcat "AutoCAD.AcCmColor." tra116))
      )
      (and
        (= (type tra007) 'STR)
        (setq tra118 (vl-string-search "$" tra007))
        (setq tra119 (substr tra007 1 tra118))
        (setq tra120 (substr tra007 (+ tra118 2)))
        (setq tra121 (vla-GetInterfaceObject (vlax-get-acad-object) tra117))
        (not (vl-catch-all-error-p (vl-catch-all-apply 'vla-SetColorBookColor (list tra121 tra119 tra120))))
        (setq tra122 (tar013 (vla-get-Red tra121) (vla-get-Green tra121) (vla-get-Blue tra121)))
      )
      (if tra122
        tra122
        16777215
      )
  )
  (defun tar014 (tra011 tra012 / tra126 tra123 tra124 tra125)
    (setq tra123 (strlen tra011))
      (if (> tra123 tra012)
        (progn
          (setq tra124 (substr tra011 1 (/ (- tra012 3) 2)))
          (setq tra125 (substr tra011 (- tra123 (1- (/ (- tra012 3) 2)))))
          (setq tra126 (strcat tra124 "\056\056\056" tra125))
        )
      )
      (if tra126
        tra126
        tra011
      )
  )
  (defun tar015 (tra013 / tra116 tra051 tra117 tra121 tra127 tar016)
    (vl-load-com)
    (defun tar016 (tra014 / )
      (list (lsh (fix tra014) -16) (lsh (lsh (fix tra014) 16) -24) (lsh (lsh (fix tra014) 24) -24))
    )
    (setq tra116 (substr (getvar "ACADVER") 1 2))
      (if (< (atoi tra116) 16)
        (setq tra116 "16")
      )
      (if
        (and
          (setq tra051 (getvar "PRODUCT"))
          (= (type tra051) 'STR)
          (= (strcase tra051) "ZWCAD")
        )
          (setq tra117 "ZWCAD.ZcCmColor")
          (setq tra117 (strcat "AutoCAD.AcCmColor." tra116))
      )
      (and
        (setq tra121 (vla-GetInterfaceObject (vlax-get-acad-object) tra117))
        (not (vl-catch-all-error-p (vl-catch-all-apply 'vla-SetRGB (cons tra121 (tar016 tra013)))))
        (setq tra127 (vla-get-ColorIndex tra121))
      )
      (if tra127
        tra127
        7
      )
  )
  (defun tar017 (tra015 tra016 tra005 / tra128 tra129)
    (if
      (and
        (= (type tra015) 'STR)
        (= (type tra016) 'STR)
      )
        (progn
          (setq tra015 (vl-string-trim tra016 tra015))
            (if (> tra005 0)
              (setq tra015 (vl-string-trim " " tra015))
            )
            (while (setq tra128 (vl-string-search tra016 tra015))
              (setq tra129 (append tra129 (list (substr tra015 1 tra128))))
              (setq tra015 (vl-string-left-trim tra016 (substr tra015 (1+ tra128))))
            )
          (setq tra129 (append tra129 (list tra015)))
        )
    )
    tra129
  )
  (defun tar018 (tra013 / tra095 tar016)
    (defun tar016 (tra014 / )
      (list (lsh (fix tra014) -16) (lsh (lsh (fix tra014) 16) -24) (lsh (lsh (fix tra014) 24) -24))
    )
    (and
      (= (type tra013) 'INT)
      (>= tra013 0)
      (<= tra013 16777215)
      (setq tra095 (mapcar 'itoa (tar016 tra013)))
      (setq tra095 (strcat (car tra095) "," (cadr tra095) "," (caddr tra095)))
    )
    (if tra095
      tra095
      "255,255,255"
    )
  )
  (defun tar019 (tra017 tra005 tra018 / tra130 tra131 tra132 tra133 tra048)
    (if (< tra005 1)
      (progn
        (setq tra130 0)
        (setq tra131 256)
      )
      (progn
        (setq tra130 -1)
        (setq tra131 257)
      )
    )
    (if
      (and
        (= (type tra017) 'LIST)
        (vl-position (setq tra132 (car tra017)) '(62 420 430))
        (vl-position (setq tra133 (type (setq tra048 (cdr tra017)))) '(INT STR))
        (or
          (and
            (= tra132 62)
            (= tra133 'INT)
            (> tra048 tra130)
            (< tra048 tra131)
          )
          (and
            (= tra132 420)
            (= tra133 'INT)
            (>= tra048 0)
            (<= tra048 16777215)
          )
          (and
            (= tra132 430)
            (= tra133 'STR)
          )
        )
      )
        tra017
        (nth tra018 (list (cons 62 7) (cons 62 256)))
    )
  )
  (defun tar020 ( / tra134 tra135 tra129 tra136)
    (setq tra134 (tblnext "LTYPE" T))
      (if (not (vl-string-search "\174" (setq tra135 (cdr (assoc 2 tra134)))))
        (setq tra129 (cons tra135 tra129))
      )
      (while (setq tra136 (tblnext "LTYPE"))
        (if (not (vl-string-search "\174" (setq tra135 (cdr (assoc 2 tra136)))))
          (setq tra129 (cons tra135 tra129))
        )
      )
      (if tra129
        (acad_strlsort tra129)
        nil
      )
  )
  (defun tar021 (tra019 tra020 tra021 / tra026 tra027 tar022)
    (defun tar022 ( / tra074 tra142 tra143 tra144 tra078 tra132 tra034 tra145 tar023 tar024)
      (defun tar023 (tra015 tra016 / tra128 tra129)
        (if
          (and
            (= (type tra015) 'STR)
            (= (type tra016) 'STR)
          )
            (progn
              (setq tra015 (vl-string-trim tra016 tra015))
              (setq tra015 (vl-string-trim " " tra015))
                (while (setq tra128 (vl-string-search tra016 tra015))
                  (setq tra129 (append tra129 (list (substr tra015 1 tra128))))
                  (setq tra015 (vl-string-left-trim tra016 (substr tra015 (1+ tra128))))
                )
              (setq tra129 (append tra129 (list tra015)))
            )
        )
        tra129
      )
      (defun tar024 (tra022 / tra034 tra140 tra141 tra027 tar025 tar026)
        (defun tar025 (tra023 tra024 / tra034 tra137 tra138)
          (setq tra034 "")
            (while (/= tra023 "")
              (setq tra137 (cons (substr tra023 1 1) tra137))
              (setq tra023 (substr tra023 2))
            )
            (while (vl-position (setq tra138 (car tra137)) tra024)
              (setq tra137 (cdr tra137))
            )
          (setq tra137 (reverse tra137))
            (while tra137
              (setq tra034 (strcat tra034 (car tra137)))
              (setq tra137 (cdr tra137))
            )
          tra034
        )
        (defun tar026 (tra025 / tra139)
          (if (= (type tra025) 'STR)
            (progn
              (if (not (getvar "DIMASSOC"))
                (progn
                  (if (not (setq tra139 (findfile tra025)))
                    (progn
                      (if (vl-file-size tra025)
                        (setq tra139 tra025)
                      )
                    )
                  )
                )
                (setq tra139 (findfile tra025))
              )
            )
          )
          tra139
        )
        (setq tra022 (strcat (tar025 tra022 '(" " "\\" "/")) "\\"))
        (setq tra034 nil)
        (setq tra140 0)
        (setq tra141 (strcat "c-x$" (itoa tra140) ".txt"))
          (while (tar026 (strcat tra022 tra141))
            (setq tra140 (1+ tra140))
            (setq tra141 (strcat "c-x$" (itoa tra140) ".txt"))
          )
          (if (setq tra027 (open (strcat tra022 tra141) "w"))
            (progn
              (setq tra027 (close tra027))
              (setq tra034 T)
                (if (setq tra027 (open (strcat tra022 tra141) "r"))
                  (setq tra027 (close tra027))
                  (setq tra034 nil)
                )
            )
            (setq tra034 nil)
          )
        (terpri)
        (vl-file-delete (strcat tra022 tra141))
        tra034
      )
      (if
        (and
          (not (vl-catch-all-error-p (setq tra074 (vl-catch-all-apply 'vla-get-Preferences (list (vlax-get-acad-object))))))
          (not (vl-catch-all-error-p (setq tra142 (vl-catch-all-apply 'vla-get-Files (list tra074)))))
          (not (vl-catch-all-error-p (setq tra143 (vl-catch-all-apply 'vla-get-SupportPath (list tra142)))))
        )
          (setq tra144 (tar023 tra143 ";"))
            (progn
              (if (setq tra078 (getenv "ACAD"))
                (setq tra144 (tar023 tra078 ";"))
              )
              (if
                (and
                  (not tra144)
                  (setq tra078 (getenv "ZWCAD"))
                )
                  (setq tra144 (tar023 tra078 ";"))
              )
            )
      )
      (if
        (and
          (setq tra132 (car tra144))
          (tar024 tra132)
        )
          (setq tra034 tra132)
          (progn
            (if (tar024 (setq tra145 (vl-filename-directory (vl-filename-mktemp))))
              (setq tra034 tra145)
            )
          )
      )
      tra034
    )
    (setq tra146 (tar022))
    (if
      (and
        (setq tra026 (vl-filename-mktemp tra020 tra146 (strcat "." tra021)))
        (setq tra027 (open tra026 "w"))
      )
        (progn
          (while tra019
            (write-line (car tra019) tra027)
            (setq tra019 (cdr tra019))
          )
          (setq tra027 (close tra027))
          tra026
        )
        nil
    )
  )
  (defun tar027 ( / tra147 tra154 tra149 tra150 tra152 tra153 tra155 tra156 tra034 tra157)
    (setq tra147 (getvar "PICKBOX"))
      (if (/= (type ndk55s_-mjm618ddg4) 'LIST)
        (setq ndk55s_-mjm618ddg4 (list 0 0 (getvar "PICKBOX")))
      )
      (if (= (cadr ndk55s_-mjm618ddg4) 1)
        (setvar "PICKBOX" (caddr ndk55s_-mjm618ddg4))
      )
    (setq tra149 ndk55s_-mjm618ddg4)
      (if
        (and
          (= (type ndk55s_-mem618ddg4) 'STR)
          (tblsearch "LAYER" ndk55s_-mem618ddg4)
          (not (vl-string-search "|" ndk55s_-mem618ddg4))
        )
          (setq tra150 ndk55s_-mem618ddg4)
          (setq tra150 (getvar "CLAYER"))
      )
      (if (not (vl-position ndk55s_-mkm618ddg4 (list "0" "1")))
        (setq ndk55s_-mkm618ddg4 "0")
      )
    (setq tra152 (getvar "ERRNO"))
    (setvar "ERRNO" 7)
      (while
        (or
          (= (getvar "ERRNO") 7)
          (= tra155 "Einstellungen")
          tra153
        )
        (setvar "ERRNO" 0)
        (setq tra153 nil)
          (if (= tra155 "Einstellungen")
            (progn
                (if (not (setq ndk55s_-mjm618ddg4 (tar002)))
                  (setq ndk55s_-mjm618ddg4 tra149)
                )
              (setq ndk55s_-mkm618ddg4 (itoa (car ndk55s_-mjm618ddg4)))
              (setq tra154 (caddr ndk55s_-mjm618ddg4))
                (if (= (cadr ndk55s_-mjm618ddg4) 1)
                  (setvar "PICKBOX" (caddr ndk55s_-mjm618ddg4))
                )
            )
          )
          (if (= ndk55s_-mkm618ddg4 "0")
            (progn
              (initget "Einstellungen Auswahlliste")
              (setq tra155 (entsel (strcat "\nAktuell zu setzenden Layer durch Objekt wählen oder [Einstellungen/Auswahlliste] <" (tar014 tra150 39) ">: ")))
            )
            (progn
              (initget "Einstellungen Auswahlliste")
              (setq tra155 (nentsel (strcat "\nAktuell zu setzenden Layer durch Objekt wählen oder [Einstellungen/Auswahlliste] <" (tar014 tra150 39) ">: ")))
            )
          )
          (if (not tra155)
            (setq tra155 (list tra150))
            (progn
              (if (not (vl-position tra155 (list "Einstellungen" "Auswahlliste")))
                (progn
                  (setq tra156 (vla-get-Layer (vlax-ename->vla-object (car tra155))))
                    (if (vl-string-search "|" tra156)
                      (progn
                        (setq tra153 T)
                        (alert "Ungültig. Layer ist XRef-abhängig.")
                      )
                    )
                )
              )
            )
          )
          (if (= (getvar "ERRNO") 7)
            (princ "0 gefunden")
          )
      )
      (if tra152
        (setvar "ERRNO" tra152)
      )
      (if tra155
        (progn
          (if (= tra155 "Auswahlliste")
            (progn
              (setq tra034 (list 1 (setq tra157 (tar005))))
            )
            (progn
              (if (= (type (car tra155)) 'STR)
                (setq tra034 (list 0 (list (setq ndk55s_-mem618ddg4 (car tra155)))))
                (setq tra034 (list 0 (list (setq ndk55s_-mem618ddg4  tra156))))
              )
            )
          )
        )
      )
    (setvar "PICKBOX" tra147)
    tra034
  )
  (defun tar028 ( / )
    (if (not (vl-position ndk55s_-mam618ddg4 (list 0 1)))
      (setq ndk55s_-mam618ddg4 0)
    )
    (if (not (vl-position ndk55s_-mbm618ddg4 (list 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20)))
      (progn
        (setq ndk55s_-mam618ddg4 0)
        (setq ndk55s_-mbm618ddg4 (getvar "PICKBOX"))
      )
    )
    (if (not (vl-position ndk55s_-mcm618ddg4 (list 0 1)))
      (setq ndk55s_-mcm618ddg4 0)
    )
    (if (not (vl-position ndk55s_-mlm618ddg4 (list 0 1)))
      (setq ndk55s_-mlm618ddg4 0)
    )
    (prompt
      (strcat
        "\nAktuelle Einstellungen für Wahl des Layers: Pickbox-Größe = "
          (if (= ndk55s_-mam618ddg4 0)
            (strcat "Aktuelle (" (itoa (getvar "PICKBOX")) ")")
            (itoa ndk55s_-mbm618ddg4)
          )
        ", Blockelemente wählbar = "
        (nth ndk55s_-mcm618ddg4 (list "Nein" "Ja"))
      )
    )
  )
  (if (tar004)
    (progn
      (vl-load-com)
      (setq tra159 (getvar "CMDECHO"))
      (setvar "CMDECHO" 0)
      (setq tra072 (vla-get-ActiveDocument (vlax-get-acad-object)))
      (setq tra160 *error*)
      (setq *error* tar003)
      (vla-EndUndoMark tra072)
      (vla-StartUndoMark tra072)
      (setq tra161 T)
      (tar028)
        (if (setq tra162 (tar027))
          (progn
            (vl-catch-all-apply 'setvar (list "CLAYER" (car (cadr tra162))))
            (prompt (strcat "\nNeuer aktueller Layer: " (tar014 (car (cadr tra162)) 31) " "))
          )
        )
        (if tra160
          (setq *error* tra160)
          (setq *error* nil)
        )
      (setvar "CMDECHO" tra159)
      (vla-EndUndoMark tra072)
    )
  )
  (princ)
)
(terpri)
(princ (strcat "\nAutoLISP-Tool ACM-LAYERSETZEN (Copyright © " (substr (rtos (getvar "CDATE")) 1 4) " Gerhard Rampf) geladen. "))
(princ "\nRufen Sie den Befehl mit ACM-LAYERSETZEN auf.")
