;;;Sets ParaPIPE parameters to match previously drawn ParaPIPE entities
;;;
;;;>	Author:	Henry C. Francis
;;;>		425 N. Ashe St.
;;;>		Southern Pines, NC 28387
;;;>		http://paracadd.com
;;;>		All rights reserved.
;;;
;;;>		COPYRIGHT: 4/2003
;;;>		   EDITED: 11-10-2003
;;;
(DEFUN c:psets (/            exppselent   exppent      expplaylst
                 layer_name   laytbldat    sglcollst    sglltlst
                 dblcollst    dblltlst    status_lst
                )
  (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 "
                       (IF(AND
                            (EQ(CDR(ASSOC 0 exppent))"LWPOLYLINE")
                            (ASSOC 38 exppent)
                          )
                         (RTOS (CDR(ASSOC 38 exppent)))
                         (RTOS (CADDDR (ASSOC 10 exppent)))
                       )
                       "? "
                     ) ;_ end of strcat
                     (IF matchelev matchelev "Yes")
                   ) ;_ end of ukword
       ) ;_ end of SETQ
       (IF (EQ matchelev "Yes")
         (PROGN
           (SETQ cur_elev
                       (IF(AND
                            (EQ(CDR(ASSOC 0 exppent))"LWPOLYLINE")
                            (ASSOC 38 exppent)
                          )
                         (CDR(ASSOC 38 exppent))
                         (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
       (SETQ pipe_mjrg (SUBSTR exppentlay 1 1)); set major group
       (SETQ pipe_minr (SUBSTR exppentlay 3 4)); set minor group
       (WHILE (AND layer_next layer_name)
         (princ "\n\t\t\t")
         (PRINC layer_name)
         (princ)
         (IF (WCMATCH
               layer_name
               (STRCAT
                 "*"
                 (SUBSTR exppentlay 1 6)
                 "[1 2 3 4 5 6 7 8 9 A B C D E F G H I]"
                 (SUBSTR exppentlay 7 2)
                 "[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
             (COND                      ; set status
               ((EQ (SUBSTR layer_name 8 1) "R")
                (IF (MEMBER "Remain" status_lst)
                  NIL
                  (SETQ status_lst (APPEND status_Lst (LIST "Remain")))
                )
               )
               ((EQ (SUBSTR layer_name 8 1) "D")
                (IF (MEMBER "Demolish" status_lst)
                  NIL
                  (SETQ status_lst (APPEND status_Lst (LIST "Demolish")))
                )
               )
               ((EQ (SUBSTR layer_name 8 1) "F")
                (IF (MEMBER "Future" status_lst)
                  NIL
                  (SETQ status_lst (APPEND status_Lst (LIST "Future")))
                )
               )
               ((EQ (SUBSTR layer_name 8 1) "N")
                (IF (MEMBER "New" status_lst)
                  NIL
                  (SETQ status_lst (APPEND status_Lst (LIST "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
                  (OR
                    (AND
                      sglcollst
                      (MEMBER (CDR (ASSOC 62 laytbldat)) sglcollst)
                    )
                    (WCMATCH layer_name "*NPLT*")
                  )
                   nil
                   (SETQ
                     sglcollst
                      (APPEND
                        sglcollst
                        (LIST (CDR (ASSOC 62 laytbldat)))
                      ) ;_ end of append
                   ) ;_ end of setq
                ) ;_ end of if
                (IF
                  (OR
                    (AND
                      sglltlst
                      (MEMBER (CDR (ASSOC 6 laytbldat)) sglltlst)
                    )
                    (WCMATCH layer_name "*NPLT*")
                  )
                   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 status_lst) 1)
         (PROGN
           (SETQ statuskwd NIL)
           (FOREACH n status_lst
             (IF statuskwd
               (SETQ statuskwd (STRCAT statuskwd " " n))
               (SETQ statuskwd n)
             )
           )
           (SETQ status_name
                  (ukword
                    1
                    statuskwd
                    (STRCAT
                      "Found these as the possible status: "
                      statuskwd
                      ". Which is the status? "
                    ) ;_ end of strcat
                    (IF status_name status_name (CAR status_lst))
                  )
           ) ;_ end of setq
           (SETQ status (STRCAT "stat_" (strcase status_name T)))
         )
       )
       (IF (> (LENGTH dblcollst) 1)
         (PROGN
           (setq intstr nil)
           (foreach n dblcollst (if intstr (setq intstr (strcat intstr ", " (itoa n)))(setq intstr (itoa n))))
           (SETQ ppdbl_colr
                  (uint
                    1
                    ""
                    (STRCAT "Fitting and pipe double-line colors: "
                            intstr
                            ". Which is the pipe color? "
                    ) ;_ end of strcat
                    (IF ppdbl_colr ppdbl_colr (CAR dblcollst))
                  ) ;_ end of uint
           ) ;_ end of setq
           (SETQ dbl_colr (ABS ppdbl_colr))
           (SETQ ppdft_colr
                  (uint
                    1
                    ""
                    "Which is the fitting color? "
                    (IF ppdft_colr ppdft_colr (CADR dblcollst))
                  ) ;_ end of uint
           ) ;_ end of setq
           (SETQ dft_colr (ABS ppdft_colr))
         ) ;_ end of progn
       ) ;_ end of if
       (IF (> (LENGTH dblltlst) 1)
         (PROGN
           (SETQ dblltkwd NIL)
           (FOREACH n dblltlst
             (IF dblltkwd
               (SETQ dblltkwd (STRCAT dblltkwd " " n))
               (SETQ dblltkwd n)
             )
           )
           (SETQ ppdbl_ltname
                  (ukword
                    1
                    dblltkwd
                    (STRCAT
                      "Fitting and pipe double-line linetypes: "
                      dblltkwd
                      ". Which is the pipe linetype? "
                    ) ;_ end of strcat
                    (IF ppdbl_ltname ppdbl_ltname (CAR dblltlst))
                  ) ;_ end of ustr
           ) ;_ end of setq
           (SETQ dbl_ltname (STRCASE ppdbl_ltname T))
           (SETQ ppdft_ltname
                  (ukword
                    1
                    dblltkwd
                    "Which is the fitting linetype? "
                    (IF ppdft_ltname ppdft_ltname (CAR dblltlst))
                  )
           ) ;_ end of setq
           (SETQ dft_ltname (STRCASE ppdbl_ltname T))
         ) ;_ end of progn
       ) ;_ end of if
       (IF (> (LENGTH sglcollst) 1)
         (PROGN
           (setq intstr nil)
           (foreach n sglcollst (if intstr (setq intstr (strcat intstr ", " (itoa n)))(setq intstr (itoa n))))
           (SETQ ppsgl_colr
                  (uint
                    1
                    ""
                    (STRCAT "Fitting and pipe single-line colors: "
                            intstr
                            ". Which is the pipe color? "
                    ) ;_ end of strcat
                    (IF ppsgl_colr ppsgl_colr (CAR sglcollst))
                  ) ;_ end of uint
           ) ;_ end of setq
           (SETQ sgl_colr (ABS ppsgl_colr))
           (SETQ ppsft_colr
                  (uint
                    1
                    ""
                    "Which is the fitting color? "
                    (IF ppsft_colr ppsft_colr (CADR sglcollst))
                  ) ;_ end of uint
           ) ;_ end of setq
           (SETQ sft_colr (ABS ppsft_colr))
         ) ;_ end of progn
       ) ;_ end of if
       (IF (> (LENGTH sglltlst) 1)
         (PROGN
           (SETQ sglltkwd NIL)
           (FOREACH n sglltlst
             (IF sglltkwd
               (SETQ sglltkwd (STRCAT sglltkwd " " n))
               (SETQ sglltkwd n)
             )
           )
           (SETQ ppsgl_ltname
                  (ukword
                    1
                    sglltkwd
                    (STRCAT
                      "Fitting and pipe single-line linetypes: "
                      sglltkwd
                      ". Which is the pipe linetype? "
                    ) ;_ end of strcat
                    (IF ppsgl_ltname ppsgl_ltname (CAR sglltlst))
                  )
           ) ;_ end of setq
           (SETQ sgl_ltname (STRCASE ppsgl_ltname T))
           (SETQ ppsft_ltname
                  (ukword
                    1
                    sglltkwd
                    "Which is the fitting linetype? "
                    (IF ppsft_ltname ppsft_ltname (CADR sglltlst))
                  )
           ) ;_ end of setq
           (SETQ sft_ltname (STRCASE ppsft_ltname T))
         ) ;_ end of progn
       ) ;_ 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! ***|;