;............................................................
;:      DATE : 92-01-01    Kunde: tewi                      :
;:      Autor: Schmidt     AutoCAD-Version 11               :
;:      Version 1.1        ab Version 10 mit anpassen       :
;:                                                          :
;:      LAYM.LSP           Layer-Manager                    :
;:..........................................................:

(SPECIAL '(grp))

(DEFUN zoal ()                            ;Zoom af
    (SETQ vsiz (GETVAR "VIEWSIZE"))
    (COMMAND "_ZOOM" "_V")
)

(DEFUN zovo ()                            ;Zoom vorher, wenn m”glich
    (IF (/= (GETVAR "VIEWSIZE") vsiz)
       (COMMAND "_ZOOM" "_P")
    )
)

(DEFUN mdis (/ mlau)
   (SETQ mlau 26)
   (GRTEXT 0  "LAY-MAN")
   (GRTEXT 1  "        ")
   (GRTEXT 2  "   ?   ")
   (GRTEXT 3  " SET    ")
   (GRTEXT 4  "COPY GR.")
   (GRTEXT 5  "MOVE GR.")
   (GRTEXT 6  "MOVE EL ")
   (GRTEXT 7  "MOVE ALL")
   (GRTEXT 8  "ON LAYER")
   (GRTEXT 9  "OFF LAYR")
   (GRTEXT 10 "TAU LAY.")
   (GRTEXT 11 "FR LAYER")
   (GRTEXT 12 "FR ALL  ")
   (GRTEXT 13 "DEL LAY.")
   (GRTEXT 14 "LAY.SELE")
   (GRTEXT 15 "        ")
   (GRTEXT 16 "        ")
   (GRTEXT 17 "        ")
   (GRTEXT 18 "        ")
   (GRTEXT 19 "        ")
   (GRTEXT 20 "        ")
   (GRTEXT 21 "        ")
   (GRTEXT 22 "        ")
   (GRTEXT 23 "        ")
   (GRTEXT 24 "        ")
   (GRTEXT 25 "        ")
   (WHILE (< mlau mlen)
      (GRTEXT mlau "        ")
      (SETQ mlau (1+ mlau))
   )
)
(DEFUN ssgad (nset gset / slau seln)      ;SSET zu SSET addieren
    (SETQ slau 0)
    (IF (NULL (EVAL (READ gset)))(SET (READ gset)(SSADD)))
    (WHILE (SETQ seln (SSNAME nset slau))
        (SSADD seln (EVAL (READ gset)))
        (REDRAW seln 3)
        (SETQ slau (1+ slau))
    )
)

(DEFUN ared (aset ltyp / asla asna)        ;Ausleuchten von Elementen.
    (SETQ asla 0)
    (WHILE (SETQ asna (SSNAME aset asla))
        (REDRAW asna ltyp)
        (SETQ asla (1+ asla))
    )
)

(DEFUN alay (txt)                          ;Layername filtern
   (IF (SETQ akel (ENTSEL txt))
      (CDR (ASSOC '8 (ENTGET (CAR akel))))
   )

)

(defun alel (tele elna)                    ;Elemente filtern
   (IF elna
      (SSGET "X" (LIST (CONS '0 elna)(CONS '8 tele)))
      (SSGET "X" (LIST (CONS '8 tele)))
   )
)

(DEFUN lann (nwna ngna)                          ;Layer new name
   (STRCAT (SUBSTR nwna 1 1) ngna (SUBSTR nwna 4))
)

(DEFUN laqu (/ lach)                              ;Layer Gruppenname
    (SETQ lach "-"
          last (SUBSTR (STRCASE (GETSTRING "Group-Letter: <_> ")) 1 2)
          last (COND
                  ((= (STRLEN last) 2) last)
                  ((= (STRLEN last) 1) (STRCAT last lach))
                  ( T                  (STRCAT lach lach))
               )
    )
)

(DEFUN ltes (tlay grou)                     ;ausschalt Kontrolle
   (IF (OR (AND (= (SUBSTR (GETVAR "CLAYER") 2 2) tlay) grou)
           (AND (= (GETVAR "CLAYER") tlay) (NOT grou))
       )
          (emsg "change first active layer")
          T
   )
)

(DEFUN layl (/ lext ltan)                     ;Layerliste
   (SETQ ltan  T)
   (WHILE (SETQ lext (TBLNEXT "LAYER" ltan))
      (SETQ laex (CONS (CONS (CDADR lext) (CDDR lext)) laex)
            ltan NIL
      )
   )
)

(DEFUN ldis (/ run lauf llen)                             ;Layer am Seitenmenu anz.
  (SETQ run  T
        lauf 0
        llen (LENGTH clis)
  )
  (WHILE run
     (WHILE (< lauf mlen)
        (IF (< lpos llen)
           (GRTEXT lauf (NTH lpos clis))
           (GRTEXT lauf "        ")
        )                                  ;Menuanzeige
        (SETQ lauf (1+ lauf)
              lpos (1+ lpos)
        )
                        ;um 1 erh”hen
     )
     (IF (> lpos mlen)
         (GRTEXT mlen "Prev. ")
         (GRTEXT mlen "      ")
     )                                    ;Rckschalten
     (IF (> (- llen lpos) 0)
         (GRTEXT (1+ mlen) "Next  ")
         (GRTEXT (1+ mlen) "       ")
     )                                    ;Vorw„rtsschalten
     (IF (= (CAR (SETQ antw (GRREAD))) 4)
        (IF (< (CADR antw) mlen)
                        ;wenn gltige Antwort
           (IF (> (SETQ antw (+ (CADR antw)(- lpos lauf))) llen)
              (SETQ antw NIL run NIL)
              (SETQ run NIL
                    lpos (IF (= (- lpos mlen) (1- llen))
                             (- lpos mlen mlen)
                             (- lpos mlen)
                         )
              )
           )
           (COND
              ((AND (= (CADR antw) mlen)(> lpos mlen))
                           ;Vorher
                   (SETQ lpos (- lpos mlen mlen)
                         lauf 0
                   )
              )
              ((AND (= (CADR antw) (1+ mlen))(> llen lpos))
                            ;N„chst
                    (SETQ lauf 0)
              )
              (T    (emsg "False Field !"))
           )
        )
        (SETQ antw NIL run NIL)
     )
  )
)

(DEFUN lays (ein / clis lpos laex antw atly akly llau lcom)         ;Layer schalten
   (SETQ lpos 0)
   (layl)
   (IF ein
      (FOREACH xpos laex
         (IF (MINUSP (CDR (ASSOC 62 (CDR xpos))))
             (SETQ clis (CONS (CAR xpos) clis))
         )
      )
      (FOREACH xpos laex
         (IF (= (CDR (ASSOC 70 (CDR xpos))) 65)
             (SETQ clis (CONS (CAR xpos) clis))
         )
      )
   )
   (WHILE clis
      (PRINC "\nSelect Layer from the Screen Menu: ")
      (ldis)
      (IF antw
          (SETQ atly (NTH antw clis)
                akly (CONS atly akly)
                clis (APPEND (REVERSE (CDR (MEMBER atly (REVERSE clis))))
                                (CDR (MEMBER atly clis))
                     )
          )
          (SETQ clis NIL)
      )
   )
   (IF akly
      (PROGN
         (SETQ llau 0
               lcom (IF ein "_ON" "_T")
         )
         (PRINC "\n\nPlease wait ...")
         (COMMAND "_LAYER")
         (REPEAT (LENGTH akly)
            (COMMAND  lcom (NTH llau akly))
            (SETQ llau (1+ llau))
         )
         (COMMAND "")
      )
      (emsg "Nothing selected!")
   )
)

(DEFUN laye (/ lacg lauf lant)              ;Layer neuer Auswahlsatz
   (SETQ lacg (SSLENGTH chgr)
         lauf 0
   )
   (REPEAT lacg
      (IF (NOT (MEMBER (SETQ lant (CDR (ASSOC 8 (ENTGET
                                          (SSNAME chgr lauf))))) lanl))
          (SETQ lanl (CONS lant lanl))
      )
      (SETQ lauf (1+ lauf))
   )
)

(DEFUN layc (/ lall lauf lane linf laco nlna chel laol nwel)            ;Layer change
   (SETQ lall (LENGTH lanl)
         lauf 0
   )
   (REPEAT lall
      (IF (NOT (ASSOC (lann (NTH lauf lanl) last) laex))
          (SETQ lane (CONS (NTH lauf lanl) lane))
      )
      (SETQ lauf (1+ lauf))
   )
   (SETQ lall (LENGTH lane)
         lauf 0
   )
   (REPEAT lall
      (SETQ linf (CDR (ASSOC (NTH lauf lane) laex))
            laco (IF (MINUSP (SETQ lico (CDR (ASSOC 62 linf))))(ABS lico) lico)
            nlna (lann (NTH lauf lane) last)
      )
      (COMMAND "_LAYER" "_N" nlna "_CO" lico nlna "LT" (CDR (ASSOC 6 linf)) nlna "")
      (SETQ lauf (1+ lauf))
   )
   (SETQ lall (SSLENGTH chgr)
         lauf 0
   )
   (REPEAT lall
      (SETQ chel (ENTGET (SSNAME chgr lauf))
            laol (ASSOC 8 chel)
            nwel (SUBST (CONS 8 (lann (CDR laol) last)) laol chel)
      )
      (ENTMOD nwel)
      (SETQ lauf (1+ lauf))
   )
)

(DEFUN lgrn (cona / lpos lgri clis lnwn lnaw lsta ltmp lntp ldtp lddb last)                         ;Layer Gruppenmanipulationen
  (SETQ lpos 0)
  (layl)
  (FOREACH xpos laex
     (IF (SETQ lgri (SUBSTR (CAR xpos) 2 2))
        (IF clis
           (IF (NOT (MEMBER lgri clis))
              (SETQ clis (CONS lgri clis))
           )
           (SETQ clis (LIST lgri))
        )
     )
  )
  (IF clis
     (PROGN
        (PRINC "\nSelect group from the Screen Menu: ")
        (ldis)
        (IF antw
           (PROGN
              (SETQ lnwn (STRCAT "?" (NTH antw clis) "*"))
              (COND
                 ((= cona "_OFF")
                   (IF (ltes (NTH antw clis) T)
                      (COMMAND "_LAYER" "_OFF" lnwn "")
                   )
                 )
                 ((= cona "DEL")
                    (SETQ lnaw (NTH antw clis)
                          lsta T
                    )
                    (zoal)
                    (WHILE (SETQ ltmp (TBLNEXT "LAYER" lsta))
                       (IF (= (SUBSTR (SETQ lntp (CDR (ASSOC 2 ltmp))) 2 2) lnaw)
                          (IF (SETQ ldtp (SSGET "X" (LIST (CONS 8 lntp))))
                             (ssgad ldtp "lddb")
                          )
                       )
                       (SETQ lsta NIL)
                    )
                    (IF lddb
                       (IF (ques "Delete this Elements?" NIL)
                          (COMMAND "_ERASE" lddb "")
                          (ared lddb 4)
                       )
                    )
                    (zovo)
                 )
                 ((= cona "WAHL")
                    (SETQ lnaw (NTH antw clis)
                          lsta T
                    )
                    (WHILE (SETQ ltmp (TBLNEXT "LAYER" lsta))
                       (IF (= (SUBSTR (SETQ lntp (CDR (ASSOC 2 ltmp))) 2 2) lnaw)
                          (IF (SETQ ldtp (SSGET "X" (LIST (CONS 8 lntp))))
                             (ssgad ldtp "lddb")
                          )
                       )
                       (SETQ lsta NIL)
                    )
                    (IF lddb
                       (PROGN
                          (PRINC "\nThis Elements are now saved as !GRP")
                          (PRINC "\nPress any key to continue...")
                          (GRREAD)
                          (SETQ grp lddb)
                          (ared lddb 4)
                       )
                       (emsg "No elements found..!")
                    )
                 )
                 (T (COMMAND "_LAYER" cona lnwn ""))
              )
           )
           (emsg "Nothing selected!")
        )
     )
  )
)

(DEFUN lay (sele layn /  vsiz elem elet akna akel akly clay lanl last)    ;Hauptprogramm
   (IF (NOT runm)
      (pstart "Layer - Manager" "" '(("REGENMODE")))
   )
   (COND
      ((= sele 2)
         (IF (SETQ akly (alay "\nSelect element"))  
           (PRINC (STRCAT "\nElement is on Layer " akly))
         )
      )
      ((= sele 3)
         (IF (SETQ akly (alay "\nSelect target-Layer: "))
           (PROGN
             (COMMAND "_LAYER" "_SET" akly "")
             (SETQ cavar (SUBST (CONS "CLAYER"  akly)
                              (ASSOC '"CLAYER" cavar) cavar)
             )
           )
         )
      )
      ((= sele 4)
         (IF (SETQ elem (ssget))
            (IF (SETQ akly (alay "\nSelect object on the target layer: "))
              (COMMAND "_COPY" elem "" "@" "@" "_CHANGE" elem "" "_PROP" "_LA" akly "")
              (emsg "Kein Layer gew„hlt! ")
            )
            (emsg "Kein Element gew„hlt! ")
         )
      )
      ((= sele 5)
         (IF (SETQ elem (ssget))
            (IF (SETQ akly (alay "\nSelect object on the target layer: "))
              (COMMAND "_CHANGE" elem "" "_PROP" "_LA" akly "")
              (emsg "No Layer selected! ")
            )
            (emsg "No object selected! ")
         )
      )
      ((= sele 6)
         (IF (SETQ akly (alay "\nSelect object to alter:\n"))
            (PROGN
               (SETQ akna (CDR (ASSOC '0 (ENTGET (CAR akel)))))
               (IF (SETQ elem (alel akly akna))
                  (IF (SETQ akly (alay "Select object on the target layer:\n"))
                     (PROGN
                        (zoal)
                        (ared elem 3)
                        (IF (ques (STRCAT "Layer of this "
                               (COND
                                  ((= akna "LINE")   "Line")
                                  ((= akna "CIRCLE") "Circle")
                                  ((= akna "ARC")    "Arc")
                                  ((= akna "POINT")  "Point")
                                  ((= akna "PLINE")  "Polylie")
                                  ( T                 akna)
                               )
                               " „ndern?") NIL)
                          (COMMAND "_CHANGE" elem "" "_PROP" "_LA" akly "")
                          (ared elem 4)
                        )
                        (zovo)
                     )
                     (emsg "No Layer selected! ")
                  )
               )
            )
            (emsg "No object selected! ")
         )
      )
      ((= sele 7)
         (IF (SETQ akly (alay "\nSelect object on layer:\n"))
            (IF (SETQ elem (alel akly NIL))
               (IF (SETQ akly (alay "Select object on the target layer:\n"))
                  (PROGN
                     (zoal)
                     (ared elem 3)
                     (IF (ques "Change the layer of this objects?" NIL)
                        (COMMAND "_CHANGE" elem "" "_PROP" "_LA" akly "")
                        (ared elem 4)
                     )
                     (zovo)
                  )
                  (emsg "No Layer selected! ")
               )
            )
            (emsg "No object selected! ")
         )
      )
      ((= sele 8)(lays T))
      ((= sele 9)
         (WHILE (SETQ akly (alay "\nselect layer to hide: "))
            (IF (ltes akly nil)
               (COMMAND "_LAYER" "_OFF" akly "")
            )
         )
      )
      ((= sele 10)(lays NIL))
      ((= sele 11)
         (WHILE (SETQ akly (alay "\nselect layer to hide: "))
            (IF (ltes akly nil)
               (COMMAND "_LAYER" "_FR" akly "")
            )
         )
      )
      ((= sele 12)
         (SETQ clay (alay "\nPick object on the layer which remains active "))
         (COMMAND "_LAYER" "_SET" clay "_FR" "*" "")
      )
      ((= sele 13)
         (IF layn
            (SETQ elem (alel layn NIL))
            (WHILE (SETQ akly (alay
                     "\nSelect an object on the layer to delete:\n"))
               (IF (SETQ elet (alel akly NIL))
                  (ssgad elet "elem")
               )
            )
         )
         (IF elem
            (PROGN
               (zoal)
               (ared elem 3)
               (IF (ques "Delete this objects?" NIL)
                  (COMMAND "_ERASE" elem "")
                  (ared elem 4)
               )
               (zovo)
            )
            (emsg "No object selected! ")
         )
      )
      ((= sele 14)
         (IF layn
            (SETQ elem (alel layn NIL))
            (WHILE (SETQ akly (alay
                      "\nSelect object on the layer belonging to the group:\n"))
               (IF (SETQ elet (alel akly NIL))
                  (ssgad elet "elem")
               )
            )
         )
         (IF elem
            (PROGN
               (ared elem 3)
               (PRINC "\This objects are saved as !GRP ")
          
     (PRINC "\npress any key to continue ")
               (GRREAD)
               (GRREAD)
               (SETQ grp elem)
               (ared elem 4)
            )
            (emsg "No object selected! ")
          )
      )
      ((= sele 15)
          (IF layn
             (SETQ last layn)
             (laqu)
          )
          (IF (SETQ chgr (SSGET))
             (PROGN
                (SETVAR "REGENMODE" 0)
                (layl)
                (laye)
                (layc)
             )
          )
      )
      ((= sele 16)(lgrn "AUS"))
      ((= sele 17)(lgrn "EIN"))
      ((= sele 18)(lgrn "FR"))
      ((= sele 19)(lgrn "T"))
      ((= sele 20)(lgrn "DEL"))
      ((= sele 21)(lgrn "WAHL"))
   )
   (IF (NOT runm)
      (pend)
   )
)
(DEFUN C:laym (/ optp runm mlen)         ;Aufruf ber Seitenmenu
   (pstart "Layer - Manager" "" '(("REGENMODE")))
   (GRREAD T)
   (SETQ runm T
         mlen 20
   )
   (WHILE runm
      (PRINC "\nSelect from the Screen-Menu: ")
      (mdis)
      (IF (= (CAR (SETQ optp (GRREAD))) 4) ;wenn gltige Seitenmenueing.
          (IF (AND (> (CADR optp) 1)(< (CADR optp) 22))
              (lay (CADR optp) nil)
              (SETQ runm NIL)
          )
          (SETQ runm NIL)
      )
      (GRREAD T)
   )
   (GRTEXT)
   (pend)
)

(DEFUN C:laqu () (lay 2 nil))         ;Aufruf ber Tablett
(DEFUN C:lase () (lay 3 nil))
(DEFUN C:lacg () (lay 4 nil))
(DEFUN C:lace () (lay 5 nil))
(DEFUN C:lamg () (lay 6 nil))
(DEFUN C:lacl () (lay 7 nil))
(DEFUN C:laei () (lay 8 nil))
(DEFUN C:laau () (lay 9 nil))
(DEFUN C:latl () (lay 10 nil))
(DEFUN C:lafl () (lay 11 nil))
(DEFUN C:lafa () (lay 12 nil))
(DEFUN C:ladl () (lay 13 nil))
(DEFUN C:lawd () (lay 14 nil))
(PRINC)
(PRINC "\n      Layermanager loaded")
(PRINC)
