;C:DC - Output Depth Cut + LF for MHP sewers. (commented - latest?) also C:NPL
;
;	THIS PROGRAM WILL CREATE A NEW POLYLINE FROM AN OLD POLYLINE
;	AND REVERSE THE ORDER OF THE VERTICES.  IT USES A SCRIPT FILE
;	CONTAINING THE VERTEX POINTS SORTED IN DECENDING ORDER.
;	THE ORIGINAL POLYLINE MUST ADVANCE CONTINUALLY IN EITHER DIRECTION
;       ALONG THE X AXIS IN THE COORDINATE SYSTEM USED.
;
;	AUTHOR: HENRY C. FRANCIS
;		425 N. ASHE ST.
;		SOUTHERN PINES, NC 28387
;		All rights reserved without prejudice.
;
;	Copyright:	9-23-93
;	Edited:		3-17-94
;
(defun c:npl ( / ptlst prgp ptg1)					;find another
  (setq prgp (car (entsel "\nSelect Existing Grade Polyline ")))
    (setq datf (open "-npl.scr" "w"))
    (write-line ".pline" datf)
    (while						;ground segment
      (not (eq (cdr (assoc 0 (entget (entnext prgp)))) "SEQEND"))
        (setq prgp (entnext prgp))
      (if
	(setq ptg1 (cdr (assoc 10 (entget prgp))))
	  (progn
	    (setq ptg1x (rtos (car ptg1)))
	    (setq g1xsl (strlen ptg1x))
	    (setq ptg1y (rtos (cadr ptg1)))
	    (setq g1ysl (strlen ptg1y))
	    (if (= g1xsl 3)
	      (setq ptg1x (strcat "00000" ptg1x))
	        (if (= g1xsl 4)
		  (setq ptg1x (strcat "0000" ptg1x))
		    (if (= g1xsl 5)
		      (setq ptg1x (strcat "000" ptg1x))
		        (if (= g1xsl 6)
			  (setq ptg1x (strcat "00" ptg1x))
			    (if (= g1xsl 7)
			      (setq ptg1x (strcat "0" ptg1x))
			    );if
			);if
		    );if
		);if
	    );if
	    (if (= g1ysl 3)
	      (setq ptg1y (strcat "0000" ptg1y))
	        (if (= g1ysl 4)
		  (setq ptg1y (strcat "000" ptg1y))
		    (if (= g1ysl 5)
		      (setq ptg1y (strcat "00" ptg1y))
		        (if (= g1ysl 6)
			  (setq ptg1y (strcat "0" ptg1y))
			    (if (= g1ysl 7)
			      (setq ptg1y (strcat "0" ptg1y))
			    );if
			);if
		    );if
		);if
	    );if
	    (setq ptlst (strcat ptg1x "," ptg1y))
	    (write-line ptlst datf)
	  );progn
      );if
    );while
    (close datf)
    (command ".sh" "sort < -npl.scr > -pl.scr" )
    (graphscr)
    (command ".script" "-pl.scr")
);defun c:npl
;
;	THIS PROGRAM WILL CALCULATE TOTAL LF AT ALL DEPTHS OF COVER IN
;	2 FT INCREMENTS EXCEPT 2' (0' TO 4' IS COUNTED AT 4') INCLUDING
;       EXPOSED PIPE (AERIAL).  THE PREVIOUS PROGRAM "NPL" IS INCLUDED
;       IN ORDER TO MAKE THE REQUIRED EXIST. GROUND POLYLINE FROM LEFT
;       TO RIGHT.  THIS PROGRAM CONTAINS SEVERAL INDIVIDUAL FUNCTIONS
;       EACH OF WHICH ARE DEFINED BELOW.
;
;	AUTHOR: HENRY C. FRANCIS
;		425 N. ASHE ST.
;		SOUTHERN PINES, N.C. NON-DOMESTIC 28387
;		All rights reserved, Without prejudice.
;	Copyright:	9-23-93
;	Edited:		3-17-94
;
(DEFUN C:DC ( / ptg1x prpe bincr DC-12 DC-10 DC-8 DC-6 DC-4 DC-2 DC0 DC2 DC4
		DC6 DC8 DC10 DC12 DC14 DC16 DC18 DC20 DC22 DC24 DC26 DC28 DC30)
		; prgp ptg1x ptg1y ptg2x ptg2y pt1
  (if outfn
    (progn
      (setq ofnsl (strlen outfn))
      (setq ofpfx (substr outfn 1 (- ofnsl 5)))
      (setq ofsfx (substr outfn (- ofnsl 3)))
      (if (and incr (< incr 10))
        (setq incr (+ incr 1))
        (setq incr 1)
      );if
      (setq incrt (substr (itoa (fix incr)) 1 1))
      (setq outfn (strcat ofpfx incrt ofsfx))
    );progn
  );if
  (setq outfn (ustr 1 "\nOutput Filename " outfn ""))
  (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)))
    (dcdat)
    (ggseg)
    (gint)
  );progn
