;;;bubble update subroutine (bubupd [blockname] [old_sdname] [new_sdname] [old_callon] [new_callon]) ;;; ;;; Author: ;;; Henry C. Francis ;;; 425 N. Ashe Street ;;; Southern Pines, NC 28387 ;;; ;;; http://www.paracadd.com ;;; All rights reserved. ;;; ;;; Copyright: 2-19-2004 ;;; Edited: 2-19-2004 ;;; (DEFUN bubupd (blockname old_sdname new_sdname old_callon new_callon / iniblk inient nxtent1 nxtent2) (SETQ attrib-lst nil) (PROGN (SETQ ttl_exst nil bstp 0 ) ;_ end of setq (IF (SETQ ttl1ss (SSGET "x" (LIST (CONS -4 "")) ) ;_ end of ssget ) ;_ end of setq (WHILE (< bstp (SSLENGTH ttl1ss)) (PROGN (SETQ attrib-lst NIL) (SETQ iniblk (SSNAME ttl1ss bstp)) (SETQ inient (ENTGET iniblk)) (SETQ nxtent (ENTGET (ENTNEXT iniblk))) (WHILE (/= (CDR (ASSOC 0 nxtent)) "SEQEND") (IF (EQ (CDR (ASSOC 0 nxtent)) "ATTRIB") (PROGN (SETQ attrib-lst (APPEND attrib-lst (LIST nxtent)))) ;_ end of progn ) ;_ end of if (SETQ nxtent (ENTGET (ENTNEXT (CDAR nxtent)))) ) ;_ end of while (IF (AND (EQ (CDR (ASSOC 1 (NTH 0 attrib-lst))) old_sdname) (EQ (CDR (ASSOC 1 (NTH 1 attrib-lst))) old_callon) ) ;_ end of AND (PROGN ;;; (PRINC "\n\t\t\t**** TRUE ****") ;;; (PRINC "\n(CDR (ASSOC 1 (NTH 0 attrib-lst))) = ") ;;; (PRINC (CDR (ASSOC 1 (NTH 0 attrib-lst)))) ;;; (PRINC "\nold_sdname = ") ;;; (PRINC old_sdname) ;;; (PRINC "\n(CDR (ASSOC 1 (NTH 1 attrib-lst))) = ") ;;; (PRINC (CDR (ASSOC 1 (NTH 1 attrib-lst)))) ;;; (PRINC "\nold_callon = ") ;;; (PRINC old_callon) ;;; (PRINC) (SETQ nxtent1 (SUBST (CONS 1 new_sdname) (ASSOC 1 (NTH 0 attrib-lst)) (NTH 0 attrib-lst) ) ;_ end of SUBST ) ;_ end of setq (SETQ nxtent2 (SUBST (CONS 1 new_callon) (ASSOC 1 (NTH 1 attrib-lst)) (NTH 1 attrib-lst) ) ;_ end of SUBST ) ;_ end of setq (ENTMOD nxtent1) (ENTMOD nxtent2) (ENTUPD iniblk) ) ;_ end of progn (PROGN ;;; (PRINC "\n\t\t\t**** NIL ****") ;;; (PRINC "\n(CDR (ASSOC 1 (NTH 0 attrib-lst))) = ") ;;; (PRINC (CDR (ASSOC 1 (NTH 0 attrib-lst)))) ;;; (PRINC "\nold_sdname = ") ;;; (PRINC old_sdname) ;;; (PRINC "\n(CDR (ASSOC 1 (NTH 1 attrib-lst))) = ") ;;; (PRINC (CDR (ASSOC 1 (NTH 1 attrib-lst)))) ;;; (PRINC "\nold_callon = ") ;;; (PRINC old_callon) ;;; (PRINC) ) ) ;_ end of if (PRINC) ) ;_ end of progn (SETQ bstp (1+ bstp)) ) ;_ end of while (PRINC) ) ;_ end of if ) ;_ end of PROGN (PRINC) ) ;_ end of defun ;|«Visual LISP© Format Options» (100 2 30 2 T "end of " 100 9 2 1 1 T nil nil T) ;*** DO NOT add text below the comment! ***|;