Jenom pro případ, že baste náhodou vynalézal vynalezené :-)
;--------- ZAKRYJ.LSP Simon Jones Sept 1987
; Toto makro provádí příkaz "_TRIM" na vybraných entitách
; a převádí "odřezky" do speciální hladiny, definované uživatelem.
; Toto může být použito pro hladinu se speciální typ čáry,
; např. pro ilustrování části zakrytého pohledu.
; Pokud vybraná entita neprotíná hranici, je na ní provedena
; "_CHANGE" hladiny - je přesunuta do speciální hladiny.
; Makro spolupracuje pouze s entitami typu ÚSEČKA, OBLOUK a KRUŽNICE.
; Ostatní entity budou ignorovány.
; K ukončení příkazu zadejte nulovou odpověď na výzvu
; k vybrání objektů.
; Funkce ukládající systémové proměnné
(defun MODES (a)
(setq MLST '())
(repeat (length a)
(setq MLST (append MLST (list (list (car a) (getvar (car a))))))
(setq a (cdr a)))
)
; Funkce k nastavení systémových proměnných
(defun MODER ()
(repeat (length MLST)
(setvar (caar MLST) (cadar MLST))
(setq MLST (cdr MLST))
)
)
; Funkce k zpracování oblouků
(defun XARC (/ cen r)
(command "_LAYER" "_S" $ln "")
(setq a (cdr (assoc 50 e1)))
(setq b (cdr (assoc 51 e1)))
(setq cen (cdr (assoc 10 e1)))
(setq r (cdr (assoc 40 e1)))
(command "_TRIM" ss "" (cadr e) "")
(setq e2 (entget (car e)))
(setq c (cdr (assoc 50 e2)))
(setq d (cdr (assoc 51 e2)))
(cond ((equal e1 e2)
(command "_CHANGE" (cdar e1) "" "_P" "_LA" $ln "")
)
((and (equal a c) (/= b d) (equal el (entlast)))
(command "_ARC" (polar cen d r)
"_C" cen
(polar cen b r)
)
)
((and (equal b d) (/= a c) (equal el (entlast)))
(command "_ARC" (polar cen a r)
"_C" cen
(polar cen c r)
)
)
(T
(setq x (cdr (assoc 50 (entget (entlast)))))
(setq y (cdr (assoc 51 (entget (entlast)))))
(cond ((and (equal a c) (equal b y))
(command "_ARC" (polar cen d r)
"_C" cen
(polar cen x r)
)
)
)
)
)
(command "_LAYER" "_S" cl "")
)
; Funkce k zpracování kružnic
(defun XCIRCLE (/ cen r)
(command "_LAYER" "_S" $ln "")
(setq el (entlast))
(setq cen (cdr (assoc 10 e1)))
(setq r (cdr (assoc 40 e1)))
(command "_TRIM" ss "" (cadr e) "")
(setq e2 (entget (car e)))
(cond ((equal e1 e2)
(command "_CHANGE" (cdar e1) "" "_P" "_LA" $ln "")
)
((= (cdr (assoc 0 e2)) "ARC")
(setq r (cdr (assoc 40 e2)))
(setq cen (cdr (assoc 10 e2)))
(setq a (polar cen (cdr (assoc 50 e2)) r))
(setq b (polar cen (cdr (assoc 51 e2)) r))
(command "_ARC" b "_C" cen A)
)
)
(command "_LAYER" "_S" cl "")
)
; Funkce k zpracování úseček
(defun XLINE ()
(command "_LAYER" "_S" $ln "")
(setq a (cdr (assoc 10 e1)))
(setq b (cdr (assoc 11 e1)))
(command "_TRIM" ss "" (cadr e) "")
(setq e2 (entget (car e)))
(setq c (cdr (assoc 10 e2)))
(setq d (cdr (assoc 11 e2)))
(cond ((equal e1 e2)
(command "_CHANGE" (cdar e1) "" "_P" "_LA" $ln "")
)
((and (equal a c) (/= b d) (equal el (entlast)))
(command "_LINE" d b "")
)
((and (equal b d) (/= a c) (equal el (entlast)))
(command "_LINE" a c "")
)
(T
(setq x (cdr (assoc 10 (entget (entlast)))))
(setq y (cdr (assoc 11 (entget (entlast)))))
(cond ((and (equal a c) (equal b y))
(command "_LINE" d x "")
)
)
)
)
(command "_LAYER" "_S" cl "")
)
(defun C:ZAKRYJ2 (/ cen r e el e1 e2 a b c cl d ln ss yn x y)
(modes '("CMDECHO" "BLIPMODE" "HIGHLIGHT"))
(setq cmd (getvar "CMDECHO")
blip (getvar "BLIPMODE")
higl (getvar "HIGHLIGHT")
osm (getvar "OSMODE"))
(setvar "CMDECHO" 0)
(setvar "BLIPMODE" 0)
(setvar "OSMODE" 0)
(setq cl (getvar "CLAYER"))
(PROMPT"\n ")
(SETQ SS1 NILL)
(SETQ SS1 (SSGET "X" '((0 . "LINE"))))
(if ss1 (prompt" ")(SETQ SS1 (SSGET "X" '((0 . "CIRCLE")))))
(if ss1 (prompt" ")(SETQ SS1 (SSGET "X" '((0 . "ARC")))))
(IF SS1
(PROGN
(if (null $ln) (setq $ln cl))
(while (null ln)
(setq ln "SKRYTE")
(if (= ln "") (setq ln $ln))
(if (not (tblsearch "LAYER" ln))
(progn
(setq yn "Ano")
(if (= yn "Ano")
(command "_LAYER" "_M" ln "_C" 2 ln "_L" "Čárkovaná" ln "_S" cl "")
(setq ln nil)
)
)
)
)
(setq $ln ln)
(prompt "\nVyberte hranice ořezání: ")
(setq ss (ssget))
(setvar "HIGHLIGHT" 0)
(setq e (entsel "\nVyberte objekty určené k přemístění na přenosovou hladinu"))
(while e
(setq e1 (entget (car e)))
(setq el (entlast))
(cond ((= (cdr (assoc 0 e1)) "LINE")
(xline)
)
((= (cdr (assoc 0 e1)) "ARC")
(xarc)
)
((= (cdr (assoc 0 e1)) "CIRCLE")
(xcircle)
)
(T (prompt "\nVybrána nevhodná entita. "))
)
(setq e (entsel "\nVyberte entity určené k přemístění na hladinu přenosu:"))
)
)
(PROMPT (strcat " .. NEJSOU VHODNÉ ENTITY VE VÝKRESE !!!!"))
)
(setvar "CMDECHO" cmd)
(setvar "BLIPMODE" blip)
(setvar "HIGHLIGHT" higl)
(setvar "OSMODE" osm)
(moder)
(princ)
)