;;;**************************************************************************** (DEFUN setpsize_error (msg /) (PRINC (STRCAT "\nError: " msg)) (SETQ just_1_inv nil) (SETQ done_just_1 nil) (SETQ *error* orig_setpsizeerror) (PRINC) ) ;_ end of DEFUN ;;;**************************************************************************** (DEFUN c:setpsize () (SETQ orig_setpsizeerror *error*) (SETQ *error* setpsize_error) (IF align_lst (PROGN (IF (AND (NOT setpsize_continue) (NOT (EQUAL (LIST aln_name set_xpipe_size) sps_yes)) (WCMATCH (STRCASE usrsfx) "[FSG][MDS]X##") ) ;_ end of AND (PROGN (ALERT "Alignment name and/or layer suffix specified\nindicates a crossing alignment may be current!\n\nAnswer \"Yes\" to the following command prompt\nto set inverts for this alignment." ) ;_ end of ALERT (SETQ set_xpipe_size (ukword 1 "Yes No" "Continue SETINV for this alignment? [Yes/No] " (IF set_xpipe_size set_xpipe_size "No" ) ;_ end of IF ) ;_ end of ukword ) ;_ end of SETQ (IF (EQ (STRCASE set_xpipe_size) "NO") (SETQ do_sps 0) (PROGN (SETQ do_sps 1 sps_yes (LIST aln_name set_xpipe_size) ) ;_ end of SETQ ) ;_ end of PROGN ) ;_ end of IF ) ;_ end of PROGN (PROGN (SETQ do_sps 1)) ) ;_ end of IF (IF (EQ do_sps 1) (PROGN (IF upoint nil (LOAD "upoint" "\nFile UPOINT.LSP not loaded! ") ) ;_ end of IF (IF uint nil (LOAD "uint" "\nFile UINT.LSP not loaded! ") ) ;_ end of IF (SETQ this_point T) (WHILE (AND this_point (NOT (SETQ member_t_list (MEMBER 'T (MAPCAR '(LAMBDA (x) (AND (EQ (TYPE this_point) 'LIST) (EQUAL (CAR this_point) (NTH 1 x) 0.1)) ) ;_ end of LAMBDA align_lst ) ;_ end of MAPCAR ) ;_ end of MEMBER ) ;_ end of SETQ ) ;_ end of NOT (NOT (EQ this_point "Quit")) ) ;_ end of AND (SETQ this_point (upoint 1 "Quit" "Pick left end station of pipe to resize [Quit]" nil nil)) ) ;_ end of WHILE (IF (AND (EQ (TYPE this_point) 'LIST) member_t_list) (PROGN (SETQ thisedcnt (- (LENGTH align_lst) (LENGTH member_t_list))) (SETQ thiseditem (NTH thisedcnt align_lst)) (WHILE (NOT (OR repeat# (EQ repeat# "Cancel") (> repeat# 0))) (SETQ repeat# (uint 1 "Cancel" (STRCAT "Current size: " (RTOS (NTH 7 thiseditem) 2 0) ", Enter the no. of pipe segments to resize [Cancel]" ) ;_ end of STRCAT repeat# ) ;_ end of UINT ) ;_ end of SETQ ) ;_ end of WHILE (IF (EQ repeat# "Cancel") (SETQ this_p_size "Cancel") (SETQ this_p_size (uint 1 "Cancel" "New pipe size [Cancel]" (IF (AND this_p_size (/= this_p_size "Cancel")) this_p_size (RTOS (NTH 7 thiseditem) 2 0) ) ;_ end of IF ) ;_ end of uint ) ;_ end of SETQ ) (IF (AND this_p_size (/= this_p_size "Cancel") repeat# (/= repeat# "Cancel") (> repeat# 0)) (REPEAT repeat# (SETQ thiseditem (NTH thisedcnt align_lst)) (SETQ this_align_lst align_lst that_align_lst align_lst this_point T ) ;_ end of SETQ (SETQ that_align_lst (SUBST (LIST (NTH 0 thiseditem) (NTH 1 thiseditem) (NTH 2 thiseditem) (NTH 3 thiseditem) (NTH 4 thiseditem) (NTH 5 thiseditem) (NTH 6 thiseditem) this_p_size (NTH 8 thiseditem) (NTH 9 thiseditem) (NTH 10 thiseditem) (NTH 11 thiseditem) (NTH 12 thiseditem) ) ;_ end of LIST thiseditem that_align_lst ) ;_ end of SUBST ) ;_ end of SETQ ;preserve and protect the original align_lst (IF (AND this_align_lst that_align_lst (EQ (LENGTH this_align_lst) (LENGTH that_align_lst))) ;_ end of AND (SETQ align_lst that_align_lst this_align_lst nil that_align_lst nil ) ;_ end of SETQ (PROGN (ALERT "There was a problem modifying the pipe size!") (SETQ this_align_lst nil that_align_lst nil ) ;_ end of SETQ ) ;_ end of PROGN ) ;_ end of IF (SETQ thisedcnt (1+ thisedcnt)) ) ;_ end of repeat ) ;_ end of IF (SETQ repeat# NIL) ) ;_ end of PROGN ) ;_ end of IF ) ;_ end of PROGN ) ;_ end of IF ) ;_ end of PROGN ) ;_ end of IF (PRINC) ) ;_ end of DEFUN ;|«Visual LISP© Format Options» (120 2 15 2 T "end of " 100 9 2 1 nil nil nil nil T) ;*** DO NOT add text below the comment! ***|;