Files
Walz/MENU/DINLAY.LSP
T

118 lines
4.7 KiB
Common Lisp

(prompt "\nLade Layergruppen ")
(setvar "cmdecho" 0)
(prompt ".")
(defun gy2 (ln ly / du d2)(if (/= ln "")
(setq ln (strcat ln "-")))(setq du (searc "-" ly) len (strlen ly))(if (= du 0)
(setq du (strcat ln ly)) (setq d2 (- len du) du (strcat ln (substr ly (+ 1 du) d2) )))
(setq du du))
(prompt ".")
(defun gs2 ( ly / ct la du le l2)(if (/= ly "")
(setq ly (strcat ly "-")))
(setq ct (- (length v-lay) 1))(while (>= ct 0)(setq la (nth ct v-lay) du (searc "-" la) le (strlen la))(if (= du 0)
(setq l2 (cons (strcat ly la) l2))
(setq du2 (- le du) l2 (cons (strcat ly (substr la (+ 1 du) du2)) l2) ))(setq ct (- ct 1)))(setq v-lay l2 l2 nil))
(prompt ".")
(defun layles ( tx / ly)
(setq ly nil *error* g_er)(while (= ly nil)
(setq ly (strcase (getstring tx)))
(if (> (strlen ly) 8)
(progn
(prompt "\nError: Max. 5 Zeichen erlaubt !")
(setq ly nil))
)
(if (> (searc "-" ly) 0)
(progn
(prompt "\nError: Nicht erlaubt!")(setq ly nil))))
(setq ly ly))
(prompt ".")
(defun gyd ( tx / ly l1 l4 l5)
(setq ly nil *error* g_er)(while (= ly nil)
(PROMPT tx)(SETQ l1 (GRREAD))(if (= (CAR l1) 12)
(SETQ l1 (GRREAD)))
(cond
((= (CAR l1) 3)(progn (SETQ l4 (ssget (nth 1 l1))) (if (/= l4 nil)
(PROGN
(SETQ l5 (ENTGET (SSNAME l4 0)) ly (CDR (ASSOC 8 l5)))
(if (= (searc "-" ly) 0) (progn (prompt "\nBasis Layergruppe")(setq ly "")) (setq ly (substr ly 1 (- (searc "-" ly) 1))) ) ))))
((equal l1 '(2 13))(progn (prompt "\nBasis Layergruppe")(setq ly "")))((= (CAR l1) 2)(progn (SETQ l4 (nth 1 l1) l5 (GETSTRING (CHR l4)) ly (STRCAT (CHR l4) l5) )))((equal l1 '(6 0))(progn (prompt "\nGrundlayergruppe")(setq ly ""))))
(if (> (strlen ly) 8)(progn (prompt "\nError: Max. 5 Zeichen erlaubt !")(setq ly nil)))
(if (> (searc "-" ly) 0)(progn (prompt "\nError: No - allowed !")(setq ly nil))))
(prompt (strcat "\nNeue Layergruppe: " ly))
(setq ly ly))(prompt ".")
(defun c:layset ( / ly )
(g_sv)
(setq ly (gyd "\nSetzen der Layergruppe: (Tastatur/Objekt) "))
(gs2 ly)
(command "_LAYER" "_SET" (nth 0 v-lay) "")
(princ)
)
(prompt ".")
(Defun C:layaus ( / ly vr du la dy)
(g_sv)
(setq ly (gyd "\nWelche Layergruppe frieren ? (Tastatur/Objekt) ") vr (getvar "regenmode") la (getvar "clayer") du (searc "-" la))(cond((and (= ly "")(/= du 0))
(progn
(setq ct (- (length v-lay) 1) dy "")
(while (>= ct 0)
(setq dy (strcat dy "," (substr (nth ct v-lay) (+ du 1))) ct (- ct 1)))
(command "_REGENAUTO" "_on" "_LAYER" "_FR" (substr dy 2) "")))((and (/= ly "")(/= (strcat ly "-") (substr la 1 du)))
(command "_REGENAUTO" "_on" "_LAYER" "_FR" (strcat ly "-*") "_off" (strcat ly "-*") ""))
((prompt "\nError: Can not freeze active Layer !")))(setvar "regenmode" vr)(princ))(prompt ".")
(Defun C:layein ( / ly vr ct la)
(setvar "cmdecho" 0)(setq *error* g_er)(setq ly (layles "\nTauen Layergruppe:") vr (getvar "regenmode") la (getvar "clayer") du (searc "-" la))
(cond((= ly "")
(progn
(setq ct (- (length v-lay) 1) dy "")
(while (>= ct 0)
(setq dy (strcat dy "," (substr (nth ct v-lay) (+ du 1))))
(setq ct (- ct 1)) )
(command "_REGENAUTO" "_on" "_LAYER" "_T" (substr dy 2) "")))
((command "_REGENAUTO" "_on" "_LAYER" "_T" (strcat ly "-*") "_on" (strcat ly "-*") "")))(setvar "regenmode" vr)(princ))
(prompt ".")
(defun C:laymach ( / ly vr ct)(g_sv)
(setq ly (layles "\nAktivieren der Layergruppe:")
vr (getvar "regenmode")
)
(gs2 ly)
(setq ct (- (length v-lay) 1))
(command "_REGENAUTO" "_off" "_LAYER")
(while (>= ct 0)
(command "_M" (nth ct v-lay) "_co" (nth ct v-col) "" "_LT" (nth ct v-ltyp) "")
(setq ct (- ct 1)))
(command "")
(setvar "regenmode" vr)
(princ))
(prompt ".")
(defun C:laywe ( / du la ct s1 ly ln el)
(g_sv)
(setq s1 nil)(gc)
(setq s1 (ssget))
(if (= s1 nil)
(prompt "\nError: keine Objekte gefunden !")
(progn
(setq la (gyd "\nSchiebe auf die Layergruppe: (Tastatur/Object) "))
(setq ct -1)
(prompt "\nObject:")
(repeat (sslength S1) (setq el (entget (ssname S1 (setq ct (1+ ct))))) (setq ly (cdr (assoc 8 el)) ln (gy2 la ly)
du (cdr (assoc 0 el)) )(if (or (= du "POLYLINE") (= du "INSERT")) (command "_change" (cdr (assoc -1 el)) "" "_LA" ln ) (entmod
(subst (cons 8 ln)(assoc 8 el) el) )) (prompt (strcat " " (itoa ct) " ")))(princ))))
(defun C:laylist ( / lis ly lg du ad)(g_sv)
(prompt "\nLayergroups:")
(setq lis nil lis (cons "0" lis))
(setq ly (cdr (assoc 2 (tblnext "LAYER" T))))
(while (/= ly nil) (setq i (searc "-" ly))
(if (> i 0)
(progn
(setq lg (substr ly 1 (- i 1)))
(setq ad T)(foreach du lis (progn (if (= lg du)(setq ad nil) )))
(if (= ad T)
(progn(prompt (strcat "\n" lg))(setq lis (cons lg lis))))))
(setq ly (cdr (assoc 2 (tblnext "LAYER")))))(princ))(princ)