도로 중심선 리습 - dolo jungsimseon liseub

워킹맘

[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)
)

---------------------------------------중심선넣는리습입니다..