(defun deterr (s)
(princ (strcat “n” s ” “))
(setvar “blipmode” 0)
(command “layer” “s” lay “”)
(command “color” col)
(command “linetype” “s” lty “”)
(setvar “osmode” os_mode)
(if (= mov 1) (command “erase” s1 s2 s3 s4 “”))
(setq *error* olderr col nil lty nil)
(princ)
)
;
(defun make_l ()
(setq ps (trans (cdr (assoc 10 ent)) 0 1)
pe (trans (cdr (assoc 11 ent)) 0 1)
pp1 (list (car p2) (cadr p1))
pp2 (list (car p1) (cadr p2))
pnt (list (list))
p1x (car p1) p1y (cadr p1)
p2x (car p2) p2y (cadr p2)
psx (car ps) psy (cadr ps)
pex (car pe) pey (cadr pe)
)
(if (and (> psx p1x) (< psx p2x) (> psy p1y) (< psy p2y))
(setq pnt (append pnt (list ps))))
(if (and (> pex p1x) (< pex p2x) (> pey p1y) (< pey p2y))
(setq pnt (append pnt (list pe))))
(setq pint (inters p1 pp1 ps pe))
(if (/= pint nil) (setq pnt (append pnt (list pint))))
(setq pint (inters pp1 p2 ps pe))
(if (/= pint nil) (setq pnt (append pnt (list pint))))
(setq pint (inters p2 pp2 ps pe))
(if (/= pint nil) (setq pnt (append pnt (list pint))))
(setq pint (inters pp2 p1 ps pe))
(if (/= pint nil) (setq pnt (append pnt (list pint))))
(if (> (length pnt) kdg)
(progn
(setq ps (nth 1 pnt) pe (nth 2 pnt))
(command “line” (list (+ (car ps) mx) (+ (cadr ps) my))
(list (+ (car pe) mx) (+ (cadr pe) my)) “”)
)
)
);end of make_l
;;;;;;;;
(defun make_a ()
(setq as (cdr (assoc 50 ent))
ae (cdr (assoc 51 ent))
pc (trans (cdr (assoc 10 ent)) 0 1)
r (cdr (assoc 40 ent))
ps (polar pc as r) pe (polar pc ae r)
pcx (car pc) pcy (cadr pc)
psx (car ps) psy (cadr ps)
pex (car pe) pey (cadr pe)
pnt (list (list))
)
(if (and (> psx p1x) (< psx p2x) (> psy p1y) (< psy p2y))
(setq pnt (append pnt (list ps))))
(if (and (> pex p1x) (< pex p2x) (> pey p1y) (< pey p2y))
(setq pnt (append pnt (list pe))))
(setq y (- pcy p1y))
(setq x (- (expt r 2) (expt y 2)))
(if (> x kde)
(progn
(setq x (sqrt x))
(if (and (> (- pcx x) p1x) (< (- pcx x) p2x))
(progn (setq p0 (list (- pcx x) p1y)) (pnt_ck))
)
(if (and (< (+ pcx x) p2x) (> (+ pcx x) p1x))
(progn (setq p0 (list (+ pcx x) p1y)) (pnt_ck))
)
)
)
(setq x (- pcx p2x))
(setq y (- (expt r 2) (expt x 2)))
(if (> y kdf)
(progn
(setq y (sqrt y))
(if (and (> (- pcy y) p1y) (< (- pcy y) p2y))
(progn (setq p0 (list p2x (- pcy y))) (pnt_ck))
)
(if (and (< (+ pcy y) p2y) (> (+ pcy y) p1y))
(progn (setq p0 (list p2x (+ pcy y))) (pnt_ck))
)
)
)
(setq y (- pcy p2y))
(setq x (- (expt r 2) (expt y 2)))
(if (> x kdf)
(progn
(setq x (sqrt x))
(if (and (< (+ pcx x) p2x) (> (+ pcx x) p1x))
(progn (setq p0 (list (+ pcx x) p2y)) (pnt_ck))
)
(if (and (> (- pcx x) p1x) (< (- pcx x) p2x))
(progn (setq p0 (list (- pcx x) p2y)) (pnt_ck))
)
)
)
(setq x (- pcx p1x))
(setq y (- (expt r 2) (expt x 2)))
(if (> y kde)
(progn
(setq y (sqrt y))
(if (and (< (+ pcy y) p2y) (> (+ pcy y) p1y))
(progn (setq p0 (list p1x (+ pcy y))) (pnt_ck))
)
(if (and (> (- pcy y) p1y) (< (- pcy y) p2y))
(progn (setq p0 (list p1x (- pcy y))) (pnt_ck))
)
)
)
(setq pok (list (list))
pntx pok
len0 (- (length pnt) 2)
lenr len0
n 1
)
(repeat len0
(setq pnt1 (nth n pnt))
(rp_ck)
(setq pok (append pok (list pnto))
pnt pntx
pntx (list (list))
n 1
lenr (1- lenr)
)
)
(setq pok (append pok (list (nth 1 pnt))))
(setq pnt pok)
(setq len0 (- (length pnt) 2))
(setq n kdf)
(repeat len0
(setq n (1+ n))
(setq ps (nth n pnt))
(setq pe (nth (1+ n) pnt))
(draw_ac)
)
);end of make_a
;;;;;;;;
(defun pnt_ck ()
(setq ang (angle pc p0))
(if (< as ae)
(if (and (> ang as) (< ang ae)) (setq pnt (append pnt (list p0))))
)
(if (> as ae)
(if (or (> ang as) (< ang ae)) (setq pnt (append pnt (list p0))))
)
)
;;;;;;;;
(defun rp_ck ()
(if (< as ae)
(repeat lenr
(setq pnt2 (nth (1+ n) pnt))
(if (< (angle pc pnt1) (angle pc pnt2))
(setq pnto pnt1 pntx (append pntx (list pnt2)))
(setq pnto pnt2 pntx (append pntx (list pnt1)))
)
(setq pnt1 pnto)
(setq n (1+ n))
)
(repeat lenr
(setq pnt2 (nth (1+ n) pnt))
(setq p10 (- (angle pc pnt1) as) p20 (- (angle pc pnt2) as))
(if (< p10 0) (setq p10 (+ (dtr 360) p10)))
(if (< p20 0) (setq p20 (+ (dtr 360) p20)))
(if (< p10 p20)
(setq pnto pnt1 pntx (append pntx (list pnt2)))
(setq pnto pnt2 pntx (append pntx (list pnt1)))
)
(setq pnt1 pnto)
(setq n (1+ n))
)
)
);end of rp_ck
;;;;;;;;
(defun co_li ()
(command “layer” “s” (cdr (assoc 8 ent)) “”)
(setq co (assoc 62 ent))
(if (boundp ‘co) (setq co (itoa (cdr co))) (setq co “bylayer”))
(command “color” co)
(setq li (assoc 6 ent))
(if (boundp ‘li) (setq li (cdr li)) (setq li “bylayer”))
(command “linetype” “s” li “”)
)
;;;;;;;;
(defun make_c ()
(setq pc (trans (cdr (assoc 10 ent)) 0 1)
r (cdr (assoc 40 ent))
pcx (car pc)
pcy (cadr pc)
y (- pcy p1y)
x (- (expt r 2) (expt y 2))
pnt (list (list))
)
(if (> x kde)
(progn
(setq x (sqrt x))
(if (and (> (- pcx x) p1x) (< (- pcx x) p2x))
(setq pnt (cons (list (- pcx x) p1y) pnt)))
(if (and (< (+ pcx x) p2x) (> (+ pcx x) p1x))
(setq pnt (cons (list (+ pcx x) p1y) pnt)))
)
)
(setq x (- pcx p2x))
(setq y (- (expt r 2) (expt x 2)))
(if (> y kdf)
(progn
(setq y (sqrt y))
(if (and (> (- pcy y) p1y) (< (- pcy y) p2y))
(setq pnt (cons (list p2x (- pcy y)) pnt)))
(if (and (< (+ pcy y) p2y) (> (+ pcy y) p1y))
(setq pnt (cons (list p2x (+ pcy y)) pnt)))
)
)
(setq y (- pcy p2y))
(setq x (- (expt r 2) (expt y 2)))
(if (> x kdf)
(progn
(setq x (sqrt x))
(if (and (< (+ pcx x) p2x) (> (+ pcx x) p1x))
(setq pnt (cons (list (+ pcx x) p2y) pnt)))
(if (and (> (- pcx x) p1x) (< (- pcx x) p2x))
(setq pnt (cons (list (- pcx x) p2y) pnt)))
)
)
(setq x (- pcx p1x))
(setq y (- (expt r 2) (expt x 2)))
(if (> y kde)
(progn
(setq y (sqrt y))
(if (and (< (+ pcy y) p2y) (> (+ pcy y) p1y))
(setq pnt (cons (list p1x (+ pcy y)) pnt)))
(if (and (> (- pcy y) p1y) (< (- pcy y) p2y))
(setq pnt (cons (list p1x (- pcy y)) pnt)))
)
)
(setq pnt (reverse pnt))
(setq len0 (- (length pnt) 1))
(setq n kde)
(while n
(setq n (1+ n))
(setq ps (nth n pnt))
(if (= n len0)
(setq pe (nth 1 pnt) n nil)
(setq pe (nth (1+ n) pnt))
)
(draw_ac)
)
);end of make_c
;;;;;;;;
(defun draw_ac ()
(if (/= (last pnt) nil)
(progn
(setq ch (polar ps (+ (angle pc ps) (dtr 90)) 0.01))
(setq chx (car ch) chy (cadr ch))
(if (and (> chx p1x) (> chy p1y) (< chx p2x) (< chy p2y))
(command “arc” “c” (list (+ pcx mx) (+ pcy my))
(list (+ (car ps) mx) (+ (cadr ps) my))
(list (+ (car pe) mx) (+ (cadr pe) my)))
)
)
(setq n nil)
)
)
;;;;;;;;
(defun c:detail ( / ssa ssc ssw sww col lty)
(setq olderr *error* *error* deterr n_klj “klisp14.lsp”)
(setq os_mode (getvar “osmode”))
(setvar “cmdecho” 0) (setvar “osmode” 0)
(setvar “blipmode” 0) (setvar “orthomode” 0)
(setq lay (getvar “clayer”) col (getvar “cecolor”) lty (getvar “celtype”))
(setq e 0 fi_na “c:\mddraw14\dtl.clr” ff_op (open fi_na “r”)
clr (read-line ff_op))
(close ff_op)
(prot_mi)
(while e (initget 1 “c”)
(setq p1 (getpoint “DETAIL: Color/
(cond ((or (= p1 “C”) (= p1 “c”))
(col_dlg (atoi clr) nil) (setq clr (itoa cdata))
(write_data fi_na clr))
(T (setq e nil))
)
)
(initget (1+ 32))
(setq p2 (getcorner p1 “nOpposite point: “)
p1x (car p1)
p1y (cadr p1)
p2x (car p2)
p2y (cadr p2)
ssa (ssadd)
ssc (ssget “c” p1 p2)
sww (ssadd)
ssw (ssget “w” p1 p2)
n -1
len (sslength ssc)
)
(if (> p1x p2x) (setq p0 p1x p1x p2x p2x p0))
(if (> p1y p2y) (setq p0 p1y p1y p2y p2y p0))
(setq p1 (list p1x p1y) p2 (list p2x p2y))
(repeat len
(setq n (1+ n)
en (ssname ssc n)
ent (entget en)
na (cdr (assoc 8 ent))
)
(if (and (/= na “DIMLINE”) (/= na “DIMENSION”) (/= na “ARROW”))
(if (= ssw nil)
(ssadd en ssa)
(if (= (ssmemb en ssw) nil) (ssadd en ssa))
)
)
(if (= (rem n 50) 0) (prompt “.”))
)
(setq mov 1 gre 0 mov_as aib)
(while gre
(command “line” p1 (list (car p2) (cadr p1)) “”)
(setq s1 (entlast))
(command “line” (list (car p2) (cadr p1)) p2 “”)
(setq s2 (entlast))
(command “line” p2 (list (car p1) (cadr p2)) “”)
(setq s3 (entlast))
(command “line” (list (car p1) (cadr p2)) p1 “”)
(setq s4 (entlast))
(prompt “nLocation point: “)
(command “move” s1 s2 s3 s4 “” p1) (command pause)
(setq grchk (car (grread t)))
(if (/= grchk 5) (command “erase” s1 s2 s3 s4 “”) (setq gre nil))
)
(setq mov nil)
(setq pm (trans (cdr (assoc 10 (entget s1))) 0 1))
(command “chprop” s1 s2 s3 s4 “” “c” clr “lt” “phant6” “”)
(if (/= ssw nil)
(progn
(setq n -1 len (sslength ssw))
(repeat len
(setq n (1+ n))
(setq en (ssname ssw n))
(setq ent (entget en))
(setq na (cdr (assoc 8 ent)))
(if (and (/= na “DIMLINE”) (/= na “DIMENSION”) (/= na “ARROW”))
(ssadd en sww))
(if (= (rem n 50) 0) (prompt “.”))
)
(if (> (sslength sww) 0) (command “copy” sww “” p1 pm))
)
)
(setq len (sslength ssa)
mx (- (car pm) p1x)
my (- (cadr pm) p1y)
nn -1
)
(repeat len
(setq nn (1+ nn))
(setq ent (entget (ssname ssa nn)))
(co_li)
(setq na (cdr (assoc 0 ent)))
(cond ((= na “CIRCLE”) (make_c))
((= na “ARC”) (make_a))
((= na “LINE”) (make_l))
)
(if (= (rem nn 50) 0) (prompt “.”))
)
(command “color” col)
(command “linetype” “s” lty “”)
(setq x (/ (- p2x p1x) 2) y (/ (- p2y p1y) 2))
(setq p0 (list (+ (car pm) x) (+ (cadr pm) y)))
(setq sca (getreal “nEnter scale<1>: “))
(prot_mk)
(if (= sca nil) (setq sca 1))
(if (/= sca 1)
(progn
(setq pm1 (list (+ (car p0) x) (+ (cadr p0) y)))
(command “scale” “c” pm pm1 “” p0 sca)
)
)
(command “layer” “s” lay “”)
(command “color” col)
(command “linetype” “s” lty “”)
(setvar “osmode” os_mode)
(setq *error* olderr)
(princ)
)
===============================================================
r14에서 사용하던 리습인데 이 리습만 2005에 추가 하려고요 수정 부탁드립니다 ^^