(DEFUN c:ppgen () (IF gpdgn_dlg# nil (SETQ gpdgn_dlg# (LOAD_DIALOG "gpdgn")) ) ;_ end of IF (SETQ newdlg_ppgen_dlg (NEW_DIALOG "ppgen_dlg" gpdgn_dlg# (IF defact_ppgen_dlg defact_ppgen_dlg "" ) ;_ end of IF (IF ppgen_loc ppgen_loc '(-1 -1) ) ;_ end of IF ) ;_ end of NEW_DIALOG ) ;_ end of SETQ (IF series_fnpfx (SET_TILE "series_fnpfx" series_fnpfx) (PROGN (SET_TILE "series_fnpfx" "01") (SETQ series_fnpfx "01") ) ;_ end of PROGN ) ;_ end of IF (IF sys_type (SET_TILE "sys_type" sys_type) (PROGN (SET_TILE "sys_type" "0") (SETQ sys_type "0") ) ;_ end of PROGN ) ;_ end of IF (IF hvpscale (COND ((EQ hvpscale 1.0) (SET_TILE "hvpscale" "0") ) ((EQ hvpscale 5.0) (SET_TILE "hvpscale" "1") ) ((EQ hvpscale 10.0) (SET_TILE "hvpscale" "2") ) ((EQ hvpscale 20.0) (SET_TILE "hvpscale" "3") ) ((EQ hvpscale 30.0) (SET_TILE "hvpscale" "4") ) ((EQ hvpscale 40.0) (SET_TILE "hvpscale" "5") ) ((EQ hvpscale 50.0) (SET_TILE "hvpscale" "6") ) ((EQ hvpscale 60.0) (SET_TILE "hvpscale" "7") ) ((EQ hvpscale 80.0) (SET_TILE "hvpscale" "8") ) ((EQ hvpscale 100.0) (SET_TILE "hvpscale" "9") ) ) ;_ end of COND (PROGN (SET_TILE "hvpscale" "6") (SETQ hvpscale 50.0) ) ;_ end of PROGN ) ;_ end of IF (IF vvpscale (COND ((EQ vvpscale 1.0) (SET_TILE "vvpscale" "0") ) ((EQ vvpscale 2.0) (SET_TILE "vvpscale" "1") ) ((EQ vvpscale 3.0) (SET_TILE "vvpscale" "2") ) ((EQ vvpscale 4.0) (SET_TILE "vvpscale" "3") ) ((EQ vvpscale 5.0) (SET_TILE "vvpscale" "4") ) ((EQ vvpscale 6.0) (SET_TILE "vvpscale" "5") ) ((EQ vvpscale 8.0) (SET_TILE "vvpscale" "6") ) ((EQ vvpscale 10.0) (SET_TILE "vvpscale" "7") ) ((EQ vvpscale 20.0) (SET_TILE "vvpscale" "8") ) ) ;_ end of COND (PROGN (SET_TILE "vvpscale" "4") (SETQ vvpscale 5.0) ) ;_ end of PROGN ) ;_ end of IF (IF sht_start (SET_TILE "sht_start" (ITOA sht_start)) (PROGN (SET_TILE "sht_start" "1") (SETQ sht_start 1) ) ;_ end of PROGN ) ;_ end of IF (IF init_sta (SET_TILE "init_sta" (RTOS init_sta 2 2)) (PROGN (SET_TILE "init_sta" "-100") (SETQ init_sta -100.00) ) ;_ end of PROGN ) ;_ end of IF (IF sht_nopfx (SET_TILE "sht_nopfx" sht_nopfx) (COND ((EQ sys_type "0") (SET_TILE "sht_nopfx" "WM") (SETQ sht_nopfx "WM") ) ((EQ sys_type "1") (SET_TILE "sht_nopfx" "SD") (SETQ sht_nopfx "SD") ) ((EQ sys_type "2") (SET_TILE "sht_nopfx" "FM") (SETQ sht_nopfx "FM") ) ((EQ sys_type "3") (SET_TILE "sht_nopfx" "GS") (SETQ sht_nopfx "GS") ) ) ;_ end of COND ) ;_ end of IF (ACTION_TILE "series_fnpfx" "(setq series_fnpfx (get_tile\"series_fnpfx\"))" ) ;_ end of ACTION_TILE (ACTION_TILE "sys_type" "(setq sys_type (get_tile\"sys_type\"))" ) ;_ end of ACTION_TILE (ACTION_TILE "hvpscale" "(setq hvpscale (rtos (get_tile\"hvpscale\")2 2))" ) ;_ end of ACTION_TILE (ACTION_TILE "vvpscale" "(setq vvpscale (rtos (get_tile\"vvpscale\")2 2))" ) ;_ end of ACTION_TILE (ACTION_TILE "sht_start" "(setq sht_start (atoi(get_tile\"sht_start\")))" ) ;_ end of ACTION_TILE (ACTION_TILE "init_sta" "(setq init_sta (atof(get_tile\"init_sta\")))" ) ;_ end of ACTION_TILE (ACTION_TILE "sht_nopfx" "(setq sht_nopfx (get_tile\"sht_nopfx\"))" ) ;_ end of ACTION_TILE (ACTION_TILE "generate_btn" "(SETQ ppwhat \"(tmppgen)\")(SETQ ppgen_loc(done_dialog 2))" ) ;_ end of ACTION_TILE (ACTION_TILE "cancel" "(SETQ ppwhat nil)(SETQ ppgen_loc(done_dialog))" ) ;_ end of ACTION_TILE (ACTION_TILE "help_param" "(help \"gpdgn.hlp\" \"GENERATE P+P SHEET SERIES\")" ) ;_ end of ACTION_TILE (COND (newdlg_ppgen_dlg (START_DIALOG) (SETQ newdlg_ppgen_dlg NIL) (IF ppwhat (EVAL (READ ppwhat)) ) ;_ end of IF (PRINC) ) (T (PRINC "\nERROR! Unable to start dialog. ")) ) ;_ end of COND ) ;_ end of DEFUN (DEFUN tmppgen (/ max_sht_ppgr min_sht_inv) (SETQ old_osmode (GETVAR "osmode")) (SETVAR "osmode" 0) (SETQ found_profvp NIL) (SETQ found_planvp NIL) (SETQ datum_lst NIL) (SETQ vpss (SSGET "X" '((0 . "VIEWPORT")))) (IF vpss ;;; Check viewports for Plan (VI02) and Profile (VI01) (PROGN (SETQ vpss_len (SSLENGTH vpss)) (SETQ vpss_step (1- vpss_len)) (WHILE (>= vpss_step 0) (SETQ step_vp (ENTGET (SSNAME vpss vpss_step))) (IF (WCMATCH (STRCASE (CDR (ASSOC 8 step_vp))) "C-VI0#7NPLT") (COND ((EQ (STRCASE (CDR (ASSOC 8 step_vp))) "C-VI017NPLT") (IF (EQ (CDR (ASSOC 68 step_vp)) 0) (SETQ found_profvp "OFF") (SETQ found_profvp T) ) ;_ end of IF ) ((EQ (STRCASE (CDR (ASSOC 8 step_vp))) "C-VI027NPLT") (IF (EQ (CDR (ASSOC 68 step_vp)) 0) (SETQ found_planvp "OFF") (SETQ found_planvp T) ) ;_ end of IF ) ) ;_ end of COND ) ;_ end of IF (SETQ vpss_step (1- vpss_step)) ) ;_ end of WHILE ) ;_ end of PROGN ) ;_ end of IF (IF (AND align_lst (EQ (GETVAR "tilemode") 0) (EQ found_planvp T) (EQ found_profvp T) ) ;_ end of AND (PROGN ;***************** start main program ************************ ;;; (SETQ sys_type (ukword 1 ;;; "GS FM SD WM" ;;; "Select type of system (GS FM SD WM)" ;;; (IF sys_type ;;; sys_type ;;; "GS" ;;; ) ;_ end of IF ;;; ) ;_ end of ukword ;;; ) ;_ end of SETQ ;;; (SETQ hvp_scale (ureal 1 ;;; "" ;;; "Enter horizontal scale (e.g., for 1\"=50' enter 50)" ;;; (IF hvp_scale ;;; hvp_scale ;;; 50 ;;; ) ;_ end of IF ;;; ) ;_ end of ureal ;;; ) ;_ end of SETQ ;;; (SETQ vvp_scale (ureal 1 ;;; "" ;;; "Enter vertical scale (e.g., for 1\"=5' enter 5)" ;;; (IF vvp_scale ;;; vvp_scale ;;; 5 ;;; ) ;_ end of IF ;;; ) ;_ end of ureal ;;; ) ;_ end of SETQ (SETQ sht_count sht_start) ;;; (SETQ sht_count ;;; (uint 1 ;;; "" ;;; "Enter first sheet number" ;;; (IF sht_start ;;; sht_start ;;; 1 ;;; ) ;_ end of IF ;;; ) ;_ end of ureal ;;; ) ;_ end of SETQ ;;; (SETQ sht_start sht_count) (dimscl) (SETQ sta_pt NIL) (SETQ shtpt_lst NIL) (SETQ sheets_lst NIL) (SETQ ppnt_lst align_lst) ;;; (SETQ start_sta (NTH 1 (NTH 0 ppnt_lst))) ;;; (SETQ pgrd_str "Enter profile grid beginning station") ;;; ;;;sht_space was removed. If problems with initial stations, restore sht_space ;;; ;;; (SETQ sht_space (ureal 1 ;;; "" ;;; "Enter distance between Match Lines (length of profile)" ;;; (IF sht_space ;;; sht_space ;;; 1300 ;;; ) ;_ end of IF ;;; ) ;_ end of ureal ;;; ) ;_ end of SETQ (SETQ init_sta NIL init_pts NIL ) ;_ end of SETQ ;;; (WHILE (OR (NOT init_pts) (NOT init_sta)) ;(< init_sta (- (NTH 1 (NTH 0 ppnt_lst)) sht_space))) ;;; (SETQ init_sta (ureal 1 ;;; "" ;;; pgrd_str ;;; (IF init_sta ;;; (IF (> init_sta (- (NTH 1 (NTH 0 ppnt_lst)) sht_space)) ;;; init_sta ;;; (* (ATOI (RTOS (/ (- (NTH 1 (NTH 0 ppnt_lst)) 50) 50) 2 0)) 50) ;;; ) ;_ end of IF ;;; 0.0 ;;; (* (ATOI (RTOS (/ (- (NTH 1 (NTH 0 ppnt_lst)) 50) 50) 2 0)) 50) ;;; ) ;_ end of IF ;;; ) ;_ end of ureal ;;; ) ;_ end of SETQ (SETQ start_sta init_sta) ;;; (IF (< init_sta (- (NTH 1 (NTH 0 ppnt_lst)) sht_space)) ;;; (PROGN (PRINC ;;; (STRCAT "\nAlignment begins more than " (RTOS sht_space 2 0) "' after specified beginning station!") ;;; ) ;_ end of PRINC ;;; (SETQ pgrd_str "Re-enter profile grid beginning station") ;;; ) ;_ end of PROGN ;;; ) ;_ end of IF (SETQ init_pts T) ;;; ) ;_ end of WHILE (SETQ mlsta_lst NIL) (SETQ sta_cnt 0) (WHILE (AND (< sta_cnt (LENGTH align_lst)) (< (NTH 1 (NTH sta_cnt align_lst)) start_sta) ) ;_ end of AND (SETQ sta_cnt (1+ sta_cnt)) ) ;_ end of WHILE (SETQ ppnt_lst (MEMBER (NTH sta_cnt align_lst) align_lst)) (FOREACH n ppnt_lst (IF (AND (OR (WCMATCH (NTH 0 n) "MATCH LINE") (EQ (NTH 5 n) 0)) (>= (NTH 1 n) init_sta) ) ;_ end of AND (PROGN (IF mlsta_lst (SETQ mlsta_lst (APPEND mlsta_lst (LIST (CONS sht_count (LIST prev_mlsta (NTH 1 n)) ) ;_ end of CONS ) ;_ end of LIST ) ;_ end of APPEND ) ;_ end of SETQ (SETQ mlsta_lst (LIST (CONS sht_count (LIST start_sta (NTH 1 n))) ) ;_ end of LIST ) ;_ end of SETQ ) ;_ end of IF (SETQ prev_mlsta (NTH 1 n)) (SETQ sht_count (1+ sht_count)) ) ;_ end of PROGN ) ;_ end of IF (SETQ last_n n) ) ;_ end of FOREACH (IF (NOT prev_mlsta) (SETQ mlsta_lst (APPEND mlsta_lst (LIST (CONS sht_count (LIST (NTH 1 (NTH 0 align_lst)) (NTH 1 last_n) ) ;_ end of LIST ) ;_ end of CONS ) ;_ end of LIST ) ;_ end of APPEND ) ;_ end of SETQ (SETQ mlsta_lst (APPEND mlsta_lst (LIST (CONS sht_count (LIST prev_mlsta (NTH 1 last_n)) ) ;_ end of CONS ) ;_ end of LIST ) ;_ end of APPEND ) ;_ end of SETQ ) ;_ end of IF (SETQ sht_count sht_start) (SETQ end_sta (CADDR (ASSOC sht_count mlsta_lst))) (SETQ first_init T) (IF (EQUAL mlsta_lst (LIST (CONS sht_count (LIST (NTH 1 (NTH 0 align_lst)) (NTH 1 last_n)) ) ;_ end of CONS ) ;_ end of LIST 0.0001 ) ;_ end of EQUAL (ALERT (STRCAT "\nNO MATCH LINES FOUND!\nMatch lines are required by PPGEN." ) ;_ end of STRCAT ) ;_ end of ALERT (PROGN (PRINC (STRCAT "\nFound " (ITOA (LENGTH mlsta_lst)) " match lines. " ) ;_ end of STRCAT ) ;_ end of PRINC (PRINC) (FOREACH n ppnt_lst (COND ((AND (OR (WCMATCH (NTH 0 n) "MATCH LINE") (EQ (NTH 5 n) 0)) shtpt_lst ) ;_ end of AND (SETQ shtpt_lst (APPEND shtpt_lst (LIST (NTH 9 n)))) (IF sheets_lst (SETQ sheets_lst (APPEND sheets_lst (LIST (CONS sht_count shtpt_lst)) ) ;_ end of APPEND ) ;_ end of SETQ (SETQ sheets_lst (LIST (CONS sht_count shtpt_lst))) ) ;_ end of IF (IF min_datum (SETQ min_datum (MIN min_datum (NTH 3 n))) (IF (EQ (TYPE (NTH 3 n)) 'REAL) (SETQ min_datum (NTH 3 n)) ) ;_ end of IF ) ;_ end of IF (IF max_datum (SETQ max_datum (MAX max_datum (NTH 2 n))) (IF (EQ (TYPE (NTH 2 n)) 'REAL) (SETQ max_datum (NTH 2 n)) ) ;_ end of IF ) ;_ end of IF ;;;datum_lst is the control for setting the profile view datum on each sheet. ;;;perfect this list and profile view will be perfected in PPGEN (IF (AND datum_lst min_datum) (SETQ datum_lst (APPEND datum_lst (LIST (CONS sht_count min_datum)) ) ;_ end of APPEND ) ;_ end of SETQ (IF min_datum (SETQ datum_lst (LIST (CONS sht_count min_datum))) ) ;_ end of IF ) ;_ end of IF (SETQ shtpt_lst (LIST (NTH 9 n))) (SETQ sht_count (1+ sht_count)) ) ((OR (WCMATCH (NTH 0 n) "MATCH LINE") (EQ (NTH 5 n) 0)) (SETQ shtpt_lst (LIST (NTH 9 n))) (IF (EQ (TYPE (NTH 3 n)) 'REAL) (SETQ min_datum (NTH 3 n) max_datum (NTH 2 n) ) ;_ end of SETQ ) ;_ end of IF (IF (EQ (LAST ppnt_lst) n) (IF sheets_lst (SETQ sheets_lst (APPEND sheets_lst (LIST (CONS sht_count shtpt_lst)) ) ;_ end of APPEND ) ;_ end of SETQ (SETQ sheets_lst (LIST (CONS sht_count shtpt_lst))) ) ;_ end of IF ) ;_ end of IF ) (T (IF shtpt_lst (SETQ shtpt_lst (APPEND shtpt_lst (LIST (NTH 9 n)))) (SETQ shtpt_lst (LIST (NTH 9 n))) ) ;_ end of IF (IF min_datum (SETQ min_datum (MIN min_datum (NTH 3 n))) (IF (EQ (TYPE (NTH 3 n)) 'REAL) (SETQ min_datum (NTH 3 n)) ) ;_ end of IF ) ;_ end of IF (IF max_datum (SETQ max_datum (MAX max_datum (NTH 2 n))) (IF (EQ (TYPE (NTH 2 n)) 'REAL) (SETQ max_datum (NTH 2 n)) ) ;_ end of IF ) ;_ end of IF ;;; (IF max_datum ;;; (SETQ min_datum (MIN max_datum (NTH 3 n))) ;;; (IF (EQ (TYPE (NTH 3 n)) 'REAL) ;;; (SETQ min_datum (NTH 3 n)) ;;; ) ;_ end of IF ;;; ) ;_ end of IF ;;; (IF min_datum ;;; (SETQ max_datum (MAX min_datum (NTH 3 n))) ;;; (IF (EQ (TYPE (NTH 3 n)) 'REAL) ;;; (SETQ max_datum (NTH 3 n)) ;;; ) ;_ end of IF ;;; ) ;_ end of IF ;;; (PRINC "\nMax_datum = ") ;;; (PRINC max_datum) ;;; (PRINC "\nMin_datum = ") ;;; (PRINC min_datum) (SETQ min_datum (+ min_datum 10.0)) ;;; (PRINC "\nMin_datum (adjusted) = ") ;;; (PRINC min_datum) (IF (EQ (LAST ppnt_lst) n) (PROGN (IF sheets_lst (SETQ sheets_lst (APPEND sheets_lst (LIST (CONS sht_count shtpt_lst)) ) ;_ end of APPEND ) ;_ end of SETQ (SETQ sheets_lst (LIST (CONS sht_count shtpt_lst))) ) ;_ end of IF (IF (AND datum_lst min_datum) (SETQ datum_lst (APPEND datum_lst (LIST (CONS sht_count min_datum)) ) ;_ end of APPEND ) ;_ end of SETQ (IF min_datum (SETQ datum_lst (LIST (CONS sht_count min_datum)) ) ;_ end of SETQ ) ;_ end of IF ) ;_ end of IF ) ;_ end of PROGN ) ;_ end of IF ) ) ;_ end of COND ;;; (IF (<= (NTH 1 n) end_sta) ;;; (IF init_pts ;;; (PROGN (SETQ sta_pt NIL) ;;; (get_sta_pt start_sta) ;;; (IF first_init ;;; (SETQ shtpt_lst (LIST (NTH 9 n))) ;;; (IF (MEMBER (LIST sta_pt) shtpt_lst) ;;; NIL ;;; (SETQ shtpt_lst (LIST sta_pt)) ;;; ) ;;; ) ;_ end of IF ;;; (SETQ init_pts NIL) ;;; (SETQ first_init NIL) ;;;;;; (IF (MEMBER (LIST (NTH 9 n)) shtpt_lst) ;;;;;; NIL ;;;;;; (SETQ shtpt_lst (APPEND shtpt_lst (LIST (NTH 9 n)))) ;;;;;; ) ;;; (SETQ min_datum (NTH 3 n)) ;;; ) ;_ end of PROGN ;;; (PROGN (IF (MEMBER (LIST (NTH 9 n)) shtpt_lst) NIL (SETQ shtpt_lst (APPEND shtpt_lst (LIST (NTH 9 ;;; n))))) ;;; (IF min_datum ;;; (SETQ min_datum (MIN min_datum (NTH 3 n))) ;;; (IF (EQ (TYPE (NTH 3 n)) 'REAL) ;;; (SETQ min_datum (NTH 3 n)) ;;; ) ;_ end of IF ;;; ) ;_ end of IF ;;; ) ;_ end of PROGN ;;; ) ;_ end of IF ;;; (PROGN (get_sta_pt end_sta) ;;; (IF (MEMBER (LIST sta_pt) shtpt_lst) ;;; NIL ;;; (SETQ shtpt_lst (APPEND shtpt_lst (LIST sta_pt))) ;;; ) ;;; (IF sheets_lst ;;; (SETQ sheets_lst (APPEND sheets_lst (LIST (CONS sht_count shtpt_lst)))) ;;; (SETQ sheets_lst (LIST (CONS sht_count shtpt_lst))) ;;; ) ;_ end of IF ;;; (SETQ start_sta end_sta) ;;; (SETQ end_sta (caddr (assoc sht_count mlsta_lst))) ;;; (IF (AND datum_lst min_datum) ;;; (SETQ datum_lst (APPEND datum_lst (LIST (CONS sht_count min_datum)))) ;;; (IF min_datum ;;; (SETQ datum_lst (LIST (CONS sht_count min_datum))) ;;; ) ;_ end of IF ;;; ) ;_ end of IF ;;; (SETQ min_datum NIL) ;;; (get_sta_pt start_sta) ;;; (SETQ shtpt_lst (LIST sta_pt)) ;;;;;; (IF (MEMBER (LIST (NTH 9 n)) shtpt_lst) ;;;;;; NIL ;;;;;; (SETQ shtpt_lst (APPEND shtpt_lst (LIST (NTH 9 n)))) ;;;;;; ) ;;; (SETQ sht_count (1+ sht_count)) ;;; ) ;_ end of PROGN ;;; ) ;_ end of IF ) ;_ end of FOREACH ;;; (get_sta_pt end_sta) ;;; (IF (MEMBER (LIST sta_pt) shtpt_lst) ;;; NIL ;;; (SETQ shtpt_lst (APPEND shtpt_lst (LIST sta_pt))) ;;; ) ;;; (IF sheets_lst ;;; (SETQ sheets_lst (APPEND sheets_lst (LIST (CONS sht_count shtpt_lst)))) ;;; (SETQ sheets_lst (LIST (CONS sht_count shtpt_lst))) ;;; ) ;_ end of IF ;;; (PRINC (STRCAT "\nReady to generate " (ITOA (1+ (LENGTH mlsta_lst))) " plan & profile sheets. ")) ;;; (PRINC) ;;; (SETQ sht_nopfx (ustr 1 ;;; "Sheet number prefix? (~ for none) " ;;; (IF sht_nopfx ;;; sht_nopfx ;;; "W" ;;; ) ;_ end of IF ;;; T ;;; ) ;_ end of ustr ;;; ) ;_ end of SETQ (IF (EQ sht_nopfx "~") (SETQ sht_nopfx "") ) ;_ end of IF ;;;(Princ "\n\t\tsheets_lst = ") ;;;(PRINC sheets_lst) (FOREACH n sheets_lst ;;; (IF init_sht NIL (C:QSAVE)) ;;; (PRINC "n/WE MADE IT PAST INIT! ") (PRINC) (COMMAND ".mview" "lock" "off" "all" "" "") (SETQ sht_notxt (STRCAT sht_nopfx (IF sht_nopfx "-" "" ) ;_ end of IF (ITOA (CAR n)) ) ;_ end of STRCAT ) ;_ end of SETQ (SETQ sheet_no (CAR n)) (SETQ sheet_pts (CDR n)) (IF (EQ nil (NTH 0 sheet_pts)) (SETQ sheet_pts (CDR sheet_pts)) ) ;_ end of IF (IF (EQ nil (LAST sheet_pts)) (SETQ sheet_pts (REVERSE (CDR (REVERSE sheet_pts)))) ) ;_ end of IF (SETQ test_ang 0) (IF vpset NIL (LOAD "vpset" "\nFile VPSET.LSP NOT FOUND!") ) ;_ end of IF (vpset 2) ;;; (PRINC "n/WE MADE IT PAST VPSET! ") ;;; (PRINC) ;;;(princ "\n\t\tStart - Multiple iterations of UCS... ") ;;;(princ) (COMMAND ".ucs" "w") (SETQ miny_dist nil) (minmax_subr sheet_pts 10 180) (IF (< (- best_ang 10) 0) (SETQ test_ang 0) (SETQ test_ang (- best_ang 10)) ) ;_ end of IF (COMMAND ".ucs" "w") (minmax_subr sheet_pts 4 (+ best_ang 10)) (IF (< (- best_ang 4) 0) (SETQ test_ang 0) (SETQ test_ang (- best_ang 4)) ) ;_ end of IF (COMMAND ".ucs" "w") (minmax_subr sheet_pts 0.25 (+ best_ang 4)) (COMMAND ".ucs" "w") (SETQ newvp_ang best_ang) (vpwin_set sheet_pts newvp_ang) (COMMAND ".ucs" "w") ;;;(princ "\n\t\tDone - Multiple iterations of UCS... ") ;;;(princ) ;;; (IF T;init_sht ;;; (PROGN (SETQ init_sht NIL) ;;; (princ "\nINIT_SHT is True! ") ;;; (princ) ;;; ) ;_ end of progn (PROGN ;;; (princ "\nINIT_SHT is False! ") ;;; (princ) (IF vpset NIL (LOAD "vpset" "\nFile VPSET.LSP not found! ") ) ;_ end of IF (IF (> sheet_no 0) (PROGN (vpset 2) (SETQ old_plsymbs (SSGET "X" '((-4 . "") (0 . "INSERT") (-4 . "AND>") (-4 . "") (-4 . "") (-4 . "OR>") ) ) ;_ end of SSGET ) ;_ end of SETQ ;;; (princ "\n\t\tStart - erase old_plsymbs... ") ;;; (princ) (IF old_plsymbs (COMMAND ".erase" old_plsymbs "") (PRINC "\nNothing found to erase! ") ) ;_ end of IF ;;; (princ "\n\t\tDone - erase old_plsymbs... ") ;;; (princ) ;;; (princ "\n\t\tStart - Dview TW... ") ;;; (princ) (COMMAND ".DVIEW" "" "TW" (- 0 newvp_ang) "") ;;; (princ "\n\t\tDone - Dview TW... ") ;;; (princ) ;;; (princ "\n\t\tStart - Zoom Scale... ") ;;; (princ) (COMMAND ".ZOOM" (STRCAT (RTOS (/ 1.0 hvp_scale) 2 4) "XP") ) ;_ end of COMMAND ;;; (princ "\n\t\tDone - Zoom Scale... ") ;;; (princ) ;;; (princ "\n\t\tStart - Zoom Center... ") ;;; (princ) (COMMAND ".ZOOM" "c" newvp_cen "") ;;; (princ "\n\t\tDone - Zoom Center... ") ;;; (princ) (IF c:tsnap NIL (LOAD "tsnap" "\nFile TSNAP.LSP not found! ") ) ;_ end of IF ;;; (princ "\n\t\tStart - Tsnap... ") ;;; (princ) (c:tsnap) ;;; (princ "\n\t\tDone - Tsnap... ") ;;; (princ) (IF (EQ (CADAR mlsta_lst) nil) (SETQ mlsta_lst (SUBST (LIST (CAR (NTH 0 mlsta_lst)) (CADR (NTH 0 align_lst)) (LAST (NTH 0 mlsta_lst)) ) ;_ end of LIST (NTH 0 mlsta_lst) mlsta_lst ) ;_ end of SUBST ) ;_ end of SETQ ) ;_ end of IF (SETQ beg_mlsta (MAX (CADR (ASSOC sheet_no mlsta_lst)) (CADR (NTH 0 align_lst)) ) ;_ end of MAX ) ;_ end of SETQ (SETQ end_mlsta (CADR (ASSOC (1+ sheet_no) mlsta_lst)) ) ;_ end of SETQ (IF (AND beg_mlsta (NOT (EQ beg_mlsta (CADR (NTH 0 align_lst)))) ) ;_ end of AND (make_ml beg_mlsta "Left") ) ;_ end of IF (IF end_mlsta (make_ml end_mlsta "Right") ) ;_ end of IF (SETQ na#_pt (POLAR newvp_cen (+ (* (/ newvp_ang 180.0) PI) (* PI 0.5)) (* 3.9 hvp_scale) ) ;_ end of POLAR ) ;_ end of SETQ (SETQ bsc_pt (POLAR newvp_cen (+ (* (/ newvp_ang 180.0) PI) (* PI 1.5)) (* 5.0 hvp_scale) ) ;_ end of POLAR ) ;_ end of SETQ (pln_naro na#_pt) (pln_bscl bsc_pt) (vpset 1) (SETQ max_sht_ppgr nil min_sht_inv nil ) ;_ end of setq (FOREACH n vsf_lst (IF (AND (>= (CAR n) beg_mlsta) (OR (NOT end_mlsta) (<= (CAR n) end_mlsta)) ) ;_ end of AND (PROGN (IF max_sht_ppgr (SETQ max_sht_ppgr (MAX max_sht_ppgr (CADR n)) ) ;_ end of SETQ (SETQ max_sht_ppgr (CADR n)) ) ;_ end of if ;;; (PRINC "\nmax_sht_ppgr = ") ;;; (princ max_sht_ppgr) ;;; (princ) ) ;_ end of PROGN ) ;_ end of if ) ;_ end of foreach (FOREACH n ppnt_lst (IF (AND (>= (NTH 1 n) beg_mlsta) (OR (NOT end_mlsta) (<= (NTH 1 n) end_mlsta)) ) ;_ end of AND (PROGN (IF min_sht_inv (SETQ min_sht_inv (MIN min_sht_inv (NTH 3 n))) (SETQ min_sht_inv (NTH 3 n)) ) ;_ end of if ;;; (PRINC "\nmin_sht_inv = ") ;;; (princ min_sht_inv) ;;; (princ) ) ;_ end of PROGN ) ;_ end of if ) ;_ end of foreach (IF (AND max_sht_ppgr min_sht_inv) (COND ((> (- max_sht_ppgr min_sht_inv) (* vvp_scale 6.0) ) ;_ end of > (SETQ cedatum min_sht_inv) ) ((> (- max_sht_ppgr min_sht_inv) (* vvp_scale 5.0) ) ;_ end of > (SETQ cedatum (- min_sht_inv (* vvp_scale 2.3))) ) ((> (- max_sht_ppgr min_sht_inv) (* vvp_scale 4.0) ) ;_ end of > (SETQ cedatum (- min_sht_inv (* vvp_scale 2.7))) ) ((> (- max_sht_ppgr min_sht_inv) (* vvp_scale 3.0) ) ;_ end of > (SETQ cedatum (- min_sht_inv (* vvp_scale 3.1))) ) ((> (- max_sht_ppgr min_sht_inv) (* vvp_scale 2.0) ) ;_ end of > (SETQ cedatum (- min_sht_inv (* vvp_scale 3.5))) ) (T (SETQ cedatum (- min_sht_inv (* vvp_scale 4.0))) ) ) ;_ end of COND (IF (EQ sheet_no (LENGTH sheets_lst)) (SETQ cedatum (- (NTH 3 (NTH 0 (REVERSE ppnt_lst))) (* 5.0 vvp_scale) ) ;_ end of - ) ;_ end of SETQ (IF (AND (ASSOC sheet_no datum_lst) (CDR (ASSOC sheet_no datum_lst)) ) ;_ end of AND (SETQ cedatum (- (CDR (ASSOC sheet_no datum_lst)) (* 5.0 vvp_scale) ) ;_ end of - ) ;_ end of SETQ ) ;_ end of IF ) ;_ end of IF ) ;_ end of IF ;;; (PRINC "\ncedatum = ") ;;; (PRINC cedatum) ;;; (princ) (SETQ cedatum (* vvp_scale (ATOI (RTOS (/ (ATOI (RTOS cedatum 2 4)) vvp_scale ) ;_ end of / 2 4 ) ;_ end of RTOS ) ;_ end of ATOI ) ;_ end of * ) ;_ end of SETQ ;;; (PRINC "\ncedatum (fixed) = ") ;;; (PRINC cedatum) ;;; (princ) ;;; (princ "\n\t\tStart - Zoom Scale... ") (COMMAND ".ZOOM" (STRCAT (RTOS (/ 1.0 hvp_scale) 2 4) "XP") ) ;_ end of COMMAND ;;; (princ "\n\t\tDone - Zoom Scale... ") (SETQ cedatum (* (/ cedatum vvp_scale) vvp_scale)) ; new! should make appropriate elevation text entries on grid ;;; (SETQ datum_rem (REM cedatum 10.0)) ;;; (COND ((AND (>= datum_rem 1) (<= datum_rem 1)) (SETQ cedatum (- cedatum 1))) ;;; ((<= datum_rem 2) (SETQ cedatum (- cedatum 2))) ;;; ((<= datum_rem 3) (SETQ cedatum (- cedatum 3))) ;;; ((<= datum_rem 4) (SETQ cedatum (- cedatum 4))) ;;; ((<= datum_rem 5) (SETQ cedatum (- cedatum 5))) ;;; ((<= datum_rem 6) (SETQ cedatum (- cedatum 6))) ;;; ((<= datum_rem 7) (SETQ cedatum (- cedatum 7))) ;;; ((<= datum_rem 8) (SETQ cedatum (- cedatum 8))) ;;; ((<= datum_rem 9) (SETQ cedatum (- cedatum 9))) ;;; ((< datum_rem 10) (SETQ cedatum (- cedatum 10))) ;;; ) ;_ end of COND ;;; (PRINC "\ncedatum (rounded) = ") ;;; (PRINC cedatum) ;;; (princ) (set_prvw beg_mlsta cedatum) ;;; (princ "\n\t\tStart - Pspace... ") (COMMAND ".pspace") ;;; (princ "\n\t\tDone - Pspace... ") (IF attupd NIL (LOAD "attupd" "\nFile ATTUPD.LSP not found! ") ) ;_ end of IF (IF do_cmud (PROGN (attupd "HUATTBATS" "TITLE_1" "PLAN AND PROFILE") (attupd "HUATTBATS" "TITLE_1/2" "") (attupd "HUATTBATS" "TITLE_2/2" "") ) ;_ end of PROGN (PROGN (attupd "HUATTBATS" "TITLE_1/2" "PLAN AND PROFILE" ) ;_ end of attupd (attupd "HUATTBATS" "TITLE_1/3" "") (attupd "HUATTBATS" "TITLE_1" "") (attupd "HUATTBATS" "TITLE_3/3" "") ) ;_ end of PROGN ) ;_ end of IF (IF stait NIL (LOAD "stait" "\nFile STAIT.LSP not found!") ) ;_ end of IF (IF do_cmud (attupd "HUATTBATS" "TITLE_1/3" (STRCAT sht_nopfx (IF (AND sht_nopfx (/= sht_nopfx "")) "-" "" ) ;_ end of IF (ITOA sheet_no) ) ;_ end of STRCAT ) ;_ end of attupd ) ;_ end of IF (IF do_cmud (attupd "HUATTBATS" "TITLE_3/3" (STRCAT "STA " (stait beg_mlsta 0) " TO STA " (IF end_mlsta (stait end_mlsta 0) (stait (NTH 1 (LAST align_lst)) 0) ) ;_ end of IF ) ;_ end of STRCAT ) ;_ end of attupd (attupd "HUATTBATS" "TITLE_2/2" (STRCAT "STA " (stait beg_mlsta 0) " TO STA " (IF end_mlsta (stait end_mlsta 0) (stait (NTH 1 (LAST align_lst)) 0) ) ;_ end of IF ) ;_ end of STRCAT ) ;_ end of attupd ) ;_ end of IF (IF do_cmud (attupd "HUATTBATS" "SHT_NO." (ITOA (+ 3 sheet_no))) (attupd "HUATTBATS" "SHT_NO." (STRCAT sht_nopfx (IF sht_nopfx "-" "" ) ;_ end of IF (ITOA sheet_no) ) ;_ end of STRCAT ) ;_ end of attupd ) ;_ end of IF (COND ((OR (EQ sht_nopfx "") (WCMATCH (GETVAR "dwgprefix") "*28474*") ) ;_ end of OR (COND ((>= sheet_no 100) (SETQ shtseq_no (ITOA sheet_no)) ) ((>= sheet_no 10) (SETQ shtseq_no (STRCAT "0" (ITOA sheet_no))) ) (T (SETQ shtseq_no (STRCAT "00" (ITOA sheet_no))) ) ) ;_ end of COND ) ((NOT (EQ sht_nopfx "")) (COND ((>= sheet_no 10) (SETQ shtseq_no (STRCAT sht_nopfx (ITOA sheet_no)) ) ;_ end of SETQ ) (T (SETQ shtseq_no (STRCAT sht_nopfx "0" (ITOA sheet_no) ) ;_ end of STRCAT ) ;_ end of SETQ ) ) ;_ end of COND ) ) ;_ end of COND ;;; (princ "\n\t\tStart - Saveas... ") (SETQ dnam-prfx series_fnpfx) (SETQ dnam-prfx1 dnam-prfx) (vpset 1) (COMMAND ".view" "s" "Profile") (vpset 2) (COMMAND ".view" "s" "Plan") (vpset 1) (COMMAND ".view" "r" "Profile") (vpset 2) (COMMAND ".view" "r" "Plan") (COMMAND ".pspace") (COMMAND ".mview" "lock" "on" "all" "" "") (COND ((>= sheet_no 100) (SETQ dnam_no (ITOA sheet_no))) ((>= sheet_no 10) (SETQ dnam_no (STRCAT "0" (ITOA sheet_no))) ) (T (SETQ dnam_no (STRCAT "00" (ITOA sheet_no)))) ) ;_ end of COND (SETQ dnam-prfx (STRCAT dnam-prfx1 dnam_no)) (IF (FINDFILE (STRCAT (GETVAR "DWGPREFIX") dnam-prfx " Plan & Profile Sheet " sys_type "-" series_fnpfx ".DWG" ) ;_ end of STRCAT ) ;_ end of FINDFILE (ask_overwrite (STRCAT (GETVAR "DWGPREFIX") dnam-prfx " Plan & Profile Sheet " sys_type "-" series_fnpfx ".DWG" ) ;_ end of STRCAT ) ;_ end of ask_overwrite ) ;_ end of IF (SETQ found_prev_fn (FINDFILE (STRCAT (GETVAR "DWGPREFIX") dnam-prfx " Plan & Profile Sheet " sys_type "-" series_fnpfx ".DWG" ) ;_ end of STRCAT ) ;_ end of FINDFILE ) ;_ end of SETQ (COND ((AND found_prev_fn ya_its_ok) (COMMAND ".saveas" (IF (> (READ (SUBSTR (GETVAR "acadver") 1 2)) 15) "2004" "R14" ) ;_ end of IF (STRCAT (GETVAR "DWGPREFIX") dnam-prfx " Plan & Profile Sheet " sys_type "-" series_fnpfx ) ;_ end of STRCAT "Y" ) ;_ end of COMMAND ) ((NOT found_prev_fn) (COMMAND ".saveas" (IF (> (READ (SUBSTR (GETVAR "acadver") 1 2)) 15) "2004" "R14" ) ;_ end of IF (STRCAT (GETVAR "DWGPREFIX") dnam-prfx " Plan & Profile Sheet " sys_type "-" series_fnpfx ) ;_ end of STRCAT ) ;_ end of COMMAND ) ) ;_ end of COND (IF (AND found_prev_fn (NOT ya_its_ok)) (ALERT (STRCAT "Drawing " (GETVAR "DWGPREFIX") "\n" dnam-prfx " Plan & Profile Sheet " sys_type "-" series_fnpfx ".DWG" "\nexists and was not overwritten!" ) ;_ end of STRCAT ) ;_ end of ALERT (PROGN ;;; (princ "\n\t\tDone - Saveas... ") (IF c:qsave (c:qsave) (PROGN (IF c:lbl NIL (LOAD "lbl" "\nFile LBL.LSP not found! ") ) ;_ end of IF (IF c:lbl (c:lbl) ) ;_ end of IF (IF cdmndx nil (LOAD "cdmndx") ) ;_ end of if (IF cdmndx (cdmndx) nil ) ;_ end of IF (COMMAND ".qsave") ) ;_ end of progn ) ;_ end of IF (PRINC "\nGenerated Plan & Profile Sheet ") (PRINC (STRCAT (GETVAR "DWGPREFIX") dnam-prfx " Plan & Profile Sheet " sys_type "-" dnam-prfx ".DWG" ) ;_ end of STRCAT ) ;_ end of PRINC ) ;_ end of PROGN ) ;_ end of IF ) ;_ end of PROGN ) ;_ end of IF ) ;_ end of PROGN ;;; ) ;_ end of IF ) ;_ end of FOREACH ) ;_ end of PROGN ) ;_ end of IF ) ;_ end of PROGN (PROGN (IF (NOT align_lst) (PRINC "\n No Alignment is currently in memory! ") ) ;_ end of IF (IF (NOT (EQ (GETVAR "tilemode") 0)) (PRINC "\n Tilemode must be 0 to generate sheets! ") ) ;_ end of IF (IF vpss (COND ((OR (<= vpss_len 2) (NOT found_planvp) (NOT found_profvp)) (PRINC "\n Plan and Profile must each have a viewport. ") (PRINC "\n Profile viewport layer name must be \"C-VI017NPLT\", and" ) ;_ end of PRINC (PRINC "\n Plan viewport layer name must be \"C-VI027NPLT\" to generate sheets! " ) ;_ end of PRINC (TEXTSCR) ) ((OR (EQ found_planvp "OFF") (EQ found_profvp "OFF")) (PRINC "\n Plan and Profile viewports must be ON. Use MVIEW to turn them ON. " ) ;_ end of PRINC (TEXTSCR) ) ) ;_ end of COND (PROGN (PRINC "\n Plan and Profile must each have a viewport. ") (PRINC "\n Profile viewport layer name must be \"C-VI017NPLT\", and" ) ;_ end of PRINC (PRINC "\n Plan viewport layer name must be \"C-VI027NPLT\" to generate sheets! " ) ;_ end of PRINC (TEXTSCR) ) ;_ end of PROGN ) ;_ end of IF ) ;_ end of PROGN ) ;_ end of IF (SETQ found_profvp NIL) (SETQ found_planvp NIL) (SETVAR "osmode" old_osmode) (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! ***|;