neue Folder LAYOUT MENU und MODULE dazu
This commit is contained in:
+564
@@ -0,0 +1,564 @@
|
||||
;............................................................
|
||||
;: 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 " ")
|
||||
) ;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 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 g�ltige 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)
|
||||
|
||||
Reference in New Issue
Block a user