(DEFUN c:casepipe () (SETQ case_size (ureal 1 "" (STRCAT "Size of Casing" (IF m_units " (mm)" " (in)" ) ;_ end of IF ) ;_ end of STRCAT (IF case_size case_size nil ) ;_ end of IF ) ;_ end of ureal ) ;_ end of SETQ (IF (> (* 0.110 dimsc) (IF m_units (/ case_size 1000) (/ case_size 12) ) ;_ end of IF ) ;_ end of > (SETQ case_unit (* 0.110 dimsc)) (SETQ case_unit (IF m_units (/ case_size 1000) (/ case_size 12) ) ;_ end of IF ) ;_ end of SETQ ) ;_ end of IF (SETQ caseb_sta (ureal 1 "Pick" (STRCAT "Beginning Station of " (RTOS case_size 2 2) (IF m_units "mm" "\"" ) ;_ end of IF " Casing or
ick" ) ;_ end of STRCAT (IF caseb_sta caseb_sta nil ) ;_ end of IF ) ;_ end of ureal ) ;_ end of SETQ (IF (EQ caseb_sta "Pick") (PROGN (SETQ pick_single T) (C:GETSTA) (SETQ this_sta (ukword 1 "Yes No" (STRCAT "Use STA " (RTOS qpnt_sta 2) "?") (IF this_sta this_sta "Yes" ) ;_ end of IF ) ;_ end of ukword ) ;_ end of SETQ (IF (EQ this_sta "Yes") (SETQ caseb_sta qpnt_sta this_sta NIL ) ;_ end of SETQ (SETQ caseb_sta (ureal 1 "Pick" "Enter Station for symbol " (IF (AND caseb_sta (EQ (TYPE caseb_sta) 'REAL)) caseb_sta nil ) ;_ end of IF ) ;_ end of ureal this_sta NIL ) ;_ end of SETQ ) ;_ end of IF ) ;_ end of PROGN ) ;_ end of IF (get_sta_pt caseb_sta) (SETQ caseb_pt sta_pt) (SETQ casee_sta (ureal 1 "Pick" (STRCAT "Ending Station of " (RTOS case_size 2 2) (IF m_units "mm" "\"" ) ;_ end of IF " Casing or
ick" ) ;_ end of STRCAT (IF casee_sta casee_sta nil ) ;_ end of IF ) ;_ end of ureal ) ;_ end of SETQ (IF (EQ casee_sta "Pick") (PROGN (SETQ pick_single T) (C:GETSTA) (SETQ this_sta (ukword 1 "Yes No" (STRCAT "Use STA " (RTOS qpnt_sta 2) "?") (IF this_sta this_sta "Yes" ) ;_ end of IF ) ;_ end of ukword ) ;_ end of SETQ (IF (EQ this_sta "Yes") (SETQ casee_sta qpnt_sta this_sta NIL ) ;_ end of SETQ (SETQ casee_sta (ureal 1 "Pick" "Enter Station for symbol " (IF (AND casee_sta (EQ (TYPE casee_sta) 'REAL)) casee_sta nil ) ;_ end of IF ) ;_ end of ureal this_sta NIL ) ;_ end of SETQ ) ;_ end of IF ) ;_ end of PROGN ) ;_ end of IF (SETQ plnorprf (UKWORD 1 "PLan PRofile" "Draw PLan or PRofile casing pipe?" (IF plnorprf plnorprf "PLan"))) (IF (EQ plnorprf "PLan") (PROGN (get_sta_pt casee_sta) (SETQ casee_pt sta_pt) (SETQ ptb_1 (POLAR caseb_pt (+ (ANGLE caseb_pt casee_pt) (* PI 0.5)) (/ case_unit 2)) ;_ end of POLAR ) ;_ end of SETQ (SETQ ptb_2 (POLAR caseb_pt (+ (ANGLE caseb_pt casee_pt) (* PI 1.5)) (/ case_unit 2)) ;_ end of POLAR ) ;_ end of SETQ (SETQ pte_1 (POLAR casee_pt (+ (ANGLE caseb_pt casee_pt) (* PI 0.5)) (/ case_unit 2)) ;_ end of POLAR ) ;_ end of SETQ (SETQ pte_2 (POLAR casee_pt (+ (ANGLE caseb_pt casee_pt) (* PI 1.5)) (/ case_unit 2)) ;_ end of POLAR ) ;_ end of SETQ ) (IF (AND caseb_sta casee_sta) (PROGN (SETQ goto_cnt 0) (FOREACH n align_lst (IF (<= (NTH 1 n) caseb_sta) (SETQ goto_cnt (1+ goto_cnt)) ) ) (SETQ bmh_ndx goto_cnt lmh_ndx (1- bmh_ndx)) (SETQ goto_cnt 0) (FOREACH n align_lst (IF (<= (NTH 1 n) casee_sta) (SETQ goto_cnt (1+ goto_cnt)) ) ) (SETQ emh_ndx (1- goto_cnt) rmh_ndx (1+ emh_ndx)) (COND ((AND(<= lmh_ndx emh_ndx)(> lmh_ndx 0)(< emh_ndx(1-(length align_lst)))) (setq lmh_inv (nth 3(nth lmh_ndx align_lst)) rmh_inv (nth 3(nth rmh_ndx align_lst)) bmh_inv (nth 3(nth bmh_ndx align_lst)) emh_inv (nth 3(nth emh_ndx align_lst)) bmh_sta (nth 1(nth bmh_ndx align_lst)) emh_sta (nth 1(nth emh_ndx align_lst)) lmh_sta (nth 1(nth lmh_ndx align_lst)) rmh_sta (nth 1(nth rmh_ndx align_lst)) lcs_slope (/(- bmh_inv lmh_inv) (- bmh_sta lmh_sta)) rcs_slope (/(- rmh_inv emh_inv) (- rmh_sta emh_sta)) rcs_psz (nth 7(nth emh_ndx align_lst)) lcs_psz (nth 7(nth lmh_ndx align_lst)) lcs_cl (*(+ lmh_inv(*(- caseb_sta lmh_sta)lcs_slope)(/ lcs_psz 24.0))v_fact) rcs_cl (*(+ emh_inv(*(- casee_sta emh_sta)rcs_slope)(/ rcs_psz 24.0))v_fact) lcs_pt (list caseb_sta lcs_cl 0) rcs_pt (list casee_sta rcs_cl 0) case_unit (IF m_units (*(/ case_size 1000)v_fact) (*(/ case_size 12)v_fact) ) ;_ end of IF ptb_1 (polar lcs_pt (* pi 0.5) (/ case_unit 2)) ptb_2 (polar lcs_pt (* pi 1.5) (/ case_unit 2)) pte_1 (polar rcs_pt (* pi 0.5) (/ case_unit 2)) pte_2 (polar rcs_pt (* pi 1.5) (/ case_unit 2)) ) ) ((AND(< emh_ndx bmh_ndx)(> emh_ndx 0)(< bmh_ndx(1-(length align_lst)))) ) ((AND(> emh_ndx bmh_ndx)(= bmh_ndx 0)(< emh_ndx(1-(length align_lst)))) ) ((AND(< emh_ndx bmh_ndx)(= emh_ndx 0)(< bmh_ndx(1-(length align_lst)))) ) ((AND(= bmh_ndx 0)(= emh_ndx(1-(length align_lst)))) ) ((AND(= emh_ndx 0)(= bmh_ndx(1-(length align_lst)))) ) ) ) ) ) (COMMAND "-layer" "m" (IF do_cmud "PS" "C-CASE3" ) ;_ end of IF "c" "3" "" "" ) ;_ end of COMMAND (COMMAND ".pline" ptb_1 ptb_2 pte_2 pte_1 ptb_1 "") (princ) ) ;_ end of DEFUN (DEFUN re_sta () (SETQ sta_lst nil) (IF (EQ mv_ndx 1) (SETQ base_sta (- (NTH 1 (NTH 1 align_lst)) (DISTANCE (NTH 9 (NTH 0 align_lst)) (NTH 9 (NTH 1 align_lst))))) ; _ end ; of ; setq (SETQ base_sta (NTH 1 (NTH 0 align_lst))) ;_ end of setq ) ;_ end of IF (SETQ cursta base_sta) (SETQ pt1 (list(car(NTH 9 (NTH 0 align_lst)))(cadr(NTH 9 (NTH 0 align_lst))))) (FOREACH n align_lst (SETQ cursta (+ cursta (DISTANCE pt1 (list(car(NTH 9 n))(cadr(NTH 9 n)))))) (IF sta_lst (SETQ sta_lst (APPEND sta_lst (LIST cursta))) (SETQ sta_lst (LIST cursta)) ) ;_ end of if (SETQ pt1 (list(car(NTH 9 n))(cadr(NTH 9 n)))) ) ;_ end of foreach (SETQ align_lst (MAPCAR '(LAMBDA (a b) (LIST (NTH 0 a) b (NTH 2 a) (NTH 3 a) (NTH 4 a) (NTH 5 a) (NTH 6 a) (NTH 7 a) (NTH 8 a) (NTH 9 a)) ) ;_ end of lambda align_lst sta_lst ) ;_ end of mapcar ) ;_ end of setq ) ;_ end of defun ;;;((WCMATCH(NTH 0 n) "*PLUG*") ;;; (COMMAND ".INSERT" "PRPLUG" syminspt dimsc (* dimsc(/ v_fact 2)) 0 )) ;;;************************************************************************************* (defun c:prblocks () (COMMAND ".wblock" "L:/util/arv" "arv") (COMMAND ".wblock" "L:/util/prbend" "PRbend") (COMMAND ".wblock" "L:/util/prbfv" "PRbfv") (COMMAND ".wblock" "L:/util/prblow" "PRblow") (COMMAND ".wblock" "L:/util/prcross" "PRcross") (COMMAND ".wblock" "L:/util/prgv" "PRgv") (COMMAND ".wblock" "L:/util/prplug" "PRplug") (COMMAND ".wblock" "L:/util/prpv" "PRpv") (COMMAND ".wblock" "L:/util/prred" "PRred") (COMMAND ".wblock" "L:/util/prtee" "PRtee") (COMMAND ".wblock" "L:/util/prvalve" "PRvalve") (COMMAND ".INSERT" "arv")(command) (COMMAND ".INSERT" "PRbend")(command) (COMMAND ".INSERT" "PRbfv")(command) (COMMAND ".INSERT" "PRblow")(command) (COMMAND ".INSERT" "PRcross")(command) (COMMAND ".INSERT" "PRgv")(command) (COMMAND ".INSERT" "PRplug")(command) (COMMAND ".INSERT" "PRpv")(command) (COMMAND ".INSERT" "PRred")(command) (COMMAND ".INSERT" "PRtee")(command) (COMMAND ".INSERT" "PRvalve")(command) (princ) )