;;;Used with GPDGN alignments (gravity or pressure pipelines) to output takeoff data.
;;;
;;;>	Author:	Henry C. Francis
;;;>		425 N. Ashe St.
;;;>		Southern Pines, NC 28387
;;;>		http://paracadd.com
;;;>		All rights reserved.
;;;
;;;>		COPYRIGHT: 8-30-1999
;;;>		   EDITED: 01-25-2006
;;;
(DEFUN c:alndata ()
  (setq	fit_lst	nil
	length_lst
	 nil
  ) ;_ end of setq
  (setq dwgsplitpath (dos_splitpath (GETVAR "dwgprefix")))
  (dos_drive (car dwgsplitpath))
  (dos_chdir (GETVAR "dwgprefix"))
  (SETQ	alnfil_sel
	 (dos_getfilem
	   "Select Alignment Files for Takeoff"
	   (GETVAR "DWGPREFIX")
	   "Alignment FIles (*.aln)|*.aln||"
	 ) ;_ end of dos_getfilem
  ) ;_ end of SETQ
  (IF (AND alnfil_sel (> (LENGTH alnfil_sel) 1))
    (PROGN
      (SETQ alnfil_lst (CDR alnfil_sel))
      (FOREACH n alnfil_lst
        (SETQ fit_out
	       (OPEN (STRCAT (SUBSTR n 1 (-(STRLEN n) 4))".dat") "w")
        ) ;_ end of SETQ
;;;	(IF (OR	(WCMATCH (STRCASE n) "*CROSSINGS*.ALN")
;;;		(WCMATCH (STRCASE n) "*EROSION*.ALN")
;;;		(WCMATCH (STRCASE n) "*MATTING*.ALN")
;;;		(WCMATCH (STRCASE n) "*X-INGS*.ALN")
;;;		(WCMATCH (STRCASE n) "*EC*.ALN")
;;;		(WCMATCH (STRCASE n) "*XINGS*.ALN")
;;;		(WCMATCH (STRCASE n) "*EROC*.ALN")
;;;	    ) ;_ end of OR
;;;	  NIL
	  (PROGN
	    (SETQ opn_fil (OPEN n "r"))
	    (SETQ prev_item NIL)
	    (READ-LINE opn_fil)
	    (WHILE (SETQ read_item (READ-LINE opn_fil))
	      (SETQ item (READ read_item))
	      (IF (AND (EQ (TYPE (READ (NTH 0 item))) 'INT)
		       (NOT (WCMATCH (NTH 0 item) "*\"*"))
		  ) ;_ end of AND
		NIL
		(PROGN
		  (IF fit_lst
		    (IF	(ASSOC (NTH 0 item) fit_lst)
		      (SETQ fit_lst
			     (SUBST
			       (CONS (NTH 0 item)
				     (1+ (CDR (ASSOC (NTH 0 item) fit_lst)))
			       ) ;_ end of CONS
			       (ASSOC (NTH 0 item) fit_lst)
			       fit_lst
			     ) ;_ end of SUBST
		      ) ;_ end of SETQ
		      (SETQ
			fit_lst	(APPEND	fit_lst
					(LIST (CONS (NTH 0 item) 1))
				) ;_ end of APPEND
		      ) ;_ end of SETQ
		    ) ;_ end of IF
		    (SETQ fit_lst (LIST (CONS (NTH 0 item) 1)))
		  ) ;_ end of IF
		) ;_ end of PROGN
	      ) ;_ end of IF
	      (IF prev_item
		(PROGN
		  (IF length_lst
		    (IF	(ASSOC (NTH 7 prev_item) length_lst)
		      (SETQ length_lst
			     (SUBST
			       (CONS
				 (NTH 7 prev_item)
				 (+
				   (CDR
				     (ASSOC (NTH 7 prev_item) length_lst)
				   ) ;_ end of CDR
				   (DISTANCE (LIST (CAR (NTH 9 prev_item))
						   (CADR (NTH 9 prev_item))
					     ) ;_ end of LIST
					     (LIST (CAR (NTH 9 item))
						   (CADR (NTH 9 item))
					     ) ;_ end of LIST
				   ) ;_ end of DISTANCE
				 ) ;_ end of +
			       ) ;_ end of CONS
			       (ASSOC (NTH 7 prev_item) length_lst)
			       length_lst
			     ) ;_ end of SUBST
		      ) ;_ end of SETQ
		      (SETQ length_lst
			     (APPEND
			       length_lst
			       (LIST
				 (CONS
				   (NTH 7 prev_item)
				   (DISTANCE (LIST (CAR (NTH 9 prev_item))
						   (CADR (NTH 9 prev_item))
					     ) ;_ end of LIST
					     (LIST (CAR (NTH 9 item))
						   (CADR (NTH 9 item))
					     ) ;_ end of LIST
				   ) ;_ end of DISTANCE
				 ) ;_ end of CONS
			       ) ;_ end of LIST
			     ) ;_ end of APPEND
		      ) ;_ end of SETQ
		    ) ;_ end of IF
		    (IF	prev_item
		      (SETQ length_lst
			     (LIST
			       (CONS
				 (NTH 7 prev_item)
				 (DISTANCE (LIST (CAR (NTH 9 prev_item))
						 (CADR (NTH 9 prev_item))
					   ) ;_ end of LIST
					   (LIST (CAR (NTH 9 item))
						 (CADR (NTH 9 item))
					   ) ;_ end of LIST
				 ) ;_ end of DISTANCE
			       ) ;_ end of CONS
			     ) ;_ end of LIST
		      ) ;_ end of SETQ
		    ) ;_ end of IF
		  ) ;_ end of IF
;;;	  (PRINC "\n")
;;;	  (PRINC (NTH 7 prev_item))
;;;	  (PRINC "  ")
;;;	  (PRINC
;;;	    (DISTANCE (LIST (CAR (NTH 9 prev_item))
;;;			    (CADR (NTH 9 prev_item))
;;;		      ) ;_ end of LIST
;;;		      (LIST (CAR (NTH 9 item))
;;;			    (CADR (NTH 9 item))
;;;		      ) ;_ end of LIST
;;;	    ) ;_ end of DISTANCE
;;;	  ) ;_ end of PRINC
		) ;_ end of PROGN
	      ) ;_ end of IF
	      (IF item
		(SETQ prev_item item)
	      ) ;_ end of IF
	    ) ;_ end of WHILE
	    (CLOSE opn_fil)
;;;	    (PRINC (STRCAT "\nLooked at \"" n "\""))
;;;	    (WRITE-LINE (STRCAT "Looked at \"" n "\"") fit_out)
	    (PRINC)
	  ) ;_ end of PROGN
;	) ;_ end of IF
      (PRINC (STRCAT "\n\nFITTINGS QUANTITIES FOR: "
		     n
		     "\n\n"
		     (GETVAR "dwgprefix")
		     "\n"
	     ) ;_ end of STRCAT
      ) ;_ end of PRINC
      (WRITE-LINE
	(STRCAT "FITTINGS QUANTITIES FOR: " n)
	fit_out
      ) ;_ end of WRITE-LINE
      (WRITE-LINE "" fit_out)
      (WRITE-LINE (GETVAR "dwgprefix") fit_out)
      (WRITE-LINE "" fit_out)
      (FOREACH n fit_lst
	(IF (WCMATCH (CAR n) "*%%221*")
	  (PROGN
	    (SETQ chrcnt 1)
	    (WHILE
	      (NOT (EQUAL (SUBSTR (CAR n) chrcnt 1) "%"))
	       (SETQ chrcnt (1+ chrcnt))
	    ) ;_ end of WHILE
	    (SETQ fit_desc (STRCAT (SUBSTR (CAR n) 1 (1- chrcnt))
				   (CHR 176)
				   (SUBSTR (CAR n) (+ chrcnt 5))
			   ) ;_ end of STRCAT
	    ) ;_ end of SETQ
	  ) ;_ end of PROGN
	  (SETQ fit_desc (CAR n))
	) ;_ end of IF
	(PRINC (STRCAT "\n" (ITOA (CDR n)) "\t" fit_desc))
	(WRITE-LINE (STRCAT (ITOA (CDR n)) "\t" fit_desc) fit_out)
      ) ;_ end of FOREACH
      (WRITE-LINE "" fit_out)
      (PRINC "\n\nPIPE SIZES AND LENGTHS:\n")
      (WRITE-LINE "PIPE SIZES AND LENGTHS:" fit_out)
      (WRITE-LINE "" fit_out)
      (SETQ grand_total NIL)
      (FOREACH n length_lst
	(PRINC
	  (STRCAT "\n" (RTOS (CAR n) 2 0) "\"\t" (RTOS (CDR n) 2 2))
	) ;_ end of PRINC
	(WRITE-LINE
	  (STRCAT (RTOS (CAR n) 2 0) "\"\t" (RTOS (CDR n) 2 2))
	  fit_out
	) ;_ end of WRITE-LINE
	(IF grand_total
	  (SETQ grand_total (+ grand_total (CDR n)))
	  (SETQ grand_total (CDR n))
	) ;_ end of IF
      ) ;_ end of FOREACH
      (IF grand_total
	(PROGN
	  (PRINC (STRCAT "\n\nTotal length of all pipe = "
			 (RTOS grand_total 2 2)
		 ) ;_ end of STRCAT
	  ) ;_ end of PRINC
	  (WRITE-LINE
	    (STRCAT "\nTotal length of all pipe = "
		    (RTOS grand_total 2 2)
	    ) ;_ end of STRCAT
	    fit_out
	  ) ;_ end of WRITE-LINE
	  (CLOSE fit_out)
	) ;_ end of PROGN
      ) ;_ end of IF
      )
    ) ;_ end of PROGN
    (PROGN
      (PRINC "\nNo alignment files selected! ")
      (PRINC)
    ) ;_ end of PROGN
  ) ;_ end of IF
  (PRINC)
) ;_ end of DEFUN

;|«Visual LISP© Format Options» (72 2 40 2 T "end of " 60 9 0 0 0 T T nil T)
 ***Don't add text below the comment!***|;