;;;
;;;
;;;>	Author:	Henry C. Francis
;;;>		425 N. Ashe St.
;;;>		Southern Pines, NC 28387
;;;>		http://paracadd.com
;;;>		All rights reserved.
;;;
;;;>		COPYRIGHT: 
;;;>		   EDITED: 10-17-2000
;;;
(DEFUN c:vtoh ()
  (SETQ vsf_ent (ENTSEL "\nSelect grade polyline"))
  (IF vsf_ent (SETQ vsf_ent (ENTGET (CAR vsf_ent))))
  (SETQ sta_to_do (ureal 1
                         ""
                         "Station of Alignment at Cross Section"
                         (IF sta_to_do
                           sta_to_do
                         ) ;_ end of if
                  ) ;_ end of ureal
  ) ;_ end of setq
  (SETQ int_sta (upoint 1 "" "Centerline intersection point of Cross Section" nil nil))
  (SETQ vert_sclfac
         (ureal 1
                ""
                "Vertical scale factor of Cross Section"
                (IF vert_sclfac
                  vert_sclfac
                ) ;_ end of if
         ) ;_ end of ureal
  ) ;_ end of setq
  (get_sta_pt sta_to_do)
  (SETQ pnt_to_do sta_pt)
  (SETQ vsf_data nil)
  (IF (EQ (CDR (ASSOC 0 vsf_ent)) "LWPOLYLINE")
         (FOREACH n vsf_ent
           (IF (EQ (CAR n) 10)
             (IF vsf_data
               (SETQ vsf_data (APPEND vsf_data (LIST (LIST (- (CADR n) (CAR int_sta)) (/ (CADDR n) vert_sclfac) 0))))
               (SETQ vsf_data (LIST (LIST (- (CADR n) (CAR int_sta)) (/ (CADDR n) vert_sclfac) 0)))
             ) ;_ end of if
           ) ;_ end of if
         ) ;_ end of foreach
         (PRINC "\nLWPOLYLINE NOT selected!")
  ) ;_ end of if
  (IF vsf_data
    (PROGN (SETQ fault_data nil)
           (FOREACH n vsf_data
             (SETQ n_pnt (POLAR pnt_to_do (+ sta_ang (* PI 0.5)) (CAR n)))
             (SETQ n_pnt (LIST (CAR n_pnt) (CADR n_pnt) (CADR n)))
             (IF fault_data
               (SETQ fault_data (APPEND fault_data (LIST n_pnt)))
               (SETQ fault_data (LIST n_pnt))
             ) ;_ end of if
           ) ;_ end of foreach
           (SETQ cnt 0)
           (ENTMAKE (LIST (CONS 0 "POLYLINE")
                          (CONS 66 1)
                          (CONS 10 (NTH 0 fault_data))
                          (CONS 40 0)
                          (CONS 41 0)
                          (CONS 62 256)
                          (CONS 70 8)
                    ) ;_ end of list
           ) ;_ end of entmake
           (WHILE (< cnt (LENGTH fault_data))
             (ENTMAKE (LIST (CONS 0 "VERTEX")
                            (CONS 10 (NTH cnt fault_data))
                            (CONS 40 0)
                            (CONS 41 0)
                            (CONS 62 256)
                            (CONS 70 32)
                      ) ;_ end of list
             ) ;_ end of entmake
             (SETQ cnt (1+ cnt))
           ) ;_ end of while
           (ENTMAKE (LIST (CONS 0 "SEQEND")) ;_ end of LIST
           ) ;_ end of ENTMAKE
    ) ;_ end of progn
  ) ;_ end of if
  (princ)
) ;_ 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!***|;