;;;
;;;
;;;>	Author:	Henry C. Francis
;;;>		425 N. Ashe St.
;;;>		Southern Pines, NC 28387
;;;>		http://paracadd.com
;;;>		All rights reserved.
;;;
;;;>		COPYRIGHT: 9-27-2001
;;;>		   EDITED: 10-06-2005
;;;
(DEFUN c:prculv ( / subspt )
  (SETQ old_osmode (GETVAR "osmode"))
  (SETVAR "osmode" 1)
  (IF c:svlayr NIL (LOAD "mklayr" "\nFile MKLAYR.LSP not loaded!"))
  (c:svlayr)
  (WHILE (SETQ line_ent (NENTSEL "Select a culvert endpoint"))
    (SETQ ent_data (ENTGET (CAR line_ent)))
    (SETQ ent_pt (CADR line_ent))
    (SETQ ent_pt (LIST (CAR ent_pt) (CADR ent_pt) 0))
    (SETQ ent_10x (CADR (ASSOC 10 ent_data)))
    (SETQ ent_10y (CADDR (ASSOC 10 ent_data)))
    (SETQ ent_11x (CADR (ASSOC 11 ent_data)))
    (SETQ ent_11y (CADDR (ASSOC 11 ent_data)))
    (SETQ ent_lay (CDR (ASSOC 8 ent_data)))
    (if (wcmatch ent_lay "*|*")
      (progn
        (while (/= (substr ent_lay 1 1) "|")
          (setq ent_lay (substr ent_lay 2))
        )
        (setq ent_lay (substr ent_lay 2))
      )
    )
    (SETQ clayr ent_lay)
    (cond
      ((=(strlen ent_lay)14)
        (setq subspt (-(strlen ent_lay)4)))
      ((=(strlen ent_lay)12)
        (setq subspt (-(strlen ent_lay)2)))
    );cond
    (setq pproc (substr ent_lay 3 4))
    (while
      (eq (substr pproc 1 1) "0")
      (if (>(strlen pproc)1)
        (setq pproc (substr pproc 2))
        (setq pproc "?")
      )
    )
    (if subspt
      (progn
        (setq p_size (substr ent_lay subspt 2))
        (while
          (eq (substr p_size 1 1) "0")
          (if (>(strlen p_size)1)
            (setq p_size (substr p_size 2))
            (setq p_size "?")
          )
        )
        (if(eq(type(read p_size))'INT)
          (setq ps_real (atof p_size))
        )
        (cond
          ((eq(substr p_size (strlen p_size))"H")
            (setq ps_real (/(atof(substr p_size 1 1))2)))
          ((eq(substr p_size (strlen p_size))"Q")
            (setq ps_real (/(atof(substr p_size 1 1))4)))
          ((eq(substr p_size (strlen p_size))"E")
            (setq ps_real (/(atof(substr p_size 1 1))8)))
        )
      )
    )
    (IF (clnmstd) NIL
      (PROGN
;;;        (IF mjrg NIL
          (SETQ mjrg "C"
;;;            (ukword 1
;;;                    "G C L A S M P F E I O Q T Z"
;;;                    "Arch/Civil/Elec/Fire/Gis/Inter/Land/Mech/Other/Plumb/Equip/Struc/Tele/Contr ?"
;;;                    (IF mjrg mjrg "C")
;;;            )
          )
;;;        )
        (SETQ llt "E")
        (IF (OR
              (WCMATCH ent_lay "*SD*")
              (WCMATCH ent_lay "*EW*")
              (WCMATCH ent_lay "*GAS*")
              (WCMATCH ent_lay "*SS*")
              (WCMATCH ent_lay "*ES*")
            )
            (PROGN
              (WHILE
                (AND
                  (NOT
                    (EQ
                      (STRLEN (SETQ utilsize (ustr 1 "Pipe size? (enter a 2 character string)" (IF utilsize utilsize "15") NIL)))
                      2
                    )
                  )
                  (NOT (EQ (TYPE (READ utilsize)) 'INT))
                )
              )
              (SETQ modf (STRCAT "ES" utilsize "P"))
              (SETQ ps_real (ATOF utilsize))
            )
            (SETQ modf NIL)
        )
        (COND
          ((WCMATCH ent_lay "*SD*")
            (SETQ utilmatl (ukword 1 "Cmp Dip Hdpe Pvc Rcp" "Material CMP/DIP/HDPE/PVC/RCP ?" (IF utilmatl utilmatl "RCP")))
            (IF (EQ (STRLEN utilmatl) 3) (SETQ prod (STRCAT "0" (STRCASE utilmatl)))(SETQ prod(STRCASE utilmatl)))
            (SETQ colr "1" llt "I" ltstr "Hidden2")
           )
          ((WCMATCH ent_lay "*EW*")
            (SETQ prod "000W" colr "5" ltstr "ECS_WL")
           )
          ((WCMATCH ent_lay "*GAS*")
            (SETQ prod "000G" colr "1" ltstr "ECS_GAS")
           )
          ((OR (WCMATCH ent_lay "*SS*")(WCMATCH ent_lay "*ES*"))
            (SETQ prod "00SS" colr "1" ltstr "ECS-SS")
           )
          (T (SETQ prod "VI01" colr "1" ltstr "CONTINUOUS"))
        )
        
      )
    )
    (SETQ view_center (GETVAR "VIEWCTR"))
    (SETQ view_size (GETVAR "VIEWSIZE"))
    (IF (< (DISTANCE ent_pt (LIST ent_10x ent_10y 0)) (DISTANCE ent_pt (LIST ent_11x ent_11y 0)))
      (SETQ nearest_pt  (LIST ent_10x ent_10y 0)
            farthest_pt (LIST ent_11x ent_11y 0)
      ) ;_ end of SETQ
      (SETQ nearest_pt  (LIST ent_11x ent_11y 0)
            farthest_pt (LIST ent_10x ent_10y 0)
      ) ;_ end of SETQ
    ) ;_ end of IF
    (GRDRAW (POLAR nearest_pt
                   (+ (ANGLE (LIST ent_10x ent_10y 0) (LIST ent_11x ent_11y 0)) (* PI 0.25))
                   (/ view_size 33.33)
            ) ;_ end of POLAR
            (POLAR nearest_pt
                   (+ (ANGLE (LIST ent_10x ent_10y 0) (LIST ent_11x ent_11y 0)) (* PI 1.25))
                   (/ view_size 33.33)
            ) ;_ end of POLAR
            7
    ) ;_ end of GRDRAW
    (GRDRAW (POLAR nearest_pt
                   (+ (ANGLE (LIST ent_10x ent_10y 0) (LIST ent_11x ent_11y 0)) (* PI 0.75))
                   (/ view_size 33.33)
            ) ;_ end of POLAR
            (POLAR nearest_pt
                   (+ (ANGLE (LIST ent_10x ent_10y 0) (LIST ent_11x ent_11y 0)) (* PI 1.75))
                   (/ view_size 33.33)
            ) ;_ end of POLAR
            7
    ) ;_ end of GRDRAW
    (IF (EQ (CDR (ASSOC 0 ent_data)) "LINE")
      (PROGN
        (SETQ near_endz (ureal 1
                               "Select"
                               "New \"Z\" for this end or <S>elect \"Z\" text"
;;;                               "Select"
                               (IF (AND near_endz (EQ (TYPE near_endz) 'REAL))
                                 near_endz
                               ) ;_ end of if
                        ) ;_ end of ureal
        ) ;_ end of setq
        (SETQ accept_z NIL)
        (IF (EQ near_endz "Select")
          (PROGN
            (SETQ nearz_txt T)
            (WHILE (AND (NOT (EQ accept_z "Yes")) nearz_txt)
              (SETQ nearz_txt (NENTSEL "Select \"Z\" text"))
              (COND
                (nearz_txt
                 (SETQ ztxt_data (ENTGET (CAR nearz_txt)))
                 (IF (OR (EQ (CDR (ASSOC 0 ztxt_data)) "TEXT") (EQ (CDR (ASSOC 0 ztxt_data)) "ATTRIB"))
                   (PROGN
                     (SETQ rawz_txt (CDR (ASSOC 1 ztxt_data)))
                     (SETQ strt_cnt 1)
                     (WHILE
                       (OR
                         (EQ (SUBSTR rawz_txt strt_cnt 1) "\"")
                         (AND
                           (NOT (EQ (TYPE (READ (SUBSTR rawz_txt strt_cnt))) 'REAL))
                           (< strt_cnt (STRLEN rawz_txt))
                         )
                       )
                        (SETQ strt_cnt (1+ strt_cnt))
                     ) ;_ end of WHILE
                     (IF (< strt_cnt (STRLEN rawz_txt))
                       (SETQ accept_z (ukword 1 "Yes No" (STRCAT "Accept " (SUBSTR rawz_txt strt_cnt) " ?") "Yes") ; _
               ; end
               ; of
               ; ukword
                       ) ;_ end of SETQ
                       (SETQ accept_z NIL)
                     ) ;_ end of IF
                     (COND
                       ((EQ accept_z "Yes")
                        (SETQ near_endz
                               (IF (EQ utilsize "13")
                                 (-(ATOF (SUBSTR rawz_txt strt_cnt)) 1.083)
                                 (ATOF (SUBSTR rawz_txt strt_cnt))
                               )
                        ))
                     )
                   ) ;_ end of PROGN
                 ) ;_ end of IF
                )
                (T (SETQ accept_z NIL))
              ) ;_ end of COND
            ) ;_ end of WHILE
          ) ;_ end of PROGN
        ) ;_ end of IF
        (IF (EQ (TYPE near_endz) 'REAL)
          (PROGN
            (GRDRAW (POLAR nearest_pt
                           (+ (ANGLE (LIST ent_10x ent_10y 0) (LIST ent_11x ent_11y 0)) (* PI 0.25))
                           (/ view_size 33.33)
                    ) ;_ end of POLAR
                    (POLAR nearest_pt
                           (+ (ANGLE (LIST ent_10x ent_10y 0) (LIST ent_11x ent_11y 0)) (* PI 1.25))
                           (/ view_size 33.33)
                    ) ;_ end of POLAR
                    -7
            ) ;_ end of GRDRAW
            (GRDRAW (POLAR nearest_pt
                           (+ (ANGLE (LIST ent_10x ent_10y 0) (LIST ent_11x ent_11y 0)) (* PI 0.75))
                           (/ view_size 33.33)
                    ) ;_ end of POLAR
                    (POLAR nearest_pt
                           (+ (ANGLE (LIST ent_10x ent_10y 0) (LIST ent_11x ent_11y 0)) (* PI 1.75))
                           (/ view_size 33.33)
                    ) ;_ end of POLAR
                    -7
            ) ;_ end of GRDRAW
            (GRDRAW (POLAR farthest_pt
                           (+ (ANGLE (LIST ent_10x ent_10y 0) (LIST ent_11x ent_11y 0)) (* PI 0.25))
                           (/ view_size 33.33)
                    ) ;_ end of POLAR
                    (POLAR farthest_pt
                           (+ (ANGLE (LIST ent_10x ent_10y 0) (LIST ent_11x ent_11y 0)) (* PI 1.25))
                           (/ view_size 33.33)
                    ) ;_ end of POLAR
                    7
            ) ;_ end of GRDRAW
            (GRDRAW (POLAR farthest_pt
                           (+ (ANGLE (LIST ent_10x ent_10y 0) (LIST ent_11x ent_11y 0)) (* PI 0.75))
                           (/ view_size 33.33)
                    ) ;_ end of POLAR
                    (POLAR farthest_pt
                           (+ (ANGLE (LIST ent_10x ent_10y 0) (LIST ent_11x ent_11y 0)) (* PI 1.75))
                           (/ view_size 33.33)
                    ) ;_ end of POLAR
                    7
            ) ;_ end of GRDRAW
            (SETQ far_endz (ureal 1
                                  "Select"
                                  "New \"Z\" for other end or <S>elect \"Z\" text"
;;;                                  "Select"
                                  (IF (AND far_endz (EQ (TYPE far_endz) 'REAL))
                                    far_endz
                                    (IF (AND near_endz (EQ (TYPE near_endz) 'REAL))
                                      near_endz
                                    ) ;_ end of IF
                                  ) ;_ end of if
                           ) ;_ end of ureal
            ) ;_ end of setq
            (SETQ accept_z NIL)
            (IF (EQ far_endz "Select")
              (PROGN
                (SETQ farz_txt T)
                (WHILE (AND (NOT (EQ accept_z "Yes")) farz_txt)
                  (SETQ farz_txt (NENTSEL "Select \"Z\" text"))
                  (COND
                    (farz_txt
                     (SETQ ztxt_data (ENTGET (CAR farz_txt)))
                     (IF (EQ (CDR (ASSOC 0 ztxt_data)) "TEXT")
                       (PROGN (SETQ rawz_txt (CDR (ASSOC 1 ztxt_data)))
                              (SETQ strt_cnt 1)
                              (WHILE (OR
                                       (EQ (SUBSTR rawz_txt strt_cnt 1) "\"")
                                       (AND
                                         (NOT (EQ (TYPE (READ (SUBSTR rawz_txt strt_cnt))) 'REAL))
                                         (< strt_cnt (STRLEN rawz_txt))
                                       ) ;_ end of AND
                                     )
                                (SETQ strt_cnt (1+ strt_cnt))
                              ) ;_ end of WHILE
                              (IF (< strt_cnt (STRLEN rawz_txt))
                                (SETQ accept_z (ukword 1 "Yes No" (STRCAT "Accept " (SUBSTR rawz_txt strt_cnt) " ?") "Yes")
               ; _
               ; end
               ; of
               ; ukword
                                ) ;_ end of SETQ
                                (SETQ accept_z NIL)
                              ) ;_ end of IF
                              (COND
                                ((EQ accept_z "Yes")
                                 (SETQ far_endz
                                   (IF (EQ utilsize "13")
                                     (-(ATOF (SUBSTR rawz_txt strt_cnt)) 1.083)
                                     (ATOF (SUBSTR rawz_txt strt_cnt))
                                   )
                                 ))
                              )
                       ) ;_ end of PROGN
                     ) ;_ end of IF
                    )
                    (T (SETQ accept_z NIL))
                  ) ;_ end of COND
                ) ;_ end of WHILE
              ) ;_ end of PROGN
            ) ;_ end of IF
            (SETQ accept_z NIL)
            (IF (EQ (TYPE far_endz) 'REAL)
              (PROGN (SETQ ent_layer (STRCAT mjrg llt prod colr (IF modf modf "")))
                     (IF ltstr
                       (COMMAND ".layer" "c" colr ent_layer "lt" ltstr ent_layer "")
                       (COMMAND ".layer" "c" colr ent_layer "")
                     )
              ) ;_ end of PROGN
              (PRINC "\nInvalid or no \"Z\" for second end! ")
            ) ;_ end of IF
          ) ;_ end of PROGN
          (PRINC "\nInvalid or no \"Z\" for first end! ")
        ) ;_ end of IF
      ) ;_ end of progn
    ) ;_ end of if
    (GRDRAW (POLAR farthest_pt
                   (+ (ANGLE (LIST ent_10x ent_10y 0) (LIST ent_11x ent_11y 0)) (* PI 0.25))
                   (/ view_size 33.33)
            ) ;_ end of POLAR
            (POLAR farthest_pt
                   (+ (ANGLE (LIST ent_10x ent_10y 0) (LIST ent_11x ent_11y 0)) (* PI 1.25))
                   (/ view_size 33.33)
            ) ;_ end of POLAR
            -7
    ) ;_ end of GRDRAW
    (GRDRAW (POLAR farthest_pt
                   (+ (ANGLE (LIST ent_10x ent_10y 0) (LIST ent_11x ent_11y 0)) (* PI 0.75))
                   (/ view_size 33.33)
            ) ;_ end of POLAR
            (POLAR farthest_pt
                   (+ (ANGLE (LIST ent_10x ent_10y 0) (LIST ent_11x ent_11y 0)) (* PI 1.75))
                   (/ view_size 33.33)
            ) ;_ end of POLAR
            -7
    ) ;_ end of GRDRAW
    (point_sta nearest_pt)
    (setq culv_end1b (list qpnt_sta (* v_fact near_endz)0))
    (point_sta farthest_pt)
    (setq culv_end2b (list qpnt_sta (* v_fact far_endz)0))
    (setq culv_end1t (polar culv_end1b (/ pi 2.0) (* v_fact(/ ps_real 12.0)))
          culv_end2t (polar culv_end2b (/ pi 2.0) (* v_fact(/ ps_real 12.0)))
    )
    (SETQ mjrg "C"
          llt  "I"
          prod "vi01"
          colr "1"
          modf "culv"
    )
    (c:mklayr)
    (setvar "plinewid" 0)
    (COMMAND ".pline" culv_end1b culv_end2b culv_end2t culv_end1t culv_end1b "c")
    (c:rslayr)
  ) ;_ end of while
  (SETVAR "osmode" old_osmode)
) ;_ end of defun

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