워킹맘
[2008.03.21] CAD_도로중심선 그리는 Lisp
메모장에 복사해서 .LSP확장자바꿔서 쓰시면됩니다..
명령어는D이고 폴리라인 두개를선택하면 중심선이 생깁니다..
----------------------------------------------------------
(defun dtr (a)
(* pi (/ a 180.0)))
(defun rtd (a)
(/ (* a 180.0) pi))
(defun dxf(code elist)
(cdr (assoc code elist)))
(defun vtxs12(ent / ptlist)
(setq ent (entnext ent))
(while (= "VERTEX" (cdr (assoc 0 (entget ent))))
(setq ptlist (cons (cdr (assoc 10 (entget ent))) ptlist)
ent (entnext
ent)
);if
);while
ptlist
)
(defun vtxs14(ent / ptlist s1 count)
(setq count 0)
(repeat (length ent)
(setq s1 (nth count ent))
(if (= 10 (car s1))
(setq ptlist (cons (cdr s1) ptlist)))
(setq count (1+ count))
)
ptlist
)
(defun pl_length(ent / count pt1 pt2 ll)
(setq count 0 ll 0.0)
(repeat (1- (length ent))
(setq pt1 (nth count ent))
(setq pt2 (nth (1+ count) ent))
(setq ll (+ ll (distance pt1 pt2)))
(setq count (1+ count))
)
ll
)
(defun nearpt(pt1 ent / count pt2 l_short l_long mx my)
(setq count 0 l_short 32000.0)
(repeat (length ent)
(setq l_long (distance pt1 (nth count ent)))
(if (> l_short l_long)
(progn
(setq l_short l_long)
(setq pt2 (nth count ent))
)
)
(setq count (1+ count))
)
(princ "\n Original Road # : ")
(princ pt1)(terpri)
(princ "\n Center Road # : ")
(princ pt2)(terpri)
(setq mx (/ (+ (car pt1) (car pt2)) 2))
(setq my (/ (+ (cadr pt1) (cadr pt2)) 2))
(setq pt2 (list mx my 0.0))
pt2
)
(defun polyline(ent / osm pt n)
(setq osm (getvar "osmode"))
(setvar "osmode" 0)
(setvar "cmdecho" 0)
(setq n 0)
(command "pline")
(while (nth n ent)
(setq pt (nth n ent))
(command pt)
(setq n (1+ n))
)
(command)
(setvar "cmdecho" 1)
(setvar "osmode" osm)
(princ)
)
(defun orthopt(pt1 pt2 / osm len rads opt1 opt2 pt_list)
(setq osm (getvar "osmode"))
(setvar "osmode" 0)
(setvar "cmdecho" 0)
(setq pt_list ())
(setq len (distance pt1 pt2))
(setq rads (angle pt1 pt2))
(setq opt1 (polar pt1 (+ rads 1.59) len))
(setq opt2 (polar pt1 (- rads 1.59) len))
(setq pt_list (cons opt1 pt_list))
(setq pt_list (cons opt2 pt_list))
(setvar "cmdecho" 1)
(setvar "osmode" osm)
(princ)
pt_list
)
(defun c:d( / fob sob fo_list so_list fob_lst sob_lst pt_lst ll sob_new_list)
(setq fob (entsel "\n first pline : "))
(if fob (command "chprop" fob "" "c" "yellow" ""))
(setq sob (entsel "\n second pline : "))
(if sob (command "chprop" sob "" "c" "yellow" ""))
(setq fo_list (entget (car fob)))
(setq so_list (entget (car sob)))
;(setq sl (dxf 8 fo_list))
(command "-layer" "s" AD002 "")
(if (= "LWPOLYLINE" (dxf 0 fo_list))
(setq fob_lst (vtxs14 fo_list))
(setq fob_lst (vtxs12 (dxf -1 fo_list)))
)
(if (= "LWPOLYLINE" (dxf 0 so_list))
(setq sob_lst (vtxs14 so_list))
(setq sob_lst (vtxs12 (dxf -1 so_list)))
)
(setq fob_ll (pl_length
fob_lst))
(princ "\n First Length : ")
(princ fob_ll)(terpri)
(setq sob_ll (pl_length sob_lst))
(princ "\n Second Length : ")
(princ sob_ll)(terpri)
(if (> (length sob_lst) (length fob_lst))
(progn
(setq pt_lst fob_lst)
(setq fob_lst sob_lst)
(setq sob_lst
pt_lst)
)
)
(setq count 0)
(setq sob_new_list ())
(repeat (length fob_lst)
(setq pt1 (nth count fob_lst))
(setq pt_new (nearpt pt1 sob_lst))
(setq sob_new_list (cons pt_new sob_new_list))
(setq count (1+ count))
)
(polyline sob_new_list)
(setq sob_new_list nil)
(princ)
)
---------------------------------------중심선넣는리습입니다..