;  (if (> pti2x ptg1x)
    (progn
      (setq hdist (- pti2x xstrt))
;      (setq ptb1 (list ptg2x ptg2y))
;      (setq ptb2 (list ptg2x (+ 2 ptg2y)))
      (dcdat)
      (gpseg)
      (gint)
    );progn
;    (gpseg)
;  );if
);if
);while
(pout)
(PRINC)
);defun DC
;;;;;************************************************
(defun dcdat (/)
    (setq datf (open outfn "a"))
      (if (> slopg slopi)
	(setq oelfa elfac)
	(setq oelfa (+ elfac 20))
      );if
    (if (and btxt (/= btxt obtxt))
    (progn
      (write-line btxt datf)
      (setq obtxt btxt)
    );progn
    );if
    (write-line (strcat (rtos hdist)","(rtos (/ oelfa 10))) datf)
    (close datf)
    (if (eval (read (strcat "dc" (itoa (/ oelfa 10))))) nil
      (set (read (strcat "dc" (itoa (/ oelfa 10)))) 0)
    );if
    (set (read (strcat "dc" (itoa (/ oelfa 10))))
         (+ hdist (eval (read (strcat "dc" (itoa (/ oelfa 10))))))
    );set
    (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 ( / )
  (if prpe
    (progn
    (setq chose (ukword 0 "Continue, End" "Continue or End ? " "Continue"))
      (if (eq chose "Continue")
        (progn
	  (setq prpb prpe)
	  (setq prpi (car (entsel "\nSelect Proposed Pipe Invert Line ")))
	  (setq prpe (car (entsel "\nSelect Pipe Ending Station Line ")))
	);progn
	(setq endit nil)
      );if
    );progn
    (progn
      (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 ")))
    );progn
  );if
  (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 pti1
      (inters ptb1 ptb2
	(cdr (assoc 10 (entget prpi)))
	(cdr (assoc 11 (entget prpi)))nil
      );inters
  );setq
  (setq pti1x (car pti1))
  (setq pti1y (cadr pti1))
  (setq xstrt pti1x)
  (setq pti2
      (inters pte1 pte2
	(cdr (assoc 10 (entget prpi)))
	(cdr (assoc 11 (entget prpi)))nil
      );inters
  );setq
  (setq pti2x (car pti2))
  (setq pti2y (cadr pti2))
  (setq slopi (/(- pti2y pti1y)(- pti2x pti1x)))
  (if bincr
    (setq bincr (+ bincr 1))
    (setq bincr 1)
  );if
  (setq btxt (strcat "Station " (rtos pti1x) " Begin Pipe Segment " (itoa (fix bincr))))
);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))
    (dcdat)
    (elfad)
  );progn
);while
);defun gint
;;;;;************************************************
(defun pout ( / )
(setq datf (open outfn "a"))
(write-line "" datf)
  (if dc30
    (write-line (strcat (rtos dc30) " LF 28'-30' Trench Depth" )datf)
  );if
  (if dc28
    (write-line (strcat (rtos dc28) " LF 26'-28' Trench Depth" )datf)
  );if
  (if dc26
    (write-line (strcat (rtos dc26) " LF 24'-26' Trench Depth" )datf)
  );if
  (if dc24
    (write-line (strcat (rtos dc24) " LF 22'-24' Trench Depth" )datf)
  );if
  (if dc22
    (write-line (strcat (rtos dc22) " LF 20'-22' Trench Depth" )datf)
  );if
  (if dc20
    (write-line (strcat (rtos dc20) " LF 18'-20' Trench Depth" )datf)
  );if
  (if dc18
    (write-line (strcat (rtos dc18) " LF 16'-18' Trench Depth" )datf)
  );if
  (if dc16
    (write-line (strcat (rtos dc16) " LF 14'-16' Trench Depth" )datf)
  );if
  (if dc14
    (write-line (strcat (rtos dc14) " LF 12'-14' Trench Depth" )datf)
  );if
  (if dc12
    (write-line (strcat (rtos dc12) " LF 10'-12' Trench Depth" )datf)
  );if
  (if dc10
    (write-line (strcat (rtos dc10) " LF 8'-10' Trench Depth" )datf)
  );if
  (if dc8
    (write-line (strcat (rtos dc8) " LF 6'-8' Trench Depth" )datf)
  );if
  (if dc6
    (write-line (strcat (rtos dc6) " LF 4'-6' Trench Depth" )datf)
  );if
  (if dc4
    (if dc2
      (progn
        (setq dc4 (+ dc4 dc2))
        (write-line (strcat (rtos dc4) " LF 0'-4' Trench Depth" )datf)
      );progn
      (write-line (strcat (rtos dc4) " LF 0'-4' Trench Depth" )datf)
    );if
    (if dc2
      (write-line (strcat (rtos dc2) " LF 0'-4' Trench Depth" )datf)
      nil
    );if
  );if
(if dc0
  (progn
  (if dc-2 (setq dc0 (+ dc-2 dc0))
	nil
  );if
  (if dc-4 (setq dc0 (+ dc-4 dc0))
	nil
  );if
  (if dc-6 (setq dc0 (+ dc-6 dc0))
	nil
  );if
  (if dc-8 (setq dc0 (+ dc-8 dc0))
	nil
  );if
  (if dc-10 (setq dc0 (+ dc-10 dc0))
	nil
  );if
  (if dc-12 (setq dc0 (+ dc-12 dc0))
	nil
  );if
  (if dc-14 (setq dc0 (+ dc-14 dc0))
	nil
  );if
  (if dc-16 (setq dc0 (+ dc-16 dc0))
	nil
  );if
  (if dc-18 (setq dc0 (+ dc-18 dc0))
	nil
  );if
  (if dc-20 (progn (setq dc0 (+ dc-20 dc0)) agout)
        (agout)
  );if
  );progn
  (agout)
);if
(close datf)
);defun pout
;;;;;************************************************
(defun agout ( / )
(if dc0
  (write-line (strcat (rtos dc0) " LF Above Ground") datf)
);if
(princ)
);defun agout