;;  Programm:      ACM-EIGAENDER.LSP
;;  Befehlsaufruf: ACM-EIGAENDER
;;  Funktion:      Farbe, Layer, Linientyp und Linienstärke zuweisen
;;  Autor:         Gerhard Rampf
;;                 Kundenspezifische Anpassungen für AutoCAD und ZWCAD
;;                 Liebigstr. 3 A
;;                 86399 Bobingen
;;                 E-Mail: info@geracad.de
;;  Datum:         07.09.2023
;;  Plattform:     Alle AutoCAD-Versionen ab Version 2005
(defun c:acm-eigaender ( / cpr073 cpr162 crp001 crp002 crp003 crp004 crp005 crp006 crp007 crp008 crp009 crp010 crp011 crp012 crp013 crp014 crp015 crp016 crp017 crp018 crp019 crp020 crp021 crp022 crp023 crp024 crp025 crp026 crp027 crp028 crp029 crp030 crp012 crp031 crp032 crp033 crp034)
    (defun crp001 (cpr001 / cpr031 cpr032 cpr033 cpr034 cpr035 cpr036 cpr037 cpr038 cpr039 cpr040 cpr041 cpr042)
      (setq cpr031 (crp005 cpr001))
        (while cpr031
          (setq cpr032 (car cpr031))
          (setq cpr033 (vl-string-right-trim "\\" (car cpr032)))
          (setq cpr034 (cadr cpr032))
            (while cpr034
              (setq cpr035 (car cpr034))
              (setq cpr036 (strcat cpr033 "\\" cpr035))
                (if (setq cpr037 (crp002 cpr036))
                  (progn
                    (setq cpr038 (car cpr037))
                      (while cpr038
                        (setq cpr039 (car cpr038))
                        (setq cpr040 (strcase cpr039))
                          (if (not (vl-position cpr040 cpr041))
                            (progn
                              (setq cpr041 (cons (strcase cpr039) cpr041))
                              (setq cpr042 (cons (cons cpr039 cpr036) cpr042))
                            )
                          )
                        (setq cpr038 (cdr cpr038))
                      )
                  )
                )
              (setq cpr034 (cdr cpr034))
            )
          (setq cpr031 (cdr cpr031))
        )
        (if cpr042
          (list (acad_strlsort (mapcar 'car cpr042)) cpr042)
          nil
        )
    )
    (defun crp002 (cpr002 / cpr044 cpr045 cpr046 cpr047 cpr048 cpr049)
      (if
        (and
          (setq cpr043 (findfile cpr002))
          (setq cpr044 (crp004 cpr043))
        )
          (progn
              (while cpr044
                (if (= (substr (setq cpr045 (car cpr044)) 1 1) "*")
                  (progn
                    (setq cpr045 (substr cpr045 2))
                      (if
                        (and
                          (setq cpr046 (car (crp003 cpr045 "," 0)))
                          (snvalid cpr046)
                        )
                          (progn
                            (setq cpr047 (strcase cpr046))
                              (if (not (vl-position cpr047 cpr049))
                                (setq cpr048 (cons cpr046 cpr048))
                              )
                            (setq cpr049 (cons (setq cpr047 (strcase cpr046)) cpr049))
                          )
                      )
                  )
                )
                (setq cpr044 (cdr cpr044))
              )
              (if cpr048
                (list cpr048 cpr043)
                nil
              )
          )
          nil
      )
    )
    (defun crp003 (cpr003 cpr004 cpr005 / cpr050 cpr051)
      (setq cpr003 (vl-string-trim cpr004 cpr003))
        (if (> cpr005 0)
          (setq cpr003 (vl-string-trim " " cpr003))
        )
        (while (setq cpr050 (vl-string-search cpr004 cpr003))
          (setq cpr051 (append cpr051 (list (substr cpr003 1 cpr050))))
          (setq cpr003 (vl-string-left-trim cpr004 (substr cpr003 (1+ cpr050))))
        )
      (append cpr051 (list cpr003))
    )
    (defun crp004 (cpr006 / cpr052 cpr053 cpr054 cpr048)
      (setq cpr052 (findfile cpr006))
        (if (not cpr052)
          (progn
            (repeat 20
              (setq cpr052 (findfile cpr006))
            )
          )
        )
        (if cpr052
          (progn
            (setq cpr053 (open cpr052 "r"))
              (while (setq cpr054 (read-line cpr053))
                (setq cpr048 (append cpr048 (list cpr054)))
              )
              (if cpr053
                (setq cpr053 (close cpr053))
              )
            cpr048
          )
        )
    )
    (defun crp005 (cpr001 / cpr055 cpr056 cpr057 cpr058 cpr059)
      (setq cpr055 (crp006))
        (while cpr055
          (setq cpr056 (car cpr055))
            (if (setq cpr057 (vl-directory-files cpr056 "*.lin" 1))
              (progn
                (setq cpr058 (crp007 cpr057 cpr001))
                (setq cpr059 (cons (list cpr056 cpr058) cpr059))
              )
            )
          (setq cpr055 (cdr cpr055))
        )
      cpr059
    )
    (defun crp006 ( / cpr060 cpr061 cpr062 cpr063)
        (if
          (and
            (setq cpr060 (getvar "PRODUCT"))
            (= (type cpr060) 'STR)
            (vl-position (setq cpr061 (strcase cpr060)) '("AUTOCAD" "BRICSCAD" "ZWCAD"))
          )
            (progn
              (if (= cpr061 "AUTOCAD")
                (setq cpr062 "ACAD")
              )
              (if (= cpr061 "BRICSCAD")
                (setq cpr062 "BRICSCAD")
              )
              (if (= cpr061 "ZWCAD")
                (setq cpr062 "ZWCAD")
              )
            )
            (setq cpr062 "ACAD")
        )
      (setq cpr063 (getenv cpr062))
      (crp003 cpr063 ";" 1)
    )
    (defun crp007 (cpr007 cpr005 / cpr064 cpr065 cpr066 cpr067)
      (setq cpr007 (mapcar 'strcase cpr007))
        (while cpr007
          (setq cpr064 (car cpr007))
            (if (vl-string-search "ISO" cpr064)
              (setq cpr065 (cons cpr064 cpr065))
              (setq cpr066 (cons cpr064 cpr066))
            )
          (setq cpr007 (cdr cpr007))
        )
        (if (= cpr005 0)
          (setq cpr067 (append cpr066 cpr065))
          (setq cpr067 (append cpr065 cpr066))
        )
      cpr067
    )
    (defun crp008 (cpr008 / cpr068)
      (if (setq cpr068 (findfile "ltypeshp.shx"))
        (progn
          (if (= (type (vl-catch-all-apply 'vla-LoadShapeFile (list cpr008 cpr068))) 'VL-CATCH-ALL-APPLY-ERROR)
            (prompt (strcat "Kann Symboldatei \042ltypeshp.shx\042 in \042" (crp009 cpr008) "\042 nicht laden. "))
            (setq cpr069 T)
          )
        )
        (setq cpr069 nil)
      )
    )
    (defun crp009 (cpr008 / cpr070 cpr071)
      (setq cpr070 (vl-string-right-trim "\\" (vla-get-Path cpr008)))
      (setq cpr071 (vla-get-Name cpr008))
      (strcat cpr070 "\\" cpr071)
    )
    (defun crp010 (cpr009 / cpr072 cpr073 cpr074 cpr075 cpr076 cpr077 cpr078 cpr062 cpr031 cpr079 cpr080 cpr081 cpr082)
        (if
          (and
            (= (type cpr009) 'STR)
            (snvalid cpr009)
            (not (tblsearch "LTYPE" cpr009))
          )
            (progn
              (setq cpr072 (vlax-get-acad-object))
              (setq cpr073 (vla-get-ActiveDocument cpr072))
              (setq cpr074 (vla-get-Linetypes cpr073))
                (if
                  (and
                    (not (vl-catch-all-error-p (setq cpr075 (vl-catch-all-apply 'vla-get-Preferences (list cpr072)))))
                    (not (vl-catch-all-error-p (setq cpr076 (vl-catch-all-apply 'vla-get-Files (list cpr075)))))
                    (not (vl-catch-all-error-p (setq cpr077 (vl-catch-all-apply 'vla-get-SupportPath (list cpr076)))))
                  )
                    (setq cpr078 (crp003 cpr077 ";" 1))
                    (progn
                      (if (setq cpr062 (getenv "ACAD"))
                        (setq cpr078 (crp003 cpr062 ";" 1))
                      )
                      (if
                        (and
                          (not cpr078)
                          (setq cpr062 (getenv "ZWCAD"))
                        )
                          (setq cpr078 (crp003 cpr062 ";" 1))
                      )
                    )
                )
                (while cpr078
                  (setq cpr031 (append cpr031 (vl-directory-files (car cpr078) "*.lin" 1)))
                  (setq cpr078 (cdr cpr078))
                )
                (while cpr031
                    (if (vl-string-search "iso.lin" (setq cpr079 (car cpr031)))
                      (setq cpr080 (append cpr080 (list cpr079)))
                      (setq cpr081 (append cpr081 (list cpr079)))
                    )
                  (setq cpr031 (cdr cpr031))
                )
                (if (< (getvar "MEASUREINIT") 1)
                  (setq cpr082 (append cpr081 cpr080))
                  (setq cpr082 (append cpr080 cpr081))
                )
                (while
                  (and
                    (not (tblsearch "LTYPE" cpr009))
                    cpr082
                  )
                    (vl-catch-all-apply 'vla-Load (list cpr074 cpr009 (car cpr082)))
                    (setq cpr082 (cdr cpr082))
                )
              (tblsearch "LTYPE" cpr009)
            )
        )
        (if (= (type cpr009) 'STR)
          (tblsearch "LTYPE" cpr009)
          nil
        )
    )
    (defun crp011 (cpr010 cpr011 / cpr085 cpr083 cpr084)
      (if
        (and
          (setq cpr083 (vl-filename-mktemp "acm.dcl"))
          (setq cpr084 (open cpr083 "w"))
        )
          (progn
            (setq cpr085
              (list
                "changeprop"
                ":dialog{key=\042d_01\042;"
                ":row{"
                ":column{"
                ":spacer{height=0.2;}"
                (strcat ":toggle{key=\042tg_01\042;label=\042" (nth cpr010 (list "&Farbe" "&Color")) ":\042;}")
                ":spacer{height=0;}}"
                ":button{key=\042b_01\042;label=\042...\042;width=0;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_01\042;width=25;fixed_width=true;height=1.1;}}"
                ":row{"
                (strcat ":toggle{key=\042tg_02\042;label=\042&Layer:\042;width=0;fixed_width=true;}")
                ":popup_list{key=\042pl_01\042;width=28;fixed_width=true;}}"
                ":row{"
                (strcat ":toggle{key=\042tg_03\042;label=\042" (nth cpr010 (list "L&inientyp" "L&inetype")) ":\042;width=0;fixed_width=true;}")
                ":popup_list{key=\042pl_02\042;width=28;fixed_width=true;}}"
                ":row{"
                (strcat ":toggle{key=\042tg_04\042;label=\042" (nth cpr010 (list "Linien&stärke" "Line&weight")) ":\042;width=0;fixed_width=true;}")
                ":popup_list{key=\042pl_03\042;width=28;fixed_width=true;}}"
                ":spacer{height=1;}"
                ":row{"
                ":spacer{width=2;}"
                ":button{key=\042b_02\042;label=\042OK\042;width=18;fixed_width=true;is_default=true;}"
                (strcat ":button{key=\042b_03\042;label=\042" (nth cpr010 (list "Abbrechen" "Cancel")) "\042;width=18;fixed_width=true;is_cancel=true;}")
                ":spacer{width=2;}}"
                ":spacer{height=0.1;}"
                  (if (= cpr011 1)
                    ":text{key=\042t_02\042;height=1.1;alignment=right;}}"
                    "}"
                  )
              )
            )
              (while cpr085
                (write-line (car cpr085) cpr084)
                (setq cpr085 (cdr cpr085))
              )
            (setq cpr084 (close cpr084))
            cpr083
          )
          nil
      )
    )
    (defun crp012 ( / cpr060 cpr086)
      (setq cpr060 (strcase (getvar "PRODUCT")))
        (if
          (and
            (= cpr060 "AUTOCAD")
            (getvar "HPDRAWORDER")
          )
            (setq cpr086 T)
            (setq cpr086 nil)
        )
        (if (not cpr086)
          (alert "\042acm-xxx\042 kann nur unter AutoCAD ab Version 2005 verwendet werden.")
        )
      cpr086
    )
    (defun crp013 ( / cpr087 cpr088 cpr090 cpr089)
      (setq cpr087 (tblnext "LTYPE" T))
      (setq cpr088 (cdr (assoc 2 cpr087)))
        (if (not (vl-string-search "\174" cpr088))
          (setq cpr089 (cons cpr088 cpr089))
        )
        (while (setq cpr090 (tblnext "LTYPE"))
          (setq cpr088 (cdr (assoc 2 cpr090)))
            (if (not (vl-string-search "\174" cpr088))
              (setq cpr089 (cons cpr088 cpr089))
            )
          )
      cpr089
    )
    (defun crp014 ( / cpr091 cpr163 cpr092)
      (setq cpr091 (vla-get-Layers (vla-get-ActiveDocument (vlax-get-acad-object))))
        (vlax-for cpr163 cpr091
          (if (not (vl-string-search "|" (setq cpr071 (vlax-get cpr163 'Name))))
            (setq cpr092 (cons cpr071 cpr092))
          )
        )
      (acad_strlsort cpr092)
    )
    (defun crp015 (cpr007 / cpr093 cpr094 cpr095)
      (if (= (type cpr007) 'LIST)
        (progn
          (setq cpr007 (crp016 cpr007 'STR))
            (if cpr007
              (progn
                (setq cpr093 cpr007)
                  (while cpr093
                    (setq cpr094 (cons (strcase (car cpr093)) cpr094))
                    (setq cpr093 (cdr cpr093))
                  )
                (setq cpr094 (reverse cpr094))
                (setq cpr093 cpr094)
                  (while cpr093
                      (if (not (vl-position (car cpr093) cpr095))
                        (setq cpr095 (cons (car cpr093) cpr095))
                      )
                    (setq cpr093 (cdr cpr093))
                  )
                (setq cpr095 (reverse cpr095))
              )
            )
        )
      )
      (if cpr095
        (crp017 cpr095 cpr007)
      )
    )
    (defun crp016 (cpr007 cpr012 / cpr096 cpr095)
        (repeat (length cpr007)
          (setq cpr096 (car cpr007))
            (if (= (type cpr096) cpr012)
              (setq cpr095 (cons cpr096 cpr095))
            )
          (setq cpr007 (cdr cpr007))
        )
      (reverse cpr095)
    )
    (defun crp017 (cpr013 cpr014 / cpr097 cpr098 cpr099 cpr100 cpr101 cpr050 cpr095)
      (setq cpr097 cpr013)
      (setq cpr098 cpr014)
        (repeat (length cpr097)
          (setq cpr099 (cons (strcase (car cpr097)) cpr099))
          (setq cpr097 (cdr cpr097))
        )
        (repeat (length cpr098)
          (setq cpr100 (cons (strcase (car cpr098)) cpr100))
          (setq cpr098 (cdr cpr098))
        )
      (setq cpr099 (reverse cpr099))
      (setq cpr100 (reverse cpr100))
        (repeat (length cpr099)
          (setq cpr101 (member (car cpr099) cpr100))
            (if cpr101
              (progn
                (setq cpr050 (- (length cpr100) (length cpr101)))
                (setq cpr095 (cons (nth cpr050 cpr014) cpr095))
              )
            )
          (setq cpr099 (cdr cpr099))
        )
      (reverse cpr095)
    )
    (defun crp018 (cpr010 / cpr102)
        (if
          (and
            (setq cpr102 (crp013))
            (setq cpr103 (car (crp001 1)))
          )
            (progn
              (setq cpr104 (append cpr102 cpr103))
              (setq cpr105 (crp015 cpr104))
              (setq cpr106 (cons (nth cpr010 (list "VonLayer" "ByLayer")) (cons (nth cpr010 (list "VonBlock" "ByBlock")) (acad_strlsort cpr105))))
            )
            (progn
              (if (setq cpr107 (tblsearch "LTYPE" "continuous"))
                (setq cpr106 (list (nth cpr010 (list "VonLayer" "ByLayer")) (nth cpr010 (list "VonBlock" "ByBlock")) (cdr (assoc 2 cpr107))))
                (setq cpr106 (list (nth cpr010 (list "VonLayer" "ByLayer")) (nth cpr010 (list "VonBlock" "ByBlock"))))
              )
            )
        )
      cpr106
    )
    (defun crp019 (cpr010 / cpr108 cpr109 cpr110)
      (setq cpr108 (list -1 -2 -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))
        (if (< (getvar "LWUNITS") 1)
          (progn
            (setq cpr109 (list "_bylayer" "_byblock" "_default" "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 cpr110 (list (nth cpr010 (list "VonLayer" "ByLayer")) (nth cpr010 (list "VonBlock" "ByBlock")) (nth cpr010 (list "Vorgabe" "Default")) "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''"))
          )
          (progn
            (setq cpr109 (list "_bylayer" "_byblock" "_default" "0.00" "0.05" "0.09" "0.13" "0.15" "0.18" "0.20" "0.25" "0.30" "0.35" "0.40" "0.50" "0.53" "0.60" "0.70" "0.80" "0.90" "1.00" "1.06" "1.20" "1.40" "1.58" "2.00" "2.11"))
            (setq cpr110 (list (nth cpr010 (list "VonLayer" "ByLayer")) (nth cpr010 (list "VonBlock" "ByBlock")) (nth cpr010 (list "Vorgabe" "Default")) "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"))
          )
        )
      (list cpr110 cpr109 cpr108)
    )
    (defun crp020 (cpr015 cpr016 / cpr111 cpr112 cpr113)
      (if
        (and
          (= (type cpr015) 'STR)
          (= (type cpr016) 'LIST)
        )
          (setq cpr111 (crp016 cpr016 'STR))
      )
      (if cpr111
        (progn
          (setq cpr112 cpr111)
            (while cpr112
              (setq cpr113 (cons (strcase (car cpr112)) cpr113))
              (setq cpr112 (cdr cpr112))
            )
            (if (member (strcase cpr015) cpr113)
              (list (car (crp017 (list cpr015) cpr111)) (vl-position (strcase cpr015) (reverse cpr113)))
              nil
            )
        )
        nil
      )
    )
    (defun crp021 (cpr017 cpr018 / cpr117 cpr114 cpr115 cpr116)
      (setq cpr114 (strlen cpr017))
        (if (> cpr114 cpr018)
          (progn
            (setq cpr115 (substr cpr017 1 (/ (- cpr018 3) 2)))
            (setq cpr116 (substr cpr017 (- cpr114 (1- (/ (- cpr018 3) 2)))))
            (setq cpr117 (strcat cpr115 "\056\056\056" cpr116))
          )
        )
        (if cpr117
          cpr117
          cpr017
        )
    )
    (defun crp022 (cpr019 cpr010 / cpr118 cpr119 cpr120 cpr121 cpr123 cpr124 cpr125 cpr126)
      (setq cpr118 (nth (atoi (get_tile "pl_01")) cpr019))
      (setq cpr119 (entget (tblobjname "LAYER" cpr118)))
        (if (assoc 430 cpr119)
          (setq cpr120 (assoc 430 cpr119))
          (progn
            (if (assoc 420 cpr119)
              (setq cpr120 (assoc 420 cpr119))
              (setq cpr120 (cons 62 (abs (cdr (assoc 62 cpr119)))))
            )
          )
        )
        (if (setq cpr121 (acad_truecolordlg (last acm0720231changeproperties) T cpr120))
          (progn
            (setq acm0720231changeproperties (crp029 cpr121))
            (setq cpr123 (abs (cdr (assoc 62 cpr121))))
              (if
                (and
                  (> cpr123 0)
                  (< cpr123 256)
                )
                  (progn
                    (if (assoc 430 cpr121)
                      (setq cpr124 (substr (cdr (assoc 430 cpr121)) (+ 2 (vl-string-search "$" (cdr (assoc 430 cpr121))))))
                      (progn
                        (if (assoc 420 cpr121)
                          (progn
                            (setq cpr125 (cdr (assoc 420 cpr121)))
                            (setq cpr124 (strcat (itoa (lsh (fix cpr125) -16)) "," (itoa (lsh (lsh (fix cpr125) 16) -24)) "," (itoa (lsh (lsh (fix cpr125) 24) -24))))
                          )
                          (progn
                            (if (< cpr123 8)
                              (setq cpr124 (nth (1- cpr123) (nth cpr010 (list (list "Rot" "Gelb" "Grün" "Cyan" "Blau" "Magenta" "Weiß") (list "Red" "Yellow" "Green" "Cyan" "Blue" "Magenta" "White")))))
                              (setq cpr124 (strcat (nth cpr010 (list "Farbe " "Color ")) (itoa cpr123)))
                            )
                          )
                        )
                      )
                    )
                  )
              )
              (if (= cpr123 256)
                (progn
                  (setq cpr124 (nth cpr010 (list "VonLayer" "ByLayer")))
                  (setq cpr126 (nth (atoi (get_tile "pl_01")) cpr019))
                  (setq cpr127 (entget (tblobjname "LAYER" cpr126)))
                  (setq cpr123 (abs (cdr (assoc 62 cpr127))))
                )
              )
              (if (= cpr123 0)
                (progn
                  (setq cpr124 (nth cpr010 (list "VonBlock" "ByBlock")))
                  (setq cpr123 7)
                )
              )
            (set_tile "t_01" (crp021 cpr124 21))
            (start_image "ib_01")
            (fill_image 0 0 (dimx_tile "ib_01") (dimy_tile "ib_01") cpr123)
            (end_image)
          )
        )
    )
    (defun crp023 (cpr010 cpr011 / cpr128 cpr129 cpr134 cpr135 cpr136 cpr140 cpr141 cpr142 cpr143 cpr144 cpr145 cpr146 cpr147 cpr123 cpr124 cpr125 cpr126 cpr127 cpr118 cpr119 cpr148 cpr149)
        (if (setq cpr128 (crp011 cpr010 cpr011))
          (progn
            (setq cpr129 (load_dialog cpr128))
              (if (not (new_dialog "changeprop" cpr129))
                (exit)
              )
            (vl-catch-all-apply 'vl-file-delete (list cpr128))
              (if (not (vl-position acm0720232changeproperties (list "0" "1")))
                (setq acm0720232changeproperties "0")
              )
              (if (not (vl-position acm0720233changeproperties (list "0" "1")))
                (setq acm0720233changeproperties "0")
              )
              (if (not (vl-position acm0720234changeproperties (list "0" "1")))
                (setq acm0720234changeproperties "0")
              )
              (if (not (vl-position acm0720235changeproperties (list "0" "1")))
                (setq acm0720235changeproperties "0")
              )
            (set_tile "d_01" (nth cpr010 (list "Eigenschaften wählen" "Select Properties")))
              (if (= cpr011 1)
                (set_tile "t_02" (crp033 (list 9 11 4 8 17 8 4 16 5 10 10 5 22 15 12 12 10 14 18 22 2 11 6 13 1 7 5 22 1 11 19 22 8 11 6 12 20 7 5 13 1 3 1 4 21 4 5)))
              )
            (setq cpr134 (crp014))
            (setq cpr135 (crp018 cpr010))
            (setq cpr136 (crp019 cpr010))
              (if
                (and
                  (= acm0720232changeproperties "0")
                  (= acm0720233changeproperties "0")
                  (= acm0720234changeproperties "0")
                  (= acm0720235changeproperties "0")
                )
                  (mode_tile "b_02" 1)
              )
              (if
                (not
                  (and
                    (= (type acm0720236changeproperties) 'STR)
                    (crp020 acm0720236changeproperties cpr134)
                  )
                )
                  (setq acm0720236changeproperties (getvar "CLAYER"))
              )
              (if
                (not
                  (and
                    (= (type acm0720237changeproperties) 'STR)
                    (crp020 acm0720237changeproperties cpr135)
                  )
                )
                  (setq acm0720237changeproperties (nth cpr010 (list "VonLayer" "ByLayer")))
              )
              (if (not (vl-position acm0720238changeproperties (list -1 -2 -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)))
                (setq acm0720238changeproperties -1)
              )
            (start_list "pl_01")
            (mapcar 'add_list cpr134)
            (end_list)
            (set_tile "pl_01" (itoa (cadr (crp020 acm0720236changeproperties cpr134))))
            (start_list "pl_02")
            (mapcar 'add_list cpr135)
            (end_list)
            (set_tile "pl_02" (itoa (cadr (crp020 acm0720237changeproperties cpr135))))
            (start_list "pl_03")
            (mapcar 'add_list (car cpr136))
            (end_list)
            (set_tile "pl_03" (itoa (vl-position acm0720238changeproperties (list -1 -2 -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))))
              (if (not (= (type acm0720231changeproperties) 'LIST))
                (setq acm0720231changeproperties '((62 . 256)))
              )
            (setq cpr140 acm0720231changeproperties)
            (setq cpr141 acm0720236changeproperties)
            (setq cpr142 acm0720237changeproperties)
            (setq cpr143 acm0720238changeproperties)
            (setq cpr144 acm0720232changeproperties)
            (setq cpr145 acm0720233changeproperties)
            (setq cpr146 acm0720234changeproperties)
            (setq cpr147 acm0720235changeproperties)
            (setq cpr123 (abs (cdr (assoc 62 acm0720231changeproperties))))
              (if
                (and
                  (> cpr123 0)
                  (< cpr123 256)
                )
                  (progn
                    (if (assoc 430 acm0720231changeproperties)
                      (setq cpr124 (substr (cdr (assoc 430 acm0720231changeproperties)) (+ 2 (vl-string-search "$" (cdr (assoc 430 acm0720231changeproperties))))))
                      (progn
                        (if (assoc 420 acm0720231changeproperties)
                          (progn
                            (setq cpr125 (cdr (assoc 420 acm0720231changeproperties)))
                            (setq cpr124 (strcat (itoa (lsh (fix cpr125) -16)) "," (itoa (lsh (lsh (fix cpr125) 16) -24)) "," (itoa (lsh (lsh (fix cpr125) 24) -24))))
                          )
                          (progn
                            (if (< cpr123 8)
                              (setq cpr124 (nth (1- cpr123) (nth cpr010 (list (list "Rot" "Gelb" "Grün" "Cyan" "Blau" "Magenta" "Weiß") (list "Red" "Yellow" "Green" "Cyan" "Blue" "Magenta" "White")))))
                              (setq cpr124 (strcat (nth cpr010 (list "Farbe " "Color ")) (itoa cpr123)))
                            )
                          )
                        )
                      )
                    )
                  )
              )
              (if (= cpr123 256)
                (progn
                  (setq cpr124 (nth cpr010 (list "VonLayer" "ByLayer")))
                  (setq cpr126 (nth (atoi (get_tile "pl_01")) cpr134))
                  (setq cpr127 (entget (tblobjname "LAYER" cpr126)))
                  (setq cpr123 (abs (cdr (assoc 62 cpr127))))
                )
              )
              (if (= cpr123 0)
                (progn
                  (setq cpr124 (nth cpr010 (list "VonBlock" "ByBlock")))
                  (setq cpr123 7)
                )
              )
            (set_tile "t_01" (crp021 cpr124 21))
            (start_image "ib_01")
            (fill_image 0 0 (dimx_tile "ib_01") (dimy_tile "ib_01") cpr123)
            (end_image)
            (set_tile "tg_01" acm0720232changeproperties)
            (set_tile "tg_02" acm0720233changeproperties)
            (set_tile "tg_03" acm0720234changeproperties)
            (set_tile "tg_04" acm0720235changeproperties)
              (if (= acm0720232changeproperties "0")
                (foreach cpr164 (list "b_01" "ib_01" "t_01")
                  (mode_tile cpr164 1)
                )
              )
              (if (= acm0720233changeproperties "0")
                (mode_tile "pl_01" 1)
              )
              (if (= acm0720234changeproperties "0")
                (mode_tile "pl_02" 1)
              )
              (if (= acm0720235changeproperties "0")
                (mode_tile "pl_03" 1)
              )
            (action_tile "b_01" "(crp022 cpr134 cpr010)")
            (action_tile "ib_01" "(crp022 cpr134 cpr010)")
              (action_tile "pl_01" "(if (equal acm0720231changeproperties (list (cons 62 256)))
                    (progn
                      (setq cpr118 (nth (atoi $value) cpr134))
                      (setq cpr119 (entget (tblobjname \"LAYER\" cpr118)))
                      (setq cpr148 (abs (cdr (assoc 62 cpr119))))
                      (start_image \"ib_01\")
                      (fill_image 0 0 (dimx_tile \"ib_01\") (dimy_tile \"ib_01\") cpr148)
                      (end_image)
                    )
                  )
                (setq acm0720236changeproperties (nth (atoi $value) cpr134))"
              )
              (action_tile "tg_01" "(if (< (setq acm0720232changeproperties (atoi $value)) 1)
                    (progn
                      (mode_tile \"b_01\" 1)
                      (mode_tile \"ib_01\" 1)
                      (mode_tile \"t_01\" 1)
                    )
                    (progn
                      (mode_tile \"b_01\" 0)
                      (mode_tile \"ib_01\" 0)
                      (mode_tile \"t_01\" 0)
                    )
                  )
                (if
                  (and
                    (= acm0720232changeproperties 0)
                    (= (atoi (get_tile \"tg_02\")) 0)
                    (= (atoi (get_tile \"tg_03\")) 0)
                    (= (atoi (get_tile \"tg_04\")) 0)
                  )
                    (mode_tile \"b_02\" 1)
                    (mode_tile \"b_02\" 0)
                )"
              )
              (action_tile "tg_02" "(if (< (setq acm0720233changeproperties (atoi $value)) 1)
                  (mode_tile \"pl_01\" 1)
                  (progn
                    (mode_tile \"pl_01\" 0)
                    (mode_tile \"pl_01\" 2)
                  )
                )
                (if
                  (and
                    (= (atoi (get_tile \"tg_01\")) 0)
                    (= acm0720233changeproperties 0)
                    (= (atoi (get_tile \"tg_03\")) 0)
                    (= (atoi (get_tile \"tg_04\")) 0)
                  )
                    (mode_tile \"b_02\" 1)
                    (mode_tile \"b_02\" 0)
                )"
              )
              (action_tile "tg_03" "(if (< (setq acm0720234changeproperties (atoi $value)) 1)
                  (mode_tile \"pl_02\" 1)
                  (progn
                    (mode_tile \"pl_02\" 0)
                    (mode_tile \"pl_02\" 2)
                  )
                )
                (if
                  (and
                    (= (atoi (get_tile \"tg_01\")) 0)
                    (= (atoi (get_tile \"tg_02\")) 0)
                    (= acm0720234changeproperties 0)
                    (= (atoi (get_tile \"tg_04\")) 0)
                  )
                    (mode_tile \"b_02\" 1)
                    (mode_tile \"b_02\" 0)
                )"
              )
              (action_tile "tg_04" "(if (< (setq acm0720235changeproperties (atoi $value)) 1)
                  (mode_tile \"pl_03\" 1)
                  (progn
                    (mode_tile \"pl_03\" 0)
                    (mode_tile \"pl_03\" 2)
                  )
                )
                (if
                  (and
                    (= (atoi (get_tile \"tg_01\")) 0)
                    (= (atoi (get_tile \"tg_02\")) 0)
                    (= (atoi (get_tile \"tg_03\")) 0)
                    (= acm0720235changeproperties 0)
                  )
                    (mode_tile \"b_02\" 1)
                    (mode_tile \"b_02\" 0)
                )"
              )
              (action_tile "b_02" "(setq acm0720236changeproperties (nth (atoi (get_tile \"pl_01\")) cpr134))
                (setq acm0720237changeproperties (nth (atoi (get_tile \"pl_02\")) cpr135))
                (setq acm0720238changeproperties (nth (atoi (get_tile \"pl_03\")) (list -1 -2 -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)))
                (setq acm0720232changeproperties (get_tile \"tg_01\"))
                (setq acm0720233changeproperties (get_tile \"tg_02\"))
                (setq acm0720234changeproperties (get_tile \"tg_03\"))
                (setq acm0720235changeproperties (get_tile \"tg_04\"))
                (setq cpr149 (list acm0720232changeproperties acm0720233changeproperties acm0720234changeproperties acm0720235changeproperties acm0720231changeproperties acm0720236changeproperties acm0720237changeproperties acm0720238changeproperties))
                (done_dialog)"
              )
              (action_tile "b_03" "(setq acm0720231changeproperties cpr140)
                (setq acm0720236changeproperties cpr141)
                (setq acm0720237changeproperties cpr142)
                (setq acm0720238changeproperties cpr143)
                (setq acm0720232changeproperties cpr144)
                (setq acm0720233changeproperties cpr145)
                (setq acm0720234changeproperties cpr146)
                (setq acm0720235changeproperties cpr147)
                (setq cpr149 nil)
                (done_dialog)"
              )
            (start_dialog)
            (unload_dialog cpr129)
          )
        )
      cpr149
    )
    (defun crp024 (cpr020 / cpr150 cpr151 cpr048 cpr152 cpr153 cpr154)
      (setq acm0720231changeproperties (setq cpr020 (crp029 cpr020)))
      (setq cpr150 (length cpr020))
        (if (= cpr150 1)
          (progn
            (setq cpr151 (cdr (assoc 62 cpr020)))
              (if (= cpr151 0)
                (setq cpr048 (list "_color" "_ByBlock"))
              )
              (if (= cpr151 256)
                (setq cpr048 (list "_color" "_ByLayer"))
              )
              (if (vl-position cpr151 (list 1 2 3 4 5 6 7))
                (setq cpr048 (list "_color" (nth (1- cpr151) (list "_red" "_yellow" "_green" "_cyan" "_blue" "_magenta" "_white"))))
              )
              (if (not cpr048)
                (setq cpr048 (list "_color" (itoa cpr151)))
              )
          )
        )
        (if (= cpr150 2)
          (progn
            (setq cpr151 (cdr (assoc 420 cpr020)))
            (setq cpr151 (list (lsh (fix cpr151) -16)(lsh (lsh (fix cpr151) 16) -24)(lsh (lsh (fix cpr151) 24) -24)))
            (setq cpr048 (list "_color" "_truecolor" (strcat (itoa (car cpr151)) "\054" (itoa (cadr cpr151)) "\054" (itoa (caddr cpr151)))))
          )
        )
        (if (= cpr150 3)
          (progn
            (setq cpr151 (cdr (assoc 430 cpr020)))
            (setq cpr152 (vl-string-search "$" cpr151))
            (setq cpr153 (substr cpr151 1 cpr152))
            (setq cpr154 (substr cpr151 (+ cpr152 2)))
            (setq cpr048 (list "_color" "_colorbook" cpr153 cpr154))
          )
        )
      cpr048
    )
    (defun crp025 (cpr021 / cpr048)
        (if (vl-position (strcase cpr021) (list "BYLAYER" "VONLAYER"))
          (setq cpr048 (list "_ltype" "_ByLayer"))
        )
        (if (vl-position (strcase cpr021) (list "BYBLOCK" "VONBLOCK"))
          (setq cpr048 (list "_ltype" "_ByBlock"))
        )
        (if (not cpr048)
          (progn
            (if (not (tblsearch "LTYPE" cpr021))
              (progn
                (crp008 (vla-get-ActiveDocument (vlax-get-acad-object)))
                (crp010 cpr021)
              )
            )
            (if (tblsearch "LTYPE" cpr021)
              (setq cpr048 (list "_ltype" cpr021))
              (setq cpr048 nil)
            )
          )
        )
      cpr048
    )
    (defun crp026 (cpr022 / cpr108 cpr048)
      (setq cpr108 (list -1 -2 -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))
        (if (= (getvar "LWUNITS") 0)
          (setq cpr048 (list "_lweight" (nth (vl-position cpr022 cpr108) (list "_bylayer" "_byblock" "_default" "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 cpr048 (list "_lweight" (nth (vl-position cpr022 cpr108) (list "_bylayer" "_byblock" "_default" "0.00" "0.05" "0.09" "0.13" "0.15" "0.18" "0.20" "0.25" "0.30" "0.35" "0.40" "0.50" "0.53" "0.60" "0.70" "0.80" "0.90" "1.00" "1.06" "1.20" "1.40" "1.58" "2.00" "2.11"))))
        )
      cpr048
    )
    (defun crp027 (cpr023 / cpr108 cpr048)
      (list "_layer" cpr023)
    )
    (defun crp028 (cpr024 cpr025 / cpr155 cpr064)
        (if (= (nth 3 cpr025) "1")
          (setq cpr155 (cons (crp026 (nth 7 cpr025)) cpr155))
        )
        (if (= (nth 2 cpr025) "1")
          (setq cpr155 (cons (crp025 (nth 6 cpr025)) cpr155))
        )
        (if (= (nth 1 cpr025) "1")
          (setq cpr155 (cons (crp027 (nth 5 cpr025)) cpr155))
        )
        (if (= (nth 0 cpr025) "1")
          (setq cpr155 (cons (crp024 (nth 4 cpr025)) cpr155))
        )
      (vl-cmdf "._chprop" cpr024 "")
        (while cpr155
          (setq cpr064 (car cpr155))
            (while cpr064
              (vl-cmdf (car cpr064))
              (setq cpr064 (cdr cpr064))
            )
          (setq cpr155 (cdr cpr155))
        )
      (vl-cmdf "")
    )
    (defun crp029 (cpr026 / )
      (if
        (and
          (= (length cpr026) 3)
          (not (vl-string-search "AUTOCAD" (strcase (getvar "PRODUCT"))))
        )
          (progn
            (alert "ACHTUNG: Es wird die RGB-Entsprechung der gewählten Farbbuch-Farbe verwendet.")
            (list (car cpr026) (cadr cpr026))
          )
          cpr026
      )
    )
  (defun crp030 ( / cpr156 cpr157 cpr158)
    (prompt "\nMit ACM-EIGAENDER zu bearbeitende Objekte wählen ... ")
      (if
        (and
          (setq cpr156 (ssget "_:L"))
          (setq cpr157 (crp023 0 (crp034 202402)))
        )
          (progn
            (setq cpr158 (getvar "CMDECHO"))
            (setvar "CMDECHO" 0)
            (crp028 cpr156 cpr157)
            (setvar "CMDECHO" cpr158)
          )
      )
  )
    (defun crp012 ( / cpr159)
      (setq cpr159 (strcase (getvar "PRODUCT")))
        (if
          (and
            (= cpr159 "AUTOCAD")
            (getvar "HPDRAWORDER")
          )
            (setq cpr086 T)
            (setq cpr086 nil)
        )
        (if (not cpr086)
          (alert "\042acm-eigaender\042 kann nur unter AutoCAD ab Version 2005 verwendet werden.")
        )
      cpr086
    )
    (defun crp031 (cpr027 / )
        (if cpr162 (setq *error* cpr162))
        (if cpr158
          (vl-catch-all-apply 'setvar (list "CMDECHO" cpr158))
        )
      (vla-EndUndoMark (vla-get-ActiveDocument (vlax-get-acad-object)))
      (princ)
    )
    (defun crp032 (cpr028 / )
      (substr "aAcdefgiIlnorsTuv?:@. " cpr028 1)
    )
    (defun crp033 (cpr029 / cpr160)
      (setq cpr160 "")
        (while cpr029
          (setq cpr160 (strcat cpr160 (crp032 (car cpr029))))
          (setq cpr029 (cdr cpr029))
        )
      cpr160
    )
    (defun crp034 (cpr030 / cpr161)
      (setq cpr161 (crp033 (list 3 4 1 15 5)))
        (if (< (atoi (substr (rtos (getvar cpr161) 2 0) 1 6)) cpr030)
          0
          1
        )
    )
  (if (crp012)
    (progn
      (vl-load-com)
      (setq cpr073 (vla-get-ActiveDocument (vlax-get-acad-object)))
      (setq cpr162 *error*)
      (setq *error* crp031)
      (vla-EndUndoMark cpr073)
      (vla-StartUndoMark cpr073)
      (crp030)
        (if cpr162
          (setq *error* cpr162)
          (setq *error* nil)
        )
      (vla-EndUndoMark cpr073)
    )
  )
  (princ)
)
(terpri)
(princ "\nAutoLISP-Tool ACM-EIGAENDER (Copyright © 2023 Gerhard Rampf) geladen.")
(princ "\nRufen Sie den Befehl mit ACM-EIGAENDER auf.")
