463 lines
14 KiB
Common Lisp
463 lines
14 KiB
Common Lisp
;............................................................
|
|
;: 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 " ")
|
|
) ;R�ckschalten
|
|
(IF (> (- llen lpos) 0)
|
|
(GRTEXT (1+ mlen) "Next ")
|
|
(GRTEXT (1+ mlen) " ")
|
|
) ;Vorw„rtsschalten
|
|
(IF (= (CAR (SETQ antw (GRREAD))) 4)
|
|
(IF (< (CADR antw) mlen)
|
|
;wenn g�ltige 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)
|