;;;
;;;
;;;
;;;
;;;****************************************************************************
;;;
;;;>	Author:	Henry C. Francis
;;;>		425 N. Ashe St.
;;;>		Southern Pines, NC 28387
;;;>		http://paracadd.com
;;;>		All rights reserved.
;;;
;;;>		COPYRIGHT: 
;;;>		   EDITED: 12-06-2006
;;;
(DEFUN procp_error (msg / )
  (princ (strcat "\nError: " msg))
;;;  (IF old_procposmode (SETVAR "OSMODE" old_procposmode))
  (IF old_procpcmdecho (SETVAR "CMDECHO" old_procpcmdecho))
  (setq do_procps NIL)
  (setq *error* orig_procperror)
  (if getstyle (getstyle ""))
  (princ)
)
;;;****************************************************************************
(DEFUN c:procps ()
  (SETQ procp_ss (SSGET "X" '((0 . "POLYLINE")(-4 . "<OR")(8 . "??GRAV[1-9 A-Z]*")(8 . "??GRVL[1-9 A-Z]*")(8 . "??ASPH[1-9 A-Z]*")(8 . "??CONC[1-9 A-Z]*")(8 . "??SOIL[1-9 A-Z]*")(8 . "??CASE4")(-4 . "OR>"))))
  (SETQ procp_cnt 0
        do_procps T)
  (IF PROCP_SS
    (WHILE (< procp_cnt (SSLENGTH procp_ss))
      (c:procp)
      (setq procp_cnt (1+ procp_cnt))
    )
  )
  (SETQ do_procps NIL)
  (ALERT "DONE!")
  (PRINC)
)
;;;****************************************************************************
(DEFUN c:procp (/ procptlst minocp_x maxocp_x do_tnote typ_t1 typ_t2 pavetype waytype) ; 
  (SETQ orig_procperror *error*
        *error* procp_error
  ) ;_ end of SETQ
;;;  (SETQ old_procposmode (GETVAR "OSMODE"))
  (SETQ old_procpcmdecho (GETVAR "CMDECHO"))
;;;  (SETVAR "CMDECHO" 0)
  (IF do_procps
    (SETQ procpename (SSNAME procp_ss procp_cnt))
    (PROGN
      (SETQ procpent (NENTSELP))
      (SETQ procpename (CAR procpent))
    )
  )
  (SETQ procpedata (ENTGET procpename))
  (SETQ origent procpedata)
  (SETQ do_tnote T
        typ_t1 NIL
        typ_t2 NIL
        typ_t3 NIL
        typ_t4 NIL
        typ_t5 NIL
        typ_t6 NIL
        typ_t7 NIL
        typ_t8 NIL
        typ_t9 NIL
        typ_t10 NIL
        typ_t111 NIL
  )
  (IF ureal
    NIL
    (LOAD "ureal" "\nFile UREAL.LSP not loaded! ")
  ) ;_ end of IF
  (IF ukword
    NIL
    (LOAD "ukword" "\nFile UKWORD.LSP not loaded! ")
  ) ;_ end of IF
  (IF GETSTYLE
    NIL
    (LOAD "getstyle" "\nFile GETSTYLE.LSP not loaded! ")
  ) ;_ end of IF
  (GETSTYLE "A")
  (IF (OR (EQ (CDR (ASSOC 0 procpedata)) "POLYLINE") (EQ (CDR (ASSOC 0 procpedata)) "VERTEX"))
    (PROGN (IF v_fact
             NIL
             (SETQ v_fact (ureal 1 "" "Enter vertical scale factor" 10.0))
           ) ;_ end of IF
           (COND ((EQ (CDR (ASSOC 0 procpedata)) "POLYLINE")
                  (SETQ procpelayr (CDR (ASSOC 8 (ENTGET (ENTNEXT (CDR (ASSOC -1 procpedata)))))))
                 )
                 ((EQ (CDR (ASSOC 0 procpedata)) "VERTEX") (SETQ procpelayr (CDR (ASSOC 8 procpedata))))
           ) ;_ end of COND
           (IF (EQ (CDR (ASSOC 0 procpedata)) "LWPOLYLINE")
             (PROGN (FOREACH n procpedata
                      (IF (EQ (CAR n) 10)
                        (SETQ procptlst (APPEND procptlst (LIST (CDR n))))
                      ) ;_ end of IF
                    ) ;_ end of FOREACH
             ) ;_ end of PROGN
             (PROGN (WHILE (/= (CDR (ASSOC 0 procpedata)) "SEQEND")
                      (SETQ procpedata (ENTGET (ENTNEXT (CDR (ASSOC -1 procpedata)))))
                    ) ;_ end of WHILE
                    (SETQ procpedata (ENTGET (CDR (ASSOC -2 procpedata))))
                    (WHILE (/= (CDR (ASSOC 0 procpedata)) "SEQEND")
                      (IF (EQ (CDR (ASSOC 0 procpedata)) "POLYLINE")
                        NIL
                        (SETQ procptlst (APPEND procptlst (LIST (CDR (ASSOC 10 procpedata)))))
                      ) ;_ end of IF
                      (SETQ procpedata (ENTGET (ENTNEXT (CDR (ASSOC -1 procpedata)))))
                    ) ;_ end of while
             ) ;_ end of PROGN
           ) ;_ end of IF
           (SETQ maxocplen (EVAL (CONS 'MAX (MAPCAR 'DISTANCE procptlst (CDR procptlst)))))
           (SETQ minocp_x (EVAL (CONS 'MIN (MAPCAR 'CAR procptlst))))
           (SETQ maxocp_x (EVAL (CONS 'MAX (MAPCAR 'CAR procptlst))))
           (SETQ ocpwid (- maxocp_x minocp_x))
           (SETQ ocpwid (MAX maxocplen ocpwid))
           (SETQ typ_t1 "OPEN CUT AND PATCH")
           (PRINC)
           (COND ((OR (WCMATCH (STRCASE (STRCAT procpelayr)) "*GRAV*")
                      (WCMATCH (STRCASE (STRCAT procpelayr)) "*GRVL*")
                  ) ;_ end of OR
                  (SETQ pavetype "GRAVEL")
                 )
                 ((WCMATCH (STRCASE (STRCAT procpelayr)) "*ASPH*") (SETQ pavetype "ASPHALT"))
                 ((WCMATCH (STRCASE (STRCAT procpelayr)) "*CONC*") (SETQ pavetype "CONCRETE"))
                 ((WCMATCH (STRCASE (STRCAT procpelayr)) "*SOIL*") (SETQ pavetype "SOIL"))
                 ((WCMATCH (STRCASE (STRCAT procpelayr)) "*CASE*") (SETQ pavetype "CASE"))
                 ((WCMATCH (STRCASE (STRCAT procpelayr)) "*RRAP*") (SETQ pavetype "RIPRAP"))
           ) ;_ end of COND
           (COND ((WCMATCH (STRCASE (STRCAT procpelayr)) "*OCNP*") (SETQ waytype (ukword 1 "Drive Road" "Is the open cut and patch in a <R>oad, <D>riveway, or <W>alkway?" (IF waytype waytype "ROAD"))))
                 ((WCMATCH (STRCASE (STRCAT procpelayr)) "*ROAD*") (SETQ waytype "ROAD"))
                 ((OR (WCMATCH (STRCASE (STRCAT procpelayr)) "*DRI*") (WCMATCH (STRCASE (STRCAT procpelayr)) "*DRV*"))
                  (SETQ waytype "DRIVE")
                 )
                 ((WCMATCH (STRCASE (STRCAT procpelayr)) "*WALK*") (SETQ waytype "SIDEWALK"))
                 ((WCMATCH (STRCASE (STRCAT procpelayr)) "*PATH*") (SETQ waytype "PATH"))
                 ((WCMATCH (STRCASE (STRCAT procpelayr)) "*##P")
                  (SETQ waytype (SUBSTR procpelayr (- (STRLEN procpelayr) 2) 2))
                  (IF (NOT (EQ (TYPE (READ waytype)) 'INT))
                    (SETQ waytype "")
                  ) ;_ end of IF
                 )
                 ((WCMATCH (STRCASE (STRCAT procpelayr)) "*CASE*") (SETQ waytype ""))
           ) ;_ end of COND
           (IF (OR (NOT pavetype) (NOT waytype))
             (PRINC (STRCAT "\nLayer is " procpelayr))
           ) ;_ end of IF
           (IF (NOT pavetype)
             (SETQ pavetype (ukword 1
                                    "Asphalt Concrete Gravel Soil"
                                    "What is the pavement type? <Asphalt/Concrete/Gravel/Soil/Riprap>"
                                    (IF pavetype
                                      pavetype
                                      "GRAVEL"
                                    ) ;_ end of IF
                            ) ;_ end of ukword
             ) ;_ end of SETQ
           ) ;_ end of IF
           (IF (AND (NOT waytype) (NOT (EQ (STRCASE pavetype) "RIPRAP")))
             (SETQ waytype (ukword 1
                                   "Drive Road Sidewalk Path"
                                   "What is the way type? <Drive/Road/Sidewalk/Path>"
                                   (IF waytype
                                     waytype
                                     "DRIVE"
                                   ) ;_ end of IF
                           ) ;_ end of ukword
             ) ;_ end of SETQ
           ) ;_ end of IF
           (IF (EQ pavetype "CASE")
             (PROGN (SETQ ocpdpth NIL)
                    (FOREACH n procptlst
                      (IF (AND (> (LENGTH (MEMBER n procptlst)) 1) (EQUAL (CAR n) (CAADR (MEMBER n procptlst)) 0.001))
                        (SETQ ocpdpth (* 12.0 (/ (ABS (- (CADR n) (CADR (NTH 1 (MEMBER n procptlst))))) v_fact)))
;;;                        (PROGN
;;;                          (PRINC "\n")
;;;                          (PRINC (CAR n))
;;;                          (PRINC "\n")
;;;                          (PRINC (CAADR (MEMBER n procptlst)))
;;;                          (PRINC "\n\n")
;;;                          (PRINC)
;;;                        )
                      ) ;_ end of IF
                    ) ;_ end of foreach
                    (IF ocpdpth NIL
                      (SETQ ocpdpth (ureal 1
                                           ""
                                           "Enter Size of Casing in inches"
                                           20.0
                                    ) ;_ end of ureal
                      ) ;_ end of SETQ
                    )
;;;                    (IF (and align_lst (>= (CADR (last align_lst))(caadr procpent)))
;;;                      (PROGN
;;;                        (SETQ cnt 0)
;;;                        (while (< (CADR (NTH cnt align_lst))(caadr procpent))
;;;                          (setq cnt (1+ cnt))
;;;                        )
;;;                        (setq casdpsize (nth 7(nth cnt align_lst)))
;;;                      )
;;;                      (setq casdpsize (ureal 1 "" "Size of DIP in casing? " (if casdpsize casdpsize 6.0)))
;;;                    )
                    (SETQ typ_t1 (STRCAT (RTOS ocpwid 2 0)
                                         " LF OF "
;;;                                         "PROPOSED "
;;;                                         (RTOS casdpsize 2 0)
;;;                                         "\" DIP "
;;;                                         (SUBSTR usrsfx 1 2)
;;;                                         " IN "
                                         waytype
                                   (COND ((WCMATCH waytype "##") "\" STEEL CASING TO")
                                         ((EQ waytype "") (STRCAT (RTOS ocpdpth 2 0) "\" STEEL CASING TO"))
                                         (T "STEEL CASING TO")
                                   ) ;_ end of COND
                                 ) ;_ end of STRCAT
                          typ_t2 "BE INSTALLED BY BORE AND"
                          typ_t3 "JACK. EXTEND CASING 5' MIN."
                          typ_t4 "BOTH SIDES OF PAVEMENT."
                    ) ;_ end of SETQ
             ) ;_ end of PROGN
             (SETQ typ_t2 (STRCASE (STRCAT (RTOS ocpwid 2 0) " LF OF " pavetype (IF (AND waytype (EQ (TYPE waytype) 'STR))(STRCAT " " waytype) ""))))
;;;             (SETQ typ_t2 (STRCASE (STRCAT "EXISTING " pavetype (IF (AND waytype (EQ (TYPE waytype) 'STR))(STRCAT " " waytype) ""))))
           ) ;_ end of IF
;;;           (SETVAR "OSMODE" 512)
           (SETQ old_do_exist do_exist)
           (COND
             ((AND pavetype waytype (OR (EQ pavetype "GRAVEL") (EQ pavetype "SOIL"))(NOT(WCMATCH (STRCASE (STRCAT procpelayr)) "*OCNP*")))
               (SETQ typ_t1   (STRCASE (STRCAT pavetype " " waytype))
                     typ_t2   NIL
                     do_exist T
               ))
             ((AND pavetype (EQ pavetype "RIPRAP"))
               (SETQ typ_t1   (STRCASE pavetype)
                     typ_t2   NIL
                     do_exist T
               ))
             (T (SETQ do_exist NIL))
           ) ;_ end of COND
           (IF do_procps
             (command ".zoom" "c" (cdr(assoc 10(entget(entnext(cdr(assoc -2 procpedata)))))) "")
;;;             (PROGN
;;;               (PRINC "\nDO_PROCPS IS NIL! ")
;;;             )
           )
           (C:MLT)
           (SETQ do_exist old_do_exist)
    ) ;_ end of PROGN
    (PROGN (PRINC "\nMust select POLYLINE (and not LWPOLYLINE)")
           (PRINC (STRCAT "\nEntity selected: " (CDR (ASSOC 0 procpedata))))
           (PRINC)
    ) ;_ end of PROGN
  ) ;_ end of IF
  (if getstyle (getstyle ""))
;;;  (IF old_procposmode
;;;    (SETVAR "OSMODE" old_procposmode)
;;;  ) ;_ end of IF
  (IF old_procpcmdecho
    (SETVAR "CMDECHO" old_procpcmdecho)
  ) ;_ end of IF
  (SETQ *error* orig_procperror)
  (PRINC)
) ;_ end of defun
;|«Visual LISP© Format Options»
(120 2 15 2 T "end of " 100 9 2 0 nil nil nil T T)
;*** DO NOT add text below the comment! ***|;