;;;
;;;
;;;>	Author:	Henry C. Francis
;;;>		425 N. Ashe St.
;;;>		Southern Pines, NC 28387
;;;>		http://paracadd.com
;;;>		All rights reserved.
;;;
;;;>		COPYRIGHT: 
;;;>		   EDITED: 06-27-2003
;;;
(DEFUN c:pppset (/            exppselent   exppent      expplaylst
                 layer_name   laytbldat    sglcollst    sglltlst
                 dblcollst    dblltlst
                )
  (SETQ exppselent (NENTSEL "\nSelect ParaPIPE piping to match"))
  (IF exppselent
    (SETQ exppent (ENTGET (CAR exppselent)))
  ) ;_ end of if
  (SETQ expplaylst nil)
  (IF
;;;    (AND
;;;      (ASSOC 330 exppent)
    (WCMATCH
      (STRCASE (CDR (ASSOC 8 exppent)))
      "*[A C E F G I L M O P Q S T Z]?????[1 2 3 4 5 6 7 8 9 A B C D E F G H I]?[S D T]?#P*"
    ) ;_ end of WCMATCH
;;;    ) ;_ end of and
     (PROGN
       (SETQ draw_hid "0")              ;initialize options
       (SETQ draw_dbl "0")
       (SETQ draw_sgl "0")
       (SETQ
         matchelev (ukword
                     1
                     "Yes No"
                     (STRCAT
                       "Do you want to match this pipe elevation of "
                       (RTOS (CADDDR (ASSOC 10 exppent)))
                     ) ;_ end of strcat
                     matchelev
                   ) ;_ end of ukword
       ) ;_ end of SETQ
       (IF (EQ matchelev "Yes")
         (PROGN
           (SETQ cur_elev (CADDDR (ASSOC 10 exppent)))
                                        ; Fix this to be a temporary setting (user variable) in PARA
           (SETVAR "ELEVATION" cur_elev)
         ) ;_ end of PROGN
       ) ;_ end of IF
       (SETQ exppentlay (STRCASE (CDR (ASSOC 8 exppent))))
       (SETQ layer_next (TBLNEXT "layer" T)
             layer_name (STRCASE (CDR (ASSOC 2 layer_next)))
       ) ;_ end of SETQ
       (WHILE (AND layer_next layer_name)
         (IF (WCMATCH
               layer_name
               (STRCAT
                 "*"
                 (SUBSTR exppentlay 1 1)
                 "?"
                 (SUBSTR exppentlay 3 4)
                 "[1 2 3 4 5 6 7 8 9 A B C D E F G H I]?[S D]"
                 (SUBSTR exppentlay 10 3)
                 "*"
               ) ;_ end of STRCAT
             ) ;_ end of WCMATCH
           (PROGN
             (WHILE
               (WCMATCH layer_name "*|*")
                (SETQ layer_name (SUBSTR layer_name 2))
             ) ;_ end of WHILE
             (SETQ
               layer_name
                (STRCASE (CDR (ASSOC 2 layer_next)))
             ) ;_ end of SETQ
           ) ;_ end of PROGN
         ) ;_ end of IF
         (IF (MEMBER layer_name expplaylst)
           nil
           (PROGN
             (SETQ expplaylst
                    (APPEND expplaylst (LIST layer_name))
             ) ;_ end of SETQ
             (IF (EQ (SUBSTR layer_name 13 4) "NPLT")
               (SETQ draw_hid "1")      ;turn on hiding option
             ) ;_ end of if
             (SETQ pipe_mjrg (SUBSTR layer_name 1 1))
                                        ; set major group
             (SETQ pipe_minr (SUBSTR layer_name 3 4))
                                        ; set minor group
             (COND                      ; set status
               ((EQ (SUBSTR layer_name 8 1) "R")
                (SETQ status "stat_remain")
               )
               ((EQ (SUBSTR layer_name 8 1) "D")
                (SETQ status "stat_demolish")
               )
               ((EQ (SUBSTR layer_name 8 1) "F")
                (SETQ status "stat_future")
               )
               ((EQ (SUBSTR layer_name 8 1) "N")
                (SETQ status "stat_new")
               )
             ) ;_ end of cond
             (COND
               ((EQ (SUBSTR layer_name 9 1) "D")
                (SETQ draw_dbl "1")
                                        ; turn on double-line option
                (SETQ laytbldat (TBLSEARCH "layer" layer_name))
                (IF
                  (OR
                    (AND dblcollst
                         (MEMBER (CDR (ASSOC 62 laytbldat))
                                 dblcollst
                         ) ;_ end of MEMBER
                    ) ;_ end of and
                    (WCMATCH layer_name "*NPLT*")
                  ) ;_ end of or
                   nil
                   (SETQ
                     dblcollst
                      (APPEND
                        dblcollst
                        (LIST (CDR (ASSOC 62 laytbldat)))
                      ) ;_ end of append
                   ) ;_ end of setq
                ) ;_ end of if
                (IF
                  (OR
                    (AND
                      dblltlst
                      (MEMBER (CDR (ASSOC 6 laytbldat)) dblltlst)
                    ) ;_ end of and
                    (WCMATCH layer_name "*NPLT*")
                  ) ;_ end of or
                   nil
                   (SETQ dblltlst
                          (APPEND dblltlst
                                  (LIST (CDR (ASSOC 6 laytbldat)))
                          ) ;_ end of append
                   ) ;_ end of setq
                ) ;_ end of if
                                        ; determine whether this is a fitting or pipe wall
                                        ; set double-line fitting color
                                        ; set double-line pipe color
                                        ; set double-line fitting linetype
                                        ; set double-line pipe linetype
               )
               ((EQ (SUBSTR layer_name 9 1) "S")
                (SETQ draw_sgl "1")
                                        ; turn on single-line option
                (SETQ laytbldat (TBLSEARCH "layer" layer_name))
                (IF
                  (AND
                    sglcollst
                    (MEMBER (CDR (ASSOC 62 laytbldat)) sglcollst)
                    (NOT (WCMATCH layer_name "*NPLT*"))
                  ) ;_ end of and
                   nil
                   (SETQ
                     sglcollst
                      (APPEND
                        sglcollst
                        (LIST (CDR (ASSOC 62 laytbldat)))
                      ) ;_ end of append
                   ) ;_ end of setq
                ) ;_ end of if
                (IF
                  (AND sglltlst
                       (MEMBER (CDR (ASSOC 6 laytbldat)) sglltlst)
                       (NOT (WCMATCH layer_name "*NPLT*"))
                  ) ;_ end of and
                   nil
                   (SETQ sglltlst
                          (APPEND sglltlst
                                  (LIST (CDR (ASSOC 6 laytbldat)))
                          ) ;_ end of append
                   ) ;_ end of setq
                ) ;_ end of if
                                        ; determine whether this is a fitting or pipe wall
                                        ; set single-line fitting color
                                        ; set single-line fitting linetype
                                        ; set single-line pipe color
                                        ; set single-line pipe linetype
               )
             ) ;_ end of cond
           ) ;_ end of progn
         ) ;_ end of if
         (SETQ layer_next (TBLNEXT "layer"))
         (IF layer_next
           (SETQ layer_name (STRCASE (CDR (ASSOC 2 layer_next))))
         ) ;_ end of SETQ
       ) ;_ end of WHILE
       (IF (> (LENGTH dblcollst) 1)
         (PROGN
           (SETQ ppdbl_colr
                  (uint
                    1
                    ""
                    (STRCAT "Fitting and pipe double-line colors: "
                            (ITOA (CAR dblcollst))
                            ", "
                            (ITOA (CADR dblcollst))
                            ". Which is the fitting color?"
                    ) ;_ end of strcat
                    (CAR dblcollst)
                  ) ;_ end of uint
           ) ;_ end of setq
           (SETQ dft_colr ppdbl_colr)
           (IF (EQ (CAR dblcollst) ppdbl_colr)
             (SETQ dbl_colr (CADR dblcollst))
             (SETQ dbl_colr (CAR dblcollst))
           ) ;_ end of if
         ) ;_ end of progn
         (SETQ dbl_colr (CAR dblcollst)
               dft_colr dbl_colr
         ) ;_ end of setq
       ) ;_ end of if
       (IF (> (LENGTH dblltlst) 1)
         (PROGN
           (SETQ ppdbl_ltname
                  (ustr
                    1
                    (STRCAT
                      "Fitting and pipe double-line linetypes: "
                      (CAR dblltlst)
                      ", "
                      (CADR dblltlst)
                      ". Which is the fitting linetype?"
                    ) ;_ end of strcat
                    (CAR dblltlst)
                    nil
                  ) ;_ end of ustr
           ) ;_ end of setq
           (SETQ dft_ltname (STRCASE ppdbl_ltname T))
           (IF (EQ (CAR dblltlst) ppdbl_ltname)
             (SETQ dbl_ltname (STRCASE (CADR dblltlst) T))
             (SETQ dbl_ltname (STRCASE (CAR dblltlst) T))
           ) ;_ end of if
         ) ;_ end of progn
         (IF dblltlst
           (SETQ dbl_ltname (STRCASE (CAR dblltlst) T)
                 dft_ltname dbl_ltname
           ) ;_ end of setq
         ) ;_ end of IF
       ) ;_ end of if
       (IF (> (LENGTH sglcollst) 1)
         (PROGN
           (SETQ ppsgl_colr
                  (uint
                    1
                    ""
                    (STRCAT "Fitting and pipe single-line colors: "
                            (ITOA (CAR sglcollst))
                            ", "
                            (ITOA (CADR sglcollst))
                            ". Which is the fitting color?"
                    ) ;_ end of strcat
                    (CAR sglcollst)
                  ) ;_ end of uint
           ) ;_ end of setq
           (SETQ sft_colr ppsgl_colr)
           (IF (EQ (CAR sglcollst) ppsgl_colr)
             (SETQ sgl_colr (CADR sglcollst))
             (SETQ sgl_colr (CAR sglcollst))
           ) ;_ end of if
         ) ;_ end of progn
         (IF sglltlst
           (SETQ sgl_colr (CAR sglcollst)
                 dft_colr dft_colr
           ) ;_ end of setq
         ) ;_ end of IF
       ) ;_ end of if
       (IF (> (LENGTH sglltlst) 1)
         (PROGN
           (SETQ ppsgl_ltname
                  (ustr
                    1
                    (STRCAT
                      "Fitting and pipe single-line linetypes: "
                      (CAR sglltlst)
                      ", "
                      (CADR sglltlst)
                      ". Which is the fitting linetype?"
                    ) ;_ end of strcat
                    (CAR sglltlst)
                    nil
                  ) ;_ end of ustr
           ) ;_ end of setq
           (SETQ sft_ltname (STRCASE ppsgl_ltname T))
           (IF (EQ (CAR sglltlst) ppsgl_ltname)
             (SETQ sgl_ltname (STRCASE (CADR sglltlst) T))
             (SETQ sgl_ltname (STRCASE (CAR sglltlst) T))
           ) ;_ end of if
         ) ;_ end of progn
         (IF sglltlst
           (SETQ sgl_ltname (STRCASE (CAR sglltlst) T)
                 sft_ltname sgl_ltname
           ) ;_ end of setq
         ) ;_ end of IF
       ) ;_ end of if
     ) ;_ end of progn
     (PROGN
       (PRINC "\nNo entity on a ParaPIPE layer was found! ")
       (PRINC)
     ) ;_ end of PROGN
  ) ;_ end of if
  (PRINC)
) ;_ end of defun
;|«Visual LISP© Format Options»
(72 2 40 2 T "end of " 60 9 2 1 0 nil T nil T)
;*** DO NOT add text below the comment! ***|;