;;;Update profile location and station / elevation text
;;;
;;;	Author:
;;;		Henry C. Francis
;;;		425 N. Ashe St.
;;;		Southern Pines, NC 28387
;;;
;;;	e-mail: hfrancis@pinehurst.net
;;;
;;;	Copyright: 1-14-98
;;;	   Edited: 2-21-99
;;;
;;;	All rights reserved.
;;;
(DEFUN c:USTAEL ()
  (IF (AND (> (GETVAR "cvport") 1) (EQ (GETVAR "tilemode") 0))
    nil
    (IF (EQ (GETVAR "tilemode") 0)
      (COMMAND "._mspace")
      (PRINC "\nPaper space is not active")
    ) ;_ end of if
  ) ;_ end of if
  (IF (AND uint ukword)
    nil
    (LOAD "uutils")
  ) ;_ end of if
  (SETQ
    rtview (ukword 1
                   "continue"
                   "Make the profile view current before continuing."
                   "continue"
           ) ;_ end of ukword
  ) ;_ end of setq
  (SETQ curvno (GETVAR "cvport"))
;;;  (REGAPP "ACAD")
  (SETQ cvpss (SSGET "X" (LIST (CONS 69 curvno))))
  (SETQ cvpent (ENTGET (SSNAME cvpss 0) (LIST "ACAD")))
  (SETQ vpscl (/ (GETVAR "viewsize") (CDR (ASSOC 41 cvpent))))
  (COND ((OR (EQ (GETVAR "lunits") 1) (EQ (GETVAR "lunits") 5))
         (PRINC (STRCAT "Viewport scale is: 1:"
                        (RTOS vpscl 2 4)
                        " (1:"
                        (RTOS vpscl 2 4)
                        ")"
                ) ;_ end of strcat
         ) ;_ end of princ
        )
        ((EQ (GETVAR "lunits") 2)
         (PRINC (STRCAT "Viewport scale is: 1\"="
                        (RTOS vpscl 2 4)
                        "' (1:"
                        (RTOS vpscl 2 4)
                        ")"
                ) ;_ end of strcat
         ) ;_ end of princ
        )
        ((EQ (GETVAR "lunits") 3)
         (PRINC (STRCAT "Viewport scale is: 1\"="
                        (RTOS (/ vpscl 12) 2 4)
                        "' (1:"
                        (RTOS vpscl 2 4)
                        ")"
                ) ;_ end of strcat
         ) ;_ end of princ
        )
        ((EQ (GETVAR "lunits") 4)
         (PRINC (STRCAT "Viewport scale is: "
                        (RTOS (/ 12.0000 vpscl) 5 4)
                        "\"=1'-0\" (1:"
                        (RTOS vpscl 2 4)
                        ")"
                ) ;_ end of strcat
         ) ;_ end of princ
        )
  ) ;_ end of cond
  (SETQ cvcntr    (GETVAR "viewctr")
        vrt_scale (ureal 1
                         ""
                         (STRCAT "Vertical scale " (CHR 40) "1\"=?" (CHR 41))
                         (IF vrt_scale
                           vrt_scale
                           10
                         ) ;_ end of IF
                  ) ;_ end of ureal
        vrt_fact  (/ vpscl vrt_scale)
        cvsize    (GETVAR "viewsize")
        cvscle    (/ cvsize (CDR (ASSOC 41 cvpent)))
        cvwdth    (* (CDR (ASSOC 40 cvpent)) cvscle)
        cvpllx    (- (CAR cvcntr) (/ cvwdth 2))
        cvplly    (/ (- (CADR cvcntr) (/ cvsize 2)) vrt_fact)
  ) ;_ end of SETQ
  (PRINC (STRCAT "\nCurrent Profile Beginning Station = "
                 (RTOS cvpllx 2 2)
         ) ;_ end of strcat
  ) ;_ end of princ
  (SETQ cursta (ureal 1
                      ""
                      "    New Profile Grid Beginning Station "
                      cvpllx
               ) ;_ end of uint
  ) ;_ end of setq
  (SETQ
    viewsta (ureal 1 "" "    New Viewport Beginning Station " cursta) ;_ end of uint
  ) ;_ end of setq
  (PRINC (STRCAT "\nCurrent Profile Base Elevation = "
                 (RTOS cvplly 2 0)
         ) ;_ end of strcat
  ) ;_ end of princ
  (SETQ cedatum (ureal 1 "" "    New Profile Base Elevation" cedatum))
  (SETQ sedata (SSGET "X"
                      '((-4 . "<OR")
                        (2 . "CPP40SPL")
                        (2 . "CPP50SPL")
                        (2 . "CMUD40SP")
                        (2 . "CMUD50SP")
                        (-4 . "OR>")
                       )
               ) ;_ end of SSGET
  ) ;_ end of SETQ
  (IF (> (SSLENGTH sedata) 1)
    (PROGN (COMMAND "._pspace")
           (PRINC "\nSelect Station/Elevation block to update: ")
           (SETQ sedata (SSGET '((-4 . "<OR")
                                 (2 . "CPP40SPL")
                                 (2 . "CPP50SPL")
                                 (2 . "CMUD40SP")
                                 (2 . "CMUD50SP")
                                 (-4 . "OR>")
                                )
                        ) ;_ end of SSGET
           ) ;_ end of SETQ
           (COMMAND "._mspace")
    ) ;_ end of PROGN
  ) ;_ end of IF
  (IF sedata
    (PROGN
      (SETQ lbelev_lst nil
            rbelev_lst nil
            sta_lst NIL
      ) ;_ end of SETQ
      (SETQ sedat      (ENTNEXT (SSNAME sedata 0))
            insert_ent sedat
      ) ;_ end of SETQ
      (WHILE (/= (CDR (ASSOC 0 (ENTGET sedat))) "SEQEND")
        (IF (EQ (CDR (ASSOC 0 (ENTGET sedat))) "ATTRIB")
          (COND ((EQ (SUBSTR (CDR (ASSOC 2 (ENTGET sedat))) 1 2) "LB")
                 (IF lbelev_lst
                   (SETQ lbelev_lst (APPEND lbelev_lst (LIST sedat)))
                   (SETQ lbelev_lst (LIST sedat))
                 ) ;_ end of IF
                 (SETQ sedat (ENTNEXT sedat))
                )
                ((EQ (SUBSTR (CDR (ASSOC 2 (ENTGET sedat))) 1 2) "RB")
                 (IF rbelev_lst
                   (SETQ rbelev_lst (APPEND rbelev_lst (LIST sedat)))
                   (SETQ rbelev_lst (LIST sedat))
                 ) ;_ end of IF
                 (SETQ sedat (ENTNEXT sedat))
                )
                ((EQ (TYPE (READ (CDR (ASSOC 2 (ENTGET sedat))))) 'INT)
                 (IF sta_lst
                   (SETQ
                     sta_lst (APPEND sta_lst
                                     (LIST (LIST sedat (ENTNEXT sedat)))
                             ) ;_ end of APPEND
                   ) ;_ end of SETQ
                   (SETQ sta_lst (LIST (LIST sedat (ENTNEXT sedat))))
                 ) ;_ end of IF
                 (SETQ sedat (ENTNEXT (ENTNEXT sedat)))
                )
          ) ;_ end of COND
          (SETQ sedat (ENTNEXT (ENTNEXT sedat)))
        ) ;_ end of IF
      ) ;_ end of WHILE
      (IF lbelev_lst
        (SETQ lbelev_lst (REVERSE lbelev_lst))
      ) ;_ end of if
      (IF rbelev_lst
        (SETQ rbelev_lst (REVERSE rbelev_lst))
      ) ;_ end of if
      (COND
        ((OR (EQ (CDR (ASSOC 2 (ENTGET (SSNAME sedata 0)))) "CPP40SPL")
             (EQ (CDR (ASSOC 2 (ENTGET (SSNAME sedata 0)))) "CMUD40SP")
         ) ;_ end of OR
         (SETQ grdwid 2.5)
        )
        ((OR (EQ (CDR (ASSOC 2 (ENTGET (SSNAME sedata 0)))) "CPP50SPL")
             (EQ (CDR (ASSOC 2 (ENTGET (SSNAME sedata 0)))) "CMUD50SP")
         ) ;_ end of OR
         (SETQ grdwid 2.0)
        )
        (T (SETQ grdwid 2.5))
      ) ;_ end of COND
      (SETQ csdndx 0)
      (panprv)
      (IF (EQ (SETQ
                updatt (ukword 1
                               "Yes No"
                               "Update station and elevation attributes?"
                               updatt
                       ) ;_ end of ukword
              ) ;_ end of setq
              "Yes"
          ) ;_ end of eq
        (PROGN (FOREACH n sta_lst
                 (SETQ csdatc
                        (ITOA
                          (FIX (/ (+ (* csdndx grdwid vpscl) cursta) 100))
                        ) ;_ end of ITOA
                 ) ;_ end of SETQ
                 (SETQ csdatp
                        (STRCAT
                          "+"
                          (RTOS (REM (+ (* csdndx grdwid vpscl) cursta) 100)
                                2
                                0
                          ) ;_ end of RTOS
                        ) ;_ end of STRCAT
                 ) ;_ end of SETQ
                 (IF (WCMATCH csdatp "+#")
                   (SETQ csdatp (STRCAT csdatp "0"))
                 ) ;_ end of if
                 (SETQ sta#_ent (ENTGET (CAR n))
                       plus_ent (ENTGET (CADR n))
                 ) ;_ end of setq
                 (SETQ sta#_ent (SUBST (CONS 1 csdatc)
                                       (ASSOC 1 sta#_ent)
                                       sta#_ent
                                ) ;_ end of SUBST
                 ) ;_ end of setq
                 (ENTMOD sta#_ent)
                 (SETQ plus_ent (SUBST (CONS 1 csdatp)
                                       (ASSOC 1 plus_ent)
                                       plus_ent
                                ) ;_ end of SUBST
                 ) ;_ end of setq
                 (ENTMOD plus_ent)
                 (SETQ csdndx (1+ csdndx))
               ) ;_ end of foreach
               (IF (OR (= (REM (/ vpscl vrt_fact) 1) 0)
                       (= (REM (/ vpscl vrt_fact) 1) 0.5)
                   ) ;_ end of OR
                 (SETQ vrt_prec 0)
                 (IF (= (REM (/ vpscl vrt_fact) 1) 0.25)
                   (SETQ vrt_prec 1)
                   (SETQ vrt_prec 2)
                 ) ;_ end of if
               ) ;_ end of if
               (SETQ cedndx 0)
               (FOREACH n lbelev_lst
                 (SETQ cedatb
                        (RTOS
                          (+ cedatum (* cedndx grdwid (/ vpscl vrt_fact)))
                          2
                          vrt_prec
                        ) ;_ end of RTOS
                 ) ;_ end of SETQ
                 (SETQ elev_ent (ENTGET n))
                 (SETQ elev_ent (SUBST (CONS 1 cedatb)
                                       (ASSOC 1 elev_ent)
                                       elev_ent
                                ) ;_ end of SUBST
                 ) ;_ end of setq
                 (ENTMOD elev_ent)
                 (SETQ cedndx (1+ cedndx))
               ) ;_ end of foreach
               (SETQ cedndx 0)
               (FOREACH n rbelev_lst
                 (SETQ cedatb
                        (RTOS
                          (+ cedatum (* cedndx grdwid (/ vpscl vrt_fact)))
                          2
                          vrt_prec
                        ) ;_ end of RTOS
                 ) ;_ end of SETQ
                 (SETQ elev_ent (ENTGET n))
                 (SETQ elev_ent (SUBST (CONS 1 cedatb)
                                       (ASSOC 1 elev_ent)
                                       elev_ent
                                ) ;_ end of SUBST
                 ) ;_ end of setq
                 (ENTMOD elev_ent)
                 (SETQ cedndx (1+ cedndx))
               ) ;_ end of foreach
               (ENTUPD insert_ent)
        ) ;_ end of PROGN
        (IF (EQ (SETQ
                  updatt (ukword 1
                                 "Yes No"
                                 "Update right side elevation attributes?"
                                 "No"
                         ) ;_ end of ukword
                ) ;_ end of setq
                "Yes"
            ) ;_ end of eq
          (PROGN (SETQ cedndx 0)
                 (FOREACH n rbelev_lst
                   (SETQ
                     cedatb (RTOS (+ cedatum
                                     (* cedndx grdwid (/ vpscl vrt_fact))
                                  ) ;_ end of +
                                  2
                                  vrt_prec
                            ) ;_ end of RTOS
                   ) ;_ end of SETQ
                   (SETQ elev_ent (ENTGET n))
                   (SETQ elev_ent (SUBST (CONS 1 cedatb)
                                         (ASSOC 1 elev_ent)
                                         elev_ent
                                  ) ;_ end of SUBST
                   ) ;_ end of setq
                   (ENTMOD elev_ent)
                   (SETQ cedndx (1+ cedndx))
                 ) ;_ end of foreach
                 (ENTUPD insert_ent)
          ) ;_ end of progn
        ) ;_ end of if
      ) ;_ end of IF
    ) ;_ end of PROGN
  ) ;_ end of IF
  (PRINC)
) ;_ end of defun
(DEFUN panprv ()
  (PROGN (SETQ nvctrx (+ viewsta (/ cvwdth 2))
               nvctry (+ (* cedatum vrt_fact) (/ cvsize 2))
               pxdist (- (CAR cvcntr) nvctrx)
               pydist (- (CADR cvcntr) nvctry)
         ) ;_ end of setq
         (PRINC (STRCAT "dX=" (RTOS pxdist) ", dY=" (RTOS pydist)))
         (COMMAND "._zoom"
                  "c"
                  (STRCAT (RTOS nvctrx) "," (RTOS nvctry))
                  ""
         ) ;_ end of command
  ) ;_ end of progn
) ;_ end of defun


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