;............................................................
;:      DATE : 92-01-01    Kunde: tewi                      :
;:      Autor: Schmidt     AutoCAD-Version 11               :
;:      Version 1.1        ab Version 10 mit anpassen       :
;:                                                          :
;:      LAYM14.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 laymanag (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 "\nObjekt wählen\n"))  
           (PRINC (STRCAT "\nElement ist auf Layer " akly))
         )
      )
      ((= sele 3)
         (IF (SETQ akly (alay "\nZiel-Ebene wählen\n"))
           (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 "\nObjekt auf dem Ziel-Ebene wählen\n"))
              (COMMAND "_COPY" elem "" "@" "@" "_CHANGE" elem "" "_PROP" "_LA" akly "")
              (emsg "Kein Layer gewählt! ")
            )
            (emsg "Kein Objekt gewählt! ")
         )
      )
      ((= sele 5)
         (IF (SETQ elem (ssget))
            (IF (SETQ akly (alay "\nObjekt auf dem Ziel-Ebene wählen\n"))
              (COMMAND "_CHANGE" elem "" "_PROP" "_LA" akly "")
              (emsg "Kein Layer gewählt")
            )
            (emsg "Kein Objekt gewählt")
         )
      )
      ((= sele 6)
         (IF (SETQ akly (alay "\nZu änderndes Objekt wählen\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 von "
                               (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 "Kein Layer gewählt")
                  )
               )
            )
            (emsg "Kein Object gewählt")
         )
      )
      ((= sele 7)
         (IF (SETQ akly (alay "\nDie zu ändernden Objekte wählen\n"))
            (IF (SETQ elem (alel akly NIL))
               (IF (SETQ akly (alay "Objekt auf der Ziel-Ebene wählen\n"))
                  (PROGN
                     (zoal)
                     (ared elem 3)
                     (IF (ques "Layer für diese Objekte ändern ?" NIL)
                        (COMMAND "_CHANGE" elem "" "_PROP" "_LA" akly "")
                        (ared elem 4)
                     )
                     (zovo)
                  )
                  (emsg "Kein Layer gewählt")
               )
            )
            (emsg "Kein Objekt gewählt")
         )
      )
      ((= sele 8)(lays T))
      ((= sele 9)
         (WHILE (SETQ akly (alay "\nLayer zum Ausblenden\n"))
            (IF (ltes akly nil)
               (COMMAND "_LAYER" "_OFF" akly "")
            )
         )
      )
      ((= sele 10)(lays NIL))
      ((= sele 11)
         (WHILE (SETQ akly (alay "\nLayer FRIEREN\n"))
            (IF (ltes akly nil)
               (COMMAND "_LAYER" "_FR" akly "")
            )
         )
      )
      ((= sele 12)
         (SETQ clay (alay "\nObjekt auf dem aktiven Layer der aktiv bleibt wählen\n"))
         (COMMAND "_LAYER" "_SET" clay "_FR" "*" "")
      )
   )
   (IF (NOT runm)
      (pend)
   )
)

(PRINC)
(PRINC "\n      Layermanager loaded")
(PRINC)
