;;;Requires: LINE entities drawn on layer C-EROC1DATA in profile ;;; X-coordinates must equal Station values ;;; Y-coordinates must equal Elevation values at any vertical scale factor (can be x1 or any other factor, x10 is common) ;;; ;;;Useage: C:DRAWECDATA (used with GPDGN alignment profiles) ;;; Use to Draw lines along existing grade in profile from grade-break to grade-break wherever erosion control measures are to be used. ;;; Can be done manually, C:DRAWECDATA is to assist in doing this ;;; C:ECDATA (used with GPDGN alignment profiles) ;;; Use after lines are drawn to export station, elevation and slope information along your finish grade for further analysis and/or use in other documents. ;;; Exported data is comma delimited with the first row containing column headings. ;;; ;;; Author: Henry C. Francis ;;; 425 N. Ashe St. ;;; Southern Pines, NC 28387 ;;; http://paracadd.com ;;; All rights reserved. ;;; ;;; COPYRIGHT: 1/15/09 ;;; EDITED: 1/15/09 ;;; (DEFUN ecdata_error (msg /) (IF old_osmode (SETVAR "osmode" old_osmode) ) ;_ end of IF (CLOSE ecdata_out) (IF old_aup (SETVAR "auprec" old_aup) ) ;_ end of IF (IF old_lup (SETVAR "luprec" old_lup) ) ;_ end of IF (SETQ *error* (IF old_ecdata_error old_ecdata_error NIL ) ;_ end of IF ) ;_ end of SETQ (PRINC "\n") (PRINC msg) ;;; (princ "\n") ;;; (princ dopt) (PRINC) ) ;_ end of DEFUN (DEFUN c:ecdata () (SETQ old_ecdata_error *error*) (SETQ *error* ecdata_error) (SETQ old_aup (GETVAR "auprec")) (SETQ old_lup (GETVAR "luprec")) (SETVAR "auprec" 8) (SETVAR "luprec" 8) (IF ureal NIL (LOAD "ureal" "\nFile UREAL.LSP not loaded! ") ) ;_ end of IF (SETQ v_fact (ureal 1 "" "Vertical scale factor?" (IF v_fact v_fact 1.0 ) ;_ end of if ) ;_ end of ureal ) ;_ end of SETQ (SETQ ecdata_ss (SSGET "X" '((0 . "LINE") (8 . "C-EROC1DATA")))) (SETQ ecdata_len (SSLENGTH ecdata_ss)) (SETQ ecdata_cnt 0) (SETQ ecdata_out_fn (GETFILED "EC Data Output File" (STRCAT (GETVAR "DWGPREFIX") (IF aln_name (STRCAT aln_name " EC Data") "EC Data" ) ;_ end of IF ) ;_ end of STRCAT "csv" 1 ) ;_ end of GETFILED ) ;_ end of SETQ (SETQ ecdata_out (OPEN ecdata_out_fn "w")) (WRITE-LINE "Begin Sta.,Begin Elev.,End Sta.,End Elev.,% Slope,GPDGN Begin Sta.,GPDGN End Sta." ecdata_out ) ;_ end of WRITE-LINE (WHILE (< ecdata_cnt ecdata_len) (SETQ this_data (ENTGET (SSNAME ecdata_ss ecdata_cnt)) this_beg_sta (MIN (CADR (ASSOC 10 this_data)) (CADR (ASSOC 11 this_data)) ) ;_ end of MIN this_end_sta (MAX (CADR (ASSOC 10 this_data)) (CADR (ASSOC 11 this_data)) ) ;_ end of MAX this_beg_elev (/ (IF (EQ this_beg_sta (CADR (ASSOC 10 this_data))) (CADDR (ASSOC 10 this_data)) (CADDR (ASSOC 11 this_data)) ) ;_ end of IF v_fact ) ;_ end of / this_end_elev (/ (IF (EQ this_end_sta (CADR (ASSOC 10 this_data))) (CADDR (ASSOC 10 this_data)) (CADDR (ASSOC 11 this_data)) ) ;_ end of IF v_fact ) ;_ end of / this_slope (/ (- (ATOF(RTOS this_end_elev 2 4))(ATOF(RTOS this_beg_elev 2 4))) ;rise (- (ATOF(RTOS this_end_sta 2 4))(ATOF(RTOS this_beg_sta 2 4))) ;run ) ;_ end of / ) ;_ end of SETQ (WRITE-LINE (STRCAT (RTOS this_beg_sta 2 0) "," (RTOS this_beg_elev 2 1) "," (RTOS this_end_sta 2 0) "," (RTOS this_end_elev 2 1) "," (RTOS (* this_slope 100.0) 2 2) "," (RTOS (1+ this_beg_sta) 2 0) "," (RTOS (1- this_end_sta) 2 0) ) ;_ end of STRCAT ecdata_out ) ;_ end of WRITE-LINE (SETQ ecdata_cnt (1+ ecdata_cnt)) ) ;_ end of WHILE (CLOSE ecdata_out) (IF old_osmode (SETVAR "osmode" old_osmode) ) ;_ end of IF (IF old_aup (SETVAR "auprec" old_aup) ) ;_ end of IF (IF old_lup (SETVAR "luprec" old_lup) ) ;_ end of IF (SETQ *error* (IF old_ecdata_error old_ecdata_error NIL ) ;_ end of IF ) ;_ end of SETQ (PRINC) ) ;_ end of defun (DEFUN c:drawecdata () (IF (SETQ thislayenam (TBLOBJNAME "LAYER" "C-EROC1DATA")) (PROGN (SETQ thislayent (ENTGET thislayenam)) (SETQ thislayent (SUBST (CONS 62 1) (ASSOC 62 thislayent) thislayent ) ;_ end of SUBST ) ;_ end of SETQ (SETQ thislayent (SUBST (CONS 6 "Continuous") (ASSOC 6 thislayent) thislayent ) ;_ end of SUBST ) ;_ end of SETQ (SETQ thislayent (SUBST (CONS 70 0) (ASSOC 70 thislayent) thislayent ) ;_ end of SUBST ) ;_ end of SETQ (SETQ thislayent (SUBST (CONS 290 0) (ASSOC 290 thislayent) thislayent ) ;_ end of SUBST ) ;_ end of SETQ (ENTMOD thislayent) (ENTUPD (CDR (ASSOC -1 thislayent))) (SETQ thiscolor NIL thisltype NIL thislayent NIL thislayenam NIL ) ;_ end of SETQ ) ;_ end of PROGN (ENTMAKE (LIST (CONS 0 "LAYER") (CONS 100 "AcDbSymbolTableRecord") (CONS 100 "AcDbLayerTableRecord") (CONS 2 "C-EROC1DATA") (CONS 70 0) (CONS 62 1) (CONS 6 "Continuous") (CONS 290 0) ) ;_ end of LIST ) ;_ end of ENTMAKE ) ;_ end of IF (SETVAR "clayer" "C-EROC1DATA") (COMMAND ".LINE") (PRINC) ) ;_ end of DEFUN ;|«Visual LISP© Format Options» (72 2 40 2 T "end of " 60 9 2 0 0 T T nil T) ;*** DO NOT add text below the comment! ***|;