;;;Output Depth Cut + LF info for MHP generated gravity sewers.
;;;
;;;>	Author:	Henry C. Francis
;;;>		425 N. Ashe St.
;;;>		Southern Pines, NC 28387
;;;>		http://paracadd.com
;;;>		All rights reserved.
;;;
;;;>		COPYRIGHT: 12-20-94
;;;>		   EDITED: 08-18-1999
;;;
(DEFUN C:DC ( / prgp ptg1x ptg1y ptg2x ptg2y pt1)
  (setq dat 0)
  (setq prgp (car (entsel "\nSelect Existing Grade Polyline ")))
  (gpseg)
  (ggseg)
  (gint)
(while endit
(if
  (> pti2x ptg2x)
  (progn
    (setq hdist (- ptg2x xstrt))
    (setq ptb1 (list ptg2x ptg2y))
    (setq ptb2 (list ptg2x (+ 2 ptg2y)))
    (setq fvdis 0)
    (dcdat)
    (ggseg)
    (gint)
  );progn
  (progn
    (setq hdist (- pti2x xstrt))
    (setq ptb1 (list ptg2x ptg2y))
    (setq ptb2 (list ptg2x (+ 2 ptg2y)))
    (setq fvdis 0)
    (dcdat)
    (gpseg)
    (gint)
  );progn
);if
);while
(PRINC)
);defun
;;;;;************************************************
(defun dcdat (/)
    (setq datf (open "-td.dat" "a"))
    (write-line (strcat (rtos hdist)" "(rtos (+ fvdis elfac))) datf)
    (close datf)
    (setq dat (+ dat hdist))
);defun dcdat
;;;;;************************************************
(defun elfad ( / )
(if (> slopg slopi)					;incr depth check
  (setq elfac (+ elfac 20))				;up 2 *10 vert. exageration
  (setq elfac (- elfac 20))				;dn 2 *10 vert. exageration
);if
);defun elfad
;;;;;************************************************
(defun gpseg ( / )
  (setq prpb (car (entsel "\nSelect Pipe Beginning Station Line ")))
  (setq prpi (car (entsel "\nSelect Proposed Pipe Invert Line ")))
  (setq prpe (car (entsel "\nSelect Pipe Ending Station Line ")))
  (setq ptb1 (cdr (assoc 10 (entget prpb))))
  (setq ptb2 (cdr (assoc 11 (entget prpb))))
  (setq pte1 (cdr (assoc 10 (entget prpe))))
  (setq pte2 (cdr (assoc 11 (entget prpe))))
  (setq pti1x
    (car
      (inters ptb1 ptb2
	(cdr (assoc 10 (entget prpi)))
	(cdr (assoc 11 (entget prpi)))nil
      );inters
    );car
  );setq
  (setq pti1y
    (cadr
      (inters ptb1 ptb2
	(cdr (assoc 10 (entget prpi)))
	(cdr (assoc 11 (entget prpi)))nil
      );inters
    );cadr
  );setq
  (setq pti2x
    (car
      (inters pte1 pte2
	(cdr (assoc 10 (entget prpi)))
	(cdr (assoc 11 (entget prpi)))nil
      );inters
    );car
  );setq
  (setq pti2y
    (cadr
      (inters pte1 pte2
	(cdr (assoc 10 (entget prpi)))
	(cdr (assoc 11 (entget prpi)))nil
      );inters
    );cadr
  );setq
  (setq slopi (/(- pti2y pti1y)(- pti2x pti1x)))
);defun gpseg
;;;;;************************************************
(defun ggseg ( / )					;find another
    (if							;ground segment
      (not (eq (cdr (assoc 0 (entget (entnext (entnext prgp))))) "SEQEND"))
      (progn
        (setq prgp (entnext prgp))
	(if ptg1x
	  (progn
	    (setq ptg1x ptg2x)
	    (setq ptg1y ptg2y)
	    (setq ptg2x (car (cdr (assoc 10 (entget (entnext prgp))))))
	    (setq ptg2y (cadr (cdr (assoc 10 (entget (entnext prgp))))))
	  );progn
	  (progn
	    (setq ptg1x (car (cdr (assoc 10 (entget prgp)))))
	    (setq ptg1y (cadr (cdr (assoc 10 (entget prgp)))))
	    (setq ptg2x (car (cdr (assoc 10 (entget (entnext prgp))))))
	    (setq ptg2y (cadr (cdr (assoc 10 (entget (entnext prgp))))))
	  );progn
	);if
	    (setq slopg (/(- ptg2y ptg1y)(- ptg2x ptg1x)))
	    (setq pt1 (inters ptb1 ptb2
		  (list ptg1x ptg1y)			;ground point at
		  (list ptg2x ptg2y)nil))		;starting station
	(setq vdist					;
		(-(cadr pt1)				;depth of cover
		(cadr(inters ptb1 ptb2			;at start
		(list pti1x pti1y)
		(list pti2x pti2y)nil)))
	);setq
	(setq xstrt (car pt1))				;set start x value
	(if (> slopg slopi)					;incr depth check
	  (setq elfac (*(fix(/(+ (/ vdist 10) 2)2))20))		;up 2 *10 vert. exageration
	  (setq elfac (*(fix(/(/ vdist 10)2))20))		;dn 2 *10 vert. exageration
	);if
	(setq endit "no")
      );progn
      (setq endit nil)
    );if
);defun ggseg
;;;;;************************************************
(defun gint ( / )
(while
  (setq pt1
    (inters
	(list ptg1x ptg1y)				;get intersect
	(list ptg2x ptg2y)				;if exists
	(list pti1x (+ pti1y elfac))			;on segment
	(list pti2x (+ pti2y elfac))
    );inters
  );setq
  (progn
    (setq hdist (-(car pt1) xstrt))
    (setq xstrt (car pt1))
    (setq fvdis 0)
    (dcdat)
    (elfad)
  );progn
);while
);defun gint