;Place Culvert Xing profile ellipses, select: Align, inv1, inv2, inters.
;	Author:
;		Henry C. Francis
;		425 N. Ashe St.
;		Southern Pines, NC 28387
;	http://www.pinehurst.net/~pfrancis
;	e-mail hfrancis@pinehurst.net
;	All rights reserved.
(defun c:xing ( / align_ent inv1_ptblk inv2_ptblk nxt_ent1 ins_ent1 ins_pt1 elev_ent1 sub2_ent1 sub3_ent1
nxt_ent2 ins_ent2 ins_pt2 elev_ent2 sub2_ent2 sub3_ent2 clvrt_len clvrt_slope seg_len inters_inv
v_next pline_ent begin_v end_v cur_sta count last_mh_sta ell_top ell_inv ell_side
)
(setq mjrg "C"
      ltyp "-"
      prod "STRM"
      colr "6"
      modf "EXST"
)
(c:svlayr)
(c:mklayr)
(COMMAND "._MSPACE")
  (IF
    (setq align_ent (nentselp "\nSelect Alignment at crossing point. "))
    (PROGN
      (while
        (not
          (setq inv1_ptblk (nentselp "\nSelect 1st Invert's SDSK point. "))
        )
      )
      (while
        (not
          (setq inv2_ptblk (nentselp "\nSelect 2nd Invert's SDSK point. "))
        )
      )
      (if
        (and align_ent 
             inv1_ptblk 
             inv2_ptblk
             (eq
               (cdr(assoc 0 (entget(car inv1_ptblk))))
               "ATTRIB"
             )
        )
        (progn
          (setq nxt_ent1 (entget(entnext(car inv1_ptblk))))
          (while
            (not
              (eq (cdr(assoc 0 nxt_ent1)) "SEQEND")
            )
            (setq nxt_ent1 (entget(entnext(cdr(assoc -1 nxt_ent1)))))
          )
          (setq ins_ent1 (cdr(assoc -2 nxt_ent1))
                ins_pt1 (cdr(assoc 10(entget ins_ent1)))
                elev_ent1 (cdr(assoc 1 (entget(entnext ins_ent1))))
                sub2_ent1 (cdr(assoc 1 (entget(entnext(entnext ins_ent1)))))      ;Point number
                sub3_ent1 (cdr(assoc 1 (entget(entnext(entnext(entnext ins_ent1))))))      ;Point description
          )
        )
      );if
      (princ (strcat "\nPoint No. " sub2_ent1 ", Desc.: " sub3_ent1 ", Elev.: " elev_ent1))
      (setq elev_ent1 (rtos(+(ureal 1 "" "1st Invert vertical offset (in feet, 0 for none): " 0)(atof elev_ent1))))
      (if
        (eq
          (cdr(assoc 0 (entget(car inv2_ptblk))))
          "ATTRIB"
        )
        (progn
          (setq nxt_ent2 (entget(entnext(car inv2_ptblk))))
          (while
            (not
              (eq (cdr(assoc 0 nxt_ent2)) "SEQEND")
            )
            (setq nxt_ent2 (entget(entnext(cdr(assoc -1 nxt_ent2)))))
          )
          (setq ins_ent2 (cdr(assoc -2 nxt_ent2))
                ins_pt2 (cdr(assoc 10(entget ins_ent2)))
                elev_ent2 (cdr(assoc 1(entget(entnext ins_ent2))))
                sub2_ent2 (cdr(assoc 1(entget(entnext(entnext ins_ent2)))))      ;Point number
                sub3_ent2 (cdr(assoc 1(entget(entnext(entnext(entnext ins_ent2))))))      ;Point description
          )
        )
      );if
      (princ (strcat "\nPoint No. " sub2_ent2 ", Desc.: " sub3_ent2 ", Elev.: " elev_ent2))
      (setq elev_ent2 (rtos(+(ureal 1 "" "2nd Invert vertical offset (0 for none): " 0)(atof elev_ent2))))
      (setq ins_pt1     (list(car ins_pt1)(cadr ins_pt1))
            ins_pt2     (list(car ins_pt2)(cadr ins_pt2))
            clvrt_len   (distance ins_pt1 ins_pt2)
            clvrt_slope (/(-(atof elev_ent1)(atof elev_ent2))clvrt_len)
            clvrt_size  (ureal 1 "" "\nCulvert Diameter (in feet): " clvrt_size)
            seg_len     (distance
                            ins_pt1
                            (list(caadr align_ent)(cadadr align_ent))
                        )
            inters_inv  (-(atof elev_ent1)(* seg_len clvrt_slope))
            v_next      (entget(car align_ent))
      )
      (IF (EQ (CDR (ASSOC 0 v_next)) "VERTEX")
        (PROGN
          (WHILE (EQ (CDR (ASSOC 0 v_next)) "VERTEX")
    	(PROGN (SETQ v_next (ENTGET (ENTNEXT (CDAR v_next)))))
          ) ;_ end of WHILE
          (SETQ pline_ent (ENTGET (CDR (ASSOC -2 v_next)))
    	    v_next    (ENTGET (ENTNEXT (CDAR pline_ent)))
    	    begin_v   (CDR (ASSOC 10 v_next))
    	    end_v     begin_v
    	    cur_sta   0
    	    count     (FIX -1)
          ) ;_ end of SETQ
          (WHILE (NOT (EQ (CDAR v_next) (CAR align_ent)))
    	(SETQ end_v   (CDR (ASSOC 10 v_next))
    	      cur_sta (+ cur_sta (DISTANCE begin_v end_v))
    	      begin_v end_v
    	      v_next  (ENTGET (ENTNEXT (CDAR v_next)))
    	) ;_ end of SETQ
    	(PRINC "\n")
    	(PRINC (RTOS cur_sta))
          ) ;_ end of WHILE
          (setq end_v (CDR (ASSOC 10 v_next))
                cur_sta (+ cur_sta (DISTANCE begin_v end_v))
          )
          (PRINC "\n")
          (PRINC (RTOS cur_sta))
          (SETQ begin_v end_v
                v_next  (ENTGET (ENTNEXT (CDAR v_next)))
                end_v (CDR (ASSOC 10 v_next))
                last_mh_sta cur_sta
                cur_sta (+ cur_sta (distance begin_v (cadr align_ent)))
          )
        )
        (princ "\nPolyline NOT selected. ")
      )
      (princ "\nLast MH Station:      ")
      (princ last_mh_sta)
      (princ "\nCulvert Station:      ")
      (princ cur_sta)
      (princ "\nCulvert Length:       ")
      (princ clvrt_len)
      (princ "\nCulvert Slope:        ")
      (princ clvrt_slope)
      (princ "\nIntersection Invert:  ")
      (princ inters_inv)
      (princ)
      (setq ell_inv (list cur_sta (* 10 inters_inv))
            ell_top (polar ell_inv (/ pi 2) (* clvrt_size 10))
            ell_side (/ clvrt_size 2)
      )
      (command "._ellipse" ell_inv ell_top ell_side)
      (PRINC)
    )
    (PRINC "Function cancelled  ")
  )
  (c:rslayr)
  (PRINC)
)