;;;Dialog utility for storing, editing and retrieving/placing Typical Notes into a drawing. ;;; ;;; Author: ;;; Henry C. Francis ;;; 425 N. Ashe St. ;;; Southern Pines, NC 28387 ;;; ;;; All rights reserved. ;;; ;;; Copyright: 2/1995 ;;; Edited: 11/26/2013 ;;; ;;;Requires: getstyle.lsp, browser_help.lsp, mymldr.lsp, mlt.lsp, upoint.lsp, uint.lsp, ukwword.lsp, ;;; ureal.lsp, mltstyle.lsp, dimscl.lsp, remlt.lsp, errortrap.lsp. mklayr.lsp, tnote.dcl ;;; (DEFUN tnote_error (msg /) (TERM_DIALOG) (IF old_tnoterror (SETQ *error* old_tnoterror) ) ;_ end of IF (SETQ do_tnote nil tn_add_bubble nil ) ;_ end of SETQ (PRINC "\nERROR: ") (PRINC msg) (IF getstyle (getstyle "") ) ;_ end of IF (PRINC) ) ;_ end of defun (DEFUN c:tnote (/ tn_pl_note new_tnote_list this_ttss) (SETQ old_tnoterror *error*) (IF getstyle nil (LOAD "getstyle" "\nFile GETSTYLE.LSP not loaded! ") ) ;_ end of IF (IF getstyle (getstyle "A") ) ;_ end of IF (SETQ mystartcdate (GETVAR "cdate")) (SETQ quit_clg nil) (SETQ count 0) (IF browser_help nil (LOAD "browser_help" "\nFile BROWSER_HELP not loaded!") ) ;_ end of IF (IF VL-BB-SET nil (VL-LOAD-COM) ) ;_ end of IF ;;; (IF tnote_list ;;; NIL ;;; (PROGN ;;; (ALERT "A") ;;; (get_tnotedat_file) ;;; ) ;;; ) (SETQ tn_num (LOAD_DIALOG "tnote")) (NEW_DIALOG "tnote" tn_num (IF defact_tnote defact_tnote "" ) ;_ end of IF (IF tnote_loc tnote_loc '(-1 -1) ) ;_ end of IF ) ;_ end of NEW_DIALOG (IF tn_datlocn nil (COND (tn_file (get_tnotedat_file)) ((FINDFILE ".\\tnote.tnd") (SETQ tn_datlocn "tn_here")) ((FINDFILE "..\\tnote.tnd") (SETQ tn_datlocn "tn_updir")) (T (SETQ tn_datlocn "tn_other")) ) ;_ end of COND ) ;_ end of IF (set_tnote_list) (SETQ tn_thts (IF tn_thts tn_thts (IF do_cmud "100" "110" ) ;_ end of IF ) ;_ end of IF ) ;_ end of SETQ (SET_TILE "leroy_size" tn_thts) (set_leroy tn_thts) (SET_TILE "tn_space" (COND ((AND (EQ (GETVAR "tilemode") 0) tn_space (OR (EQ tn_space "tn_psp") (EQ tn_space "tn_csp"))) tn_space ) ((AND (EQ (GETVAR "tilemode") 1) tn_space (OR (EQ tn_space "tn_msp") (EQ tn_space "tn_csp"))) tn_space ) (T (SETQ tn_space "tn_msp")) ) ;_ end of COND ) ;_ end of SET_TILE (SET_TILE "colr_over" (IF colr_over colr_over "0" ) ;_ end of IF ) ;_ end of SET_TILE (IF (EQ (TYPE tnote_ldrc) 'int) (SETQ tnote_ldrc (ITOA tnote_ldrc)) ) ;_ end of IF (IF (EQ (TYPE tnote_txtc) 'int) (SETQ tnote_txtc (ITOA tnote_txtc)) ) ;_ end of IF (COND ((AND mycolor_text (EQ mycolor_text "ldrc_swatch") tnote_ldrc) (SETQ sel_color (ATOI tnote_ldrc))) (tnote_ldrc (SETQ sel_color (ATOI tnote_ldrc) mycolor_text "ldrc_swatch" ) ;_ end of SETQ ) (T (SETQ tnote_ldrc "1" sel_color (ATOI tnote_ldrc) mycolor_text "ldrc_swatch" ) ;_ end of SETQ ) ) ;_ end of COND (set_color_swatch) ;leader color override (COND ((AND mycolor_text (EQ mycolor_text "txtc_swatch") tnote_txtc) (SETQ sel_color (ATOI tnote_txtc))) (tnote_txtc (SETQ sel_color (ATOI tnote_txtc) mycolor_text "txtc_swatch" ) ;_ end of SETQ ) (T (SETQ tnote_txtc "6" sel_color (ATOI tnote_txtc) mycolor_text "txtc_swatch" ) ;_ end of SETQ ) ) ;_ end of COND (set_color_swatch) ;text color override (IF (AND just_option (WCMATCH just_option "just_mr")) (PROGN (SETQ do_right_just "Yes" just_option "just_mr" ) ;_ end of SETQ (SET_TILE "just_option" "just_mr") ) ;_ end of PROGN (PROGN (SETQ do_right_just "No" just_option "just_ml" ) ;_ end of SETQ (SET_TILE "just_option" "just_ml") ) ;_ end of PROGN ) ;_ end of IF (IF m-leader (VL-BB-SET 'bb-m-leader m-leader) (IF my-m-leader (PROGN (SETQ m-leader my-m-leader) (VL-BB-SET 'bb-m-leader m-leader)) (IF (SETQ m-leader (VL-BB-REF 'bb-m-leader)) nil (PROGN (SETQ m-leader "0" my-m-leader "0" ) ;_ end of SETQ (VL-BB-SET 'bb-m-leader m-leader) ) ;_ end of PROGN ) ;_ end of IF ) ;_ end of IF ) ;_ end of IF (SET_TILE "m-leader" m-leader) (IF (AND t-leader (NOT (EQ m-leader "1"))) (VL-BB-SET 'bb-t-leader t-leader) (IF (AND my-t-leader (NOT (EQ m-leader "1"))) (PROGN (SETQ t-leader my-t-leader) (VL-BB-SET 'bb-t-leader t-leader)) (IF (AND (NOT (EQ m-leader "1")) (SETQ t-leader (VL-BB-REF 'bb-t-leader))) nil (PROGN (SETQ t-leader "0" my-t-leader "0" ) ;_ end of SETQ (VL-BB-SET 'bb-t-leader t-leader) ) ;_ end of PROGN ) ;_ end of IF ) ;_ end of IF ) ;_ end of IF (COND ((AND as-existing (EQ as-existing "1")) (SETQ do_exist T) (VL-BB-SET 'bb-do_exist T)) ((EQ as-existing "0") (SETQ do_exist nil) (VL-BB-SET 'bb-do_exist nil)) ((EQ do_exist T) (VL-BB-SET 'bb-do_exist T) (SETQ as-existing "1")) (T (VL-BB-SET 'bb-do_exist nil) (SETQ as-existing "0" do_exist nil ) ;_ end of SETQ ) ) ;_ end of COND (SET_TILE "as-existing" as-existing) (IF (EQ m-leader "1") (PROGN (MODE_TILE "t-leader" 1) (SET_TILE "t-leader" "0")) (PROGN (MODE_TILE "t-leader" 0) (SET_TILE "t-leader" t-leader)) ) ;_ end of IF (set_colr_mode) (SET_TILE "add_bubble" (IF tn_add_bubble tn_add_bubble "0" ) ;_ end of if ) ;_ end of set_tile (SET_TILE "detail_desg" (IF tn_detail_desg tn_detail_desg "" ) ;_ end of if ) ;_ end of set_tile (IF (SETQ this_ttss (SSGET "X" (LIST (CONS 410 (GETVAR "CTAB")) (CONS 2 "corpttbats")))) (PROGN (SETQ this_ttbat (ENTGET (SSNAME this_ttss 0))) (WHILE (AND (SETQ this_ttbat (ENTGET (ENTNEXT (CDR (ASSOC -1 this_ttbat))))) (NOT (EQ (CDR (ASSOC 0 this_ttbat)) "SEQEND")) (IF (ASSOC 2 this_ttbat) (NOT (EQ (CDR (ASSOC 2 this_ttbat)) "SHT_NO.")) T ) ;_ end of IF ) ;_ end of AND ) ;_ end of WHILE (IF (EQ (CDR (ASSOC 2 this_ttbat)) "SHT_NO.") (PROGN (SETQ this_from (CDR (ASSOC 1 this_ttbat))) (COND ((WCMATCH this_from "-*") (SETQ count 2) (WHILE (WCMATCH this_from "-*") (SETQ this_from (SUBSTR this_from count) count (1+ count) ) ;_ end of SETQ ) ;_ end of WHILE ) ((WCMATCH this_from "*-") (SETQ count (1- (STRLEN this_from))) (WHILE (WCMATCH this_from "*-") (SETQ this_from (SUBSTR this_from 1 count) count (1- count) ) ;_ end of SETQ ) ;_ end of WHILE ) ((WCMATCH this_from "*-*") (SETQ orig_from this_from count (1- (STRLEN this_from)) ) ;_ end of SETQ (WHILE (NOT (WCMATCH this_from "*-")) (SETQ this_from (SUBSTR this_from 1 count) count (1- count) ) ;_ end of SETQ ) ;_ end of WHILE (SETQ count2 count count 2 ) ;_ end of SETQ (WHILE (NOT (WCMATCH this_from "-*")) (SETQ this_from (SUBSTR orig_from count) count (1+ count) ) ;_ end of SETQ ) ;_ end of WHILE (SETQ this_from (STRCAT (SUBSTR orig_from 1 count2) (SUBSTR orig_from count))) ) ) ;_ end of COND ) ;_ end of PROGN ) ;_ end of IF ) ;_ end of PROGN ) ;_ end of IF (SET_TILE "sheet_from" (IF this_from this_from (IF tn_sheet_from tn_sheet_from "" ) ;_ end of IF ) ;_ end of if ) ;_ end of set_tile (SET_TILE "sheet_locn" (IF tn_sheet_locn tn_sheet_locn "" ) ;_ end of if ) ;_ end of set_tile (IF pview_lst (SETQ wrap_int (LENGTH pview_lst)) (IF wrap_int nil (SETQ wrap_int 1) ) ;_ end of IF ) ;_ end of IF (SET_TILE "Wrap_lines" (ITOA (1- wrap_int))) (IF (OR (NOT tn_add_bubble) (EQ tn_add_bubble "0")) (PROGN (MODE_TILE "detail_desg" 1) (MODE_TILE "sheet_from" 1) (MODE_TILE "sheet_locn" 1)) ;_ end of progn (PROGN (MODE_TILE "detail_desg" 0) (MODE_TILE "sheet_from" 0) (MODE_TILE "sheet_locn" 0)) ;_ end of progn ) ;_ end of if (IF (AND sel_key (EQ (TYPE sel_key) 'str) (EQ (TYPE (READ sel_key)) 'int) tnote_list (> (LENGTH tnote_list) (READ sel_key)) ) ;_ end of AND (PROGN (IF (> (STRLEN (NTH (READ sel_key) tnote_list)) 132) (PROGN (SET_TILE "new_item" (SUBSTR (NTH (READ sel_key) tnote_list) 1 132)) (SET_TILE "new_item2" (SUBSTR (NTH (READ sel_key) tnote_list) 133)) ) ;_ end of PROGN (PROGN (SET_TILE "new_item" (NTH (READ sel_key) tnote_list)) (SET_TILE "new_item2" "")) ) ;_ end of IF (tn_set_caps) (set_pview) ) ;_ end of PROGN ;;; (IF prev_ntx1 ;;; (PROGN ;;; (SETQ prev_mlt_note ;;; (STRCAT prev_ntx1 ;;; (IF prev_ntx2 (STRCAT " " prev_ntx2) "") ;;; (IF prev_ntx3 (STRCAT " " prev_ntx3) "") ;;; (IF prev_ntx4 (STRCAT " " prev_ntx4) "") ;;; (IF prev_ntx5 (STRCAT " " prev_ntx5) "") ;;; (IF prev_ntx6 (STRCAT " " prev_ntx6) "") ;;; (IF prev_ntx7 (STRCAT " " prev_ntx7) "") ;;; (IF prev_ntx8 (STRCAT " " prev_ntx8) "") ;;; (IF prev_ntx9 (STRCAT " " prev_ntx9) "") ;;; (IF prev_ntx10 (STRCAT " " prev_ntx10) "") ;;; ) ;;; ) ;;; (IF (> (STRLEN prev_mlt_note) 132) ;;; (PROGN ;;; (SET_TILE "new_item" (SUBSTR prev_mlt_note 1 132)) ;;; (SET_TILE "new_item2" (SUBSTR prev_mlt_note 133)) ;;; ) ;;; (PROGN ;;; (SET_TILE "new_item" prev_mlt_note) ;;; (SET_TILE "new_item2" "") ;;; ) ;;; ) ;;; (tn_set_caps) ;;; (set_pview) ;;; ) (IF prev_mlt_note (PROGN (IF (> (STRLEN prev_mlt_note) 132) (PROGN (SET_TILE "new_item" (SUBSTR prev_mlt_note 1 132)) (SET_TILE "new_item2" (SUBSTR prev_mlt_note 133)) ) ;_ end of PROGN (PROGN (SET_TILE "new_item" prev_mlt_note) (SET_TILE "new_item2" "")) ) ;_ end of IF (tn_set_caps) (set_pview) ) ;_ end of PROGN ) ;_ end of IF ;;; ) ) ;_ end of IF (IF ctxt-str (PROGN (SET_TILE "new_item" ctxt-str) (SET_TILE "new_item2" "") (SETQ ctxt-str nil)) ) ;_ end of IF (ACTION_TILE "tn_datlocn" "(setq tn_datlocn (get_tile\"tn_datlocn\") change_datlocn T)(get_tnotedat_file)" ) ;_ end of ACTION_TILE (ACTION_TILE "Browse_datf" "(setq do_browse T)(get_tnotedat_file)") (ACTION_TILE "Major" "(Major_action)" ;;; "(setq sel_key(get_tile\"Major\"))(set_tnote_ebox)(newitem_mgr)(set_wrap)(set_pview)(SET_TILE\"Wrap_lines\"(ITOA(1-(LENGTH pview_lst))))(if(eq $reason 4)(progn(set_bubl)(setq tn_pl_note T tnpset_size(get_tile\"leroy_size\"))(done_dialog)))";(setq tn_newitem(strcat(get_tile\"new_item\")(get_tile\"new_item2\"))) ) ;_ end of action_tile (ACTION_TILE "Search" "(setq tn_srch_str (strcat \"*\"(get_tile \"new_item\")\"*\"))(setq from_srch T)(srch_tnlist)" ) ;_ end of ACTION_TILE (ACTION_TILE "tn_space" "(setq tn_space (get_tile\"tn_space\"))") (ACTION_TILE "force_caps" "(setq tn_fcaps (get_tile \"force_caps\"))(tn_set_caps)") ;_ end of action_tile (ACTION_TILE "new_item" "(newitem_mgr)(SET_TILE\"Wrap_lines\"(ITOA(1-(LENGTH pview_lst))))") ;;; "(setq tn_newitem (strcat(get_tile \"new_item\")(get_tile\"new_item2\")))(tn_set_caps)(set_pview)" (ACTION_TILE "new_item2" "(newitem_mgr)(SET_TILE\"Wrap_lines\"(ITOA(1-(LENGTH pview_lst))))") (ACTION_TILE "copy_current" "(copyto_wsp)") ;;; "(setq tn_newitem (strcat(get_tile \"new_item\")(get_tile \"new_item2\")))(tn_set_caps)(set_pview)" (ACTION_TILE "non_item1" "(newitem_mgr)") (ACTION_TILE "non_item2" "(newitem_mgr)") (ACTION_TILE "non_item3" "(newitem_mgr)") (ACTION_TILE "paste_workspace" "(paste_wsedits)(SET_TILE\"Wrap_lines\"(ITOA(1-(LENGTH pview_lst))))" ) ;_ end of ACTION_TILE (ACTION_TILE "clear_note" "(clear_wsnote)") (ACTION_TILE "note_view" "(pview)") (ACTION_TILE "Wrap_value" "(Wrap_value_action)" ;;; "(setq tn_wrap_len(get_tile\"Wrap_value\"))(set_tile\"Wrap_slide\"tn_wrap_len)(newitem_mgr)(set_bubl)(set_pview)(SET_TILE\"Wrap_lines\"(ITOA(1-(LENGTH pview_lst))))";(setq tn_newitem(strcat(get_tile\"new_item\")(get_tile\"new_item2\"))) ) ;_ end of action_tile (ACTION_TILE "Wrap_slide" "(Wrap_slide_action)" ;;; "(setq tn_wrap_len(get_tile\"Wrap_slide\"))(set_tile\"Wrap_value\"tn_wrap_len)(newitem_mgr)(set_bubl)(set_pview)(SET_TILE\"Wrap_lines\"(ITOA(1-(LENGTH pview_lst))))";(setq tn_newitem(strcat(get_tile\"new_item\")(get_tile\"new_item2\"))) ) ;_ end of action_tile (ACTION_TILE "Wrap_lines" "(Wrap_lines_action)" ;;; "(setq tn_wrap_lines(get_tile\"Wrap_lines\"))(newitem_mgr)(do_abstr)(set_bubl)(set_pview)(SET_TILE\"Wrap_lines\"(ITOA(1-(LENGTH pview_lst))))";(setq tn_newitem(strcat(get_tile\"new_item\")(get_tile\"new_item2\"))) ) ;_ end of action_tile (ACTION_TILE "t-leader" "(set-t-leader)") (ACTION_TILE "m-leader" "(set-m-leader)") (ACTION_TILE "as-existing" "(set-as-existing)") (ACTION_TILE "colr_over" "(setq colr_over (get_tile \"colr_over\"))(set_colr_mode)") (ACTION_TILE "ldrc_value" "(SETQ mycolor_text \"ldrc_value\" ascii_color $value)(set_ascolor)") (ACTION_TILE "txtc_value" "(SETQ mycolor_text \"txtc_value\" ascii_color $value)(set_ascolor)") (ACTION_TILE "ldrc_swatch" "(SETQ cur_color (get_tile\"ldrc_value\") mycolor_text \"ldrc_value\")(set_tnotecolor)" ) ;_ end of ACTION_TILE (ACTION_TILE "txtc_swatch" "(SETQ cur_color (get_tile\"txtc_value\") mycolor_text \"txtc_value\")(set_tnotecolor)" ) ;_ end of ACTION_TILE (ACTION_TILE "decimal_size" "(set_decimal (get_tile\"decimal_size\"))") (ACTION_TILE "leroy_size" "(set_leroy (get_tile\"leroy_size\"))") (ACTION_TILE "just_mr" "(set_just (get_tile\"just_option\"))") (ACTION_TILE "just_ml" "(set_just (get_tile\"just_option\"))") (ACTION_TILE "add_bubble" "(set_bubl)") (ACTION_TILE "detail_desg" "(set_bubl)") (ACTION_TILE "sheet_from" "(set_bubl)") (ACTION_TILE "sheet_locn" "(set_bubl)") (ACTION_TILE "Save_changes" "(add_tn_item)(set_bubl)(upd_tnote_dat)") ;_ end of ACTION_TILE ;;; (ACTION_TILE ;;; "Saveas_new" ;;; "(set_bubl)(new_tnote_dat)" ;;; ) ;_ end of ACTION_TILE (ACTION_TILE "backupdat" "(mandatbak)") (ACTION_TILE "Add_more" "(setq tn_newitem (strcat(get_tile \"new_item\")(get_tile\"new_item2\")))(add_tn_item)(mode_tile \"new_item\" 2)" ) ;_ end of action_tile (ACTION_TILE "Repl_line" "(setq tn_repl_key (get_tile \"Major\"))(repl_item)") ;_ end of action_tile (ACTION_TILE "Delete_line" "(setq tn_del_key (get_tile \"Major\"))(del_tnlines)(set_tile\"new_item\" \"\")" ) ;_ end of action_tile (ACTION_TILE "Place_note" "(setq tn_newitem (strcat(get_tile \"new_item\")(get_tile\"new_item2\")))(add_tn_item)(Wrap_lines_action)(setq tn_pl_note T tnpset_size (get_tile\"leroy_size\"))(SETQ tnote_loc(done_dialog 1))" ) ;_ end of action_tile (ACTION_TILE "Place_note2" "(setq tn_newitem (strcat(get_tile \"new_item\")(get_tile\"new_item2\")))(add_tn_item)(set_bubl)(setq tn_pl_note T tnpset_size (get_tile\"leroy_size\"))(SETQ tnote_loc(done_dialog 1))" ) ;_ end of action_tile (ACTION_TILE "Add_cancel" "(setq tnpset_size nil)(SETQ tnote_loc(done_dialog 0))") (ACTION_TILE "help_tnote" "(browser_help \"tnote\")") (f_tnote) (IF tn_wrap_len (PROGN (SET_TILE "Wrap_value" tn_wrap_len) (SET_TILE "Wrap_slide" tn_wrap_len)) ;_ end of progn (PROGN (SET_TILE "Wrap_value" "21") (SET_TILE "Wrap_slide" "21")) ;_ end of progn ) ;_ end of if (MODE_TILE "new_item" 2) (START_DIALOG) ;;; (UNLOAD_DIALOG tn_num) (IF (WCMATCH (STRCASE (GETVAR "CMDNAMES")) "*DIM*") (COMMAND nil nil) ) ;_ end of IF (IF tn_pl_note (place_note) (PRINC) ) ;_ end of if (IF old_tnoterror (SETQ *error* old_tnoterror) ) ;_ end of IF (SETQ prev_sel_key sel_key) (IF getstyle (getstyle "") ) ;_ end of IF (PRINC) ) ;_ end of defun ;;;******************************************************************** (DEFUN major_action () ;;; "(setq sel_key(get_tile\"Major\"))(set_tnote_ebox)(newitem_mgr)(set_wrap)(set_pview)(SET_TILE\"Wrap_lines\"(ITOA(1-(LENGTH pview_lst))))(if(eq $reason 4)(progn(set_bubl)(setq tn_pl_note T tnpset_size(get_tile\"leroy_size\"))(done_dialog)))";(setq tn_newitem(strcat(get_tile\"new_item\")(get_tile\"new_item2\"))) (SETQ sel_key (GET_TILE "Major")) (set_tnote_ebox) (newitem_mgr) (set_bubl) (set_pview) (SET_TILE "Wrap_lines" (ITOA (1- (LENGTH pview_lst)))) ;;; (setq tn_wrap_lines (ITOA(1+(atoi(get_tile "Wrap_lines"))))) ;;; (setq tn_wrap_len (get_tile "Wrap_value")) ;;; (setq tn_wrap_slide tn_wrap_len) ;;; (ALERT (STRCAT "Wrap_lines=" tn_wrap_lines "; Wrap_len=" tn_wrap_len "; Wrap_slide=" tn_wrap_slide)) (IF (EQ $reason 4) (PROGN (SETQ tn_pl_note T tnpset_size (GET_TILE "leroy_size") ) ;_ end of setq (DONE_DIALOG) ) ;_ end of progn ) ;_ end of if ) ;_ end of DEFUN ;;;******************************************************************** (DEFUN wrap_value_action () (SETQ new_tn_wrap_len (GET_TILE "Wrap_value")) (SET_TILE "Wrap_slide" new_tn_wrap_len) (SETQ new_tn_wrap_slide new_tn_wrap_len) ;;; (ALERT (STRCAT "Wrap_value_action before (newitem_mgr):\nWrap_lines=" tn_wrap_lines "; Wrap_len=" tn_wrap_len "; Wrap_slide=" tn_wrap_slide)) (newitem_mgr) ;;; (ALERT (STRCAT "Wrap_value_action before (set_bubl):\nWrap_lines=" tn_wrap_lines "; Wrap_len=" tn_wrap_len "; Wrap_slide=" tn_wrap_slide)) (set_bubl) ;;; (ALERT (STRCAT "Wrap_value_action before (set_pview):\nWrap_lines=" tn_wrap_lines "; Wrap_len=" tn_wrap_len "; Wrap_slide=" tn_wrap_slide)) (set_pview) ;;; (ALERT (STRCAT "Wrap_value_action before (SET_TILE \"Wrap_lines\"):\nWrap_lines=" tn_wrap_lines "; Wrap_len=" tn_wrap_len "; Wrap_slide=" tn_wrap_slide)) (SET_TILE "Wrap_lines" (ITOA (1- (LENGTH pview_lst)))) (SETQ tn_wrap_lines (ITOA (1+ (ATOI (GET_TILE "Wrap_lines"))))) (SETQ tn_wrap_slide tn_wrap_len) ;;; (ALERT (STRCAT "Wrap_value_action END:\nWrap_lines=" tn_wrap_lines "; Wrap_len=" tn_wrap_len "; Wrap_slide=" tn_wrap_slide)) ) ;_ end of DEFUN ;;;******************************************************************** (DEFUN wrap_slide_action () (SETQ new_tn_wrap_slide (GET_TILE "Wrap_slide")) (SET_TILE "Wrap_value" new_tn_wrap_slide) (SETQ new_tn_wrap_len new_tn_wrap_slide) (newitem_mgr) (set_bubl) (set_pview) (SET_TILE "Wrap_lines" (ITOA (1- (LENGTH pview_lst)))) (SETQ tn_wrap_lines (ITOA (1+ (ATOI (GET_TILE "Wrap_lines"))))) ) ;_ end of DEFUN ;;;******************************************************************** (DEFUN wrap_lines_action () (SETQ tn_wrap_lines (ITOA (1+ (ATOI (GET_TILE "Wrap_lines"))))) (newitem_mgr) (do_abstr) (set_bubl) (set_pview) (SET_TILE "Wrap_lines" (ITOA (1- (LENGTH pview_lst)))) (SETQ tn_wrap_lines (ITOA (1+ (ATOI (GET_TILE "Wrap_lines"))))) (SETQ tn_wrap_len (ITOA (EVAL (CONS 'MAX (MAPCAR 'STRLEN pview_lst))))) ;;; (SET_TILE "error" (itoa tn_wrap_lines)) (SETQ tn_wrap_slide tn_wrap_len) (SET_TILE "wrap_value" tn_wrap_len) (SET_TILE "wrap_slide" tn_wrap_slide) ) ;_ end of DEFUN ;;;******************************************************************** (DEFUN clear_wsnote () (SETQ new_item nil) (SET_TILE "new_item" "") (SETQ new_item2 nil) (SET_TILE "new_item2" "") (SET_TILE "non_item1" "") (SET_TILE "non_item2" "") (SET_TILE "non_item3" "") (SETQ tn_newitem "") (SETQ tn_tokens nil) (SETQ non_item "") (set_pview) ) ;_ end of DEFUN ;;;******************************************************************** (DEFUN set-t-leader () (IF (EQ m-leader "1") (PROGN (SETQ t-leader "0" my-t-leader "0" ) ;_ end of setq (MODE_TILE "t-leader" 1) (SET_TILE "t-leader" t-leader) ) ;_ end of PROGN (PROGN (MODE_TILE "t-leader" 0) (SETQ t-leader (GET_TILE "t-leader") my-t-leader t-leader ) ;_ end of setq (SET_TILE "t-leader" t-leader) ) ;_ end of PROGN ) ;_ end of IF (VL-BB-SET 'bb-t-leader t-leader) ) ;_ end of DEFUN ;;;******************************************************************** (DEFUN set-m-leader () (SETQ m-leader (GET_TILE "m-leader") my-m-leader m-leader ) ;_ end of setq (IF (EQ m-leader "1") (PROGN (SETQ t-leader "0") (SET_TILE "t-leader" "0")) ) ;_ end of IF (MODE_TILE "t-leader" (ATOI m-leader)) (VL-BB-SET 'bb-m-leader m-leader) ) ;_ end of DEFUN ;;;******************************************************************** (DEFUN set-as-existing () (SETQ as-existing (GET_TILE "as-existing")) (IF (EQ as-existing "1") (PROGN (SETQ exist_option "Yes" do_exist T ) ;_ end of SETQ (VL-BB-SET 'bb-do_exist T) ) ;_ end of PROGN (PROGN (SETQ exist_option "No" do_exist nil ) ;_ end of SETQ (VL-BB-SET 'bb-do_exist nil) ) ;_ end of PROGN ) ;_ end of if ) ;_ end of DEFUN ;;;******************************************************************** (DEFUN set_tnotecolor (/) (NEW_DIALOG "tno_set_color" tn_num "" (IF color_loc color_loc '(-1 -1) ) ;_ end of IF ) ;_ end of NEW_DIALOG (ACTION_TILE "001" "(set_tnotecolor_no 1)") ; (ACTION_TILE "002" "(set_tnotecolor_no 2)") ; (ACTION_TILE "003" "(set_tnotecolor_no 3)") ; (ACTION_TILE "004" "(set_tnotecolor_no 4)") ; (ACTION_TILE "005" "(set_tnotecolor_no 5)") ; (ACTION_TILE "006" "(set_tnotecolor_no 6)") ; (ACTION_TILE "007" "(set_tnotecolor_no 7)") ; (ACTION_TILE "008" "(set_tnotecolor_no 8)") ; (ACTION_TILE "009" "(set_tnotecolor_no 9)") ; (ACTION_TILE "010" "(set_tnotecolor_no 10)") ; (ACTION_TILE "011" "(set_tnotecolor_no 11)") ; (ACTION_TILE "012" "(set_tnotecolor_no 12)") ; (ACTION_TILE "013" "(set_tnotecolor_no 13)") ; (ACTION_TILE "014" "(set_tnotecolor_no 14)") ; (ACTION_TILE "015" "(set_tnotecolor_no 15)") ; (ACTION_TILE "016" "(set_tnotecolor_no 16)") ; (ACTION_TILE "017" "(set_tnotecolor_no 17)") ; (ACTION_TILE "018" "(set_tnotecolor_no 18)") ; (ACTION_TILE "019" "(set_tnotecolor_no 19)") ; (ACTION_TILE "020" "(set_tnotecolor_no 20)") ; (ACTION_TILE "021" "(set_tnotecolor_no 21)") ; (ACTION_TILE "022" "(set_tnotecolor_no 22)") ; (ACTION_TILE "023" "(set_tnotecolor_no 23)") ; (ACTION_TILE "024" "(set_tnotecolor_no 24)") ; (ACTION_TILE "025" "(set_tnotecolor_no 25)") ; (ACTION_TILE "026" "(set_tnotecolor_no 26)") ; (ACTION_TILE "027" "(set_tnotecolor_no 27)") ; (ACTION_TILE "028" "(set_tnotecolor_no 28)") ; (ACTION_TILE "029" "(set_tnotecolor_no 29)") ; (ACTION_TILE "030" "(set_tnotecolor_no 30)") ; (ACTION_TILE "031" "(set_tnotecolor_no 31)") ; (ACTION_TILE "032" "(set_tnotecolor_no 32)") ; (ACTION_TILE "033" "(set_tnotecolor_no 33)") ; (ACTION_TILE "034" "(set_tnotecolor_no 34)") ; (ACTION_TILE "035" "(set_tnotecolor_no 35)") ; (ACTION_TILE "036" "(set_tnotecolor_no 36)") ; (ACTION_TILE "037" "(set_tnotecolor_no 37)") ; (ACTION_TILE "038" "(set_tnotecolor_no 38)") ; (ACTION_TILE "039" "(set_tnotecolor_no 39)") ; (ACTION_TILE "040" "(set_tnotecolor_no 40)") ; (ACTION_TILE "041" "(set_tnotecolor_no 41)") ; (ACTION_TILE "042" "(set_tnotecolor_no 42)") ; (ACTION_TILE "043" "(set_tnotecolor_no 43)") ; (ACTION_TILE "044" "(set_tnotecolor_no 44)") ; (ACTION_TILE "045" "(set_tnotecolor_no 45)") ; (ACTION_TILE "046" "(set_tnotecolor_no 46)") ; (ACTION_TILE "047" "(set_tnotecolor_no 47)") ; (ACTION_TILE "048" "(set_tnotecolor_no 48)") ; (ACTION_TILE "049" "(set_tnotecolor_no 49)") ; (ACTION_TILE "050" "(set_tnotecolor_no 50)") ; (ACTION_TILE "051" "(set_tnotecolor_no 51)") ; (ACTION_TILE "052" "(set_tnotecolor_no 52)") ; (ACTION_TILE "053" "(set_tnotecolor_no 53)") ; (ACTION_TILE "054" "(set_tnotecolor_no 54)") ; (ACTION_TILE "055" "(set_tnotecolor_no 55)") ; (ACTION_TILE "056" "(set_tnotecolor_no 56)") ; (ACTION_TILE "057" "(set_tnotecolor_no 57)") ; (ACTION_TILE "058" "(set_tnotecolor_no 58)") ; (ACTION_TILE "059" "(set_tnotecolor_no 59)") ; (ACTION_TILE "060" "(set_tnotecolor_no 60)") ; (ACTION_TILE "061" "(set_tnotecolor_no 61)") ; (ACTION_TILE "062" "(set_tnotecolor_no 62)") ; (ACTION_TILE "063" "(set_tnotecolor_no 63)") ; (ACTION_TILE "064" "(set_tnotecolor_no 64)") ; (ACTION_TILE "065" "(set_tnotecolor_no 65)") ; (ACTION_TILE "066" "(set_tnotecolor_no 66)") ; (ACTION_TILE "067" "(set_tnotecolor_no 67)") ; (ACTION_TILE "068" "(set_tnotecolor_no 68)") ; (ACTION_TILE "069" "(set_tnotecolor_no 69)") ; (ACTION_TILE "070" "(set_tnotecolor_no 70)") ; (ACTION_TILE "071" "(set_tnotecolor_no 71)") ; (ACTION_TILE "072" "(set_tnotecolor_no 72)") ; (ACTION_TILE "073" "(set_tnotecolor_no 73)") ; (ACTION_TILE "074" "(set_tnotecolor_no 74)") ; (ACTION_TILE "075" "(set_tnotecolor_no 75)") ; (ACTION_TILE "076" "(set_tnotecolor_no 76)") ; (ACTION_TILE "077" "(set_tnotecolor_no 77)") ; (ACTION_TILE "078" "(set_tnotecolor_no 78)") ; (ACTION_TILE "079" "(set_tnotecolor_no 79)") ; (ACTION_TILE "080" "(set_tnotecolor_no 80)") ; (ACTION_TILE "081" "(set_tnotecolor_no 81)") ; (ACTION_TILE "082" "(set_tnotecolor_no 82)") ; (ACTION_TILE "083" "(set_tnotecolor_no 83)") ; (ACTION_TILE "084" "(set_tnotecolor_no 84)") ; (ACTION_TILE "085" "(set_tnotecolor_no 85)") ; (ACTION_TILE "086" "(set_tnotecolor_no 86)") ; (ACTION_TILE "087" "(set_tnotecolor_no 87)") ; (ACTION_TILE "088" "(set_tnotecolor_no 88)") ; (ACTION_TILE "089" "(set_tnotecolor_no 89)") ; (ACTION_TILE "090" "(set_tnotecolor_no 90)") ; (ACTION_TILE "091" "(set_tnotecolor_no 91)") ; (ACTION_TILE "092" "(set_tnotecolor_no 92)") ; (ACTION_TILE "093" "(set_tnotecolor_no 93)") ; (ACTION_TILE "094" "(set_tnotecolor_no 94)") ; (ACTION_TILE "095" "(set_tnotecolor_no 95)") ; (ACTION_TILE "096" "(set_tnotecolor_no 96)") ; (ACTION_TILE "097" "(set_tnotecolor_no 97)") ; (ACTION_TILE "098" "(set_tnotecolor_no 98)") ; (ACTION_TILE "099" "(set_tnotecolor_no 99)") ; (ACTION_TILE "100" "(set_tnotecolor_no 100)") ; (ACTION_TILE "101" "(set_tnotecolor_no 101)") ; (ACTION_TILE "102" "(set_tnotecolor_no 102)") ; (ACTION_TILE "103" "(set_tnotecolor_no 103)") ; (ACTION_TILE "104" "(set_tnotecolor_no 104)") ; (ACTION_TILE "105" "(set_tnotecolor_no 105)") ; (ACTION_TILE "106" "(set_tnotecolor_no 106)") ; (ACTION_TILE "107" "(set_tnotecolor_no 107)") ; (ACTION_TILE "108" "(set_tnotecolor_no 108)") ; (ACTION_TILE "109" "(set_tnotecolor_no 109)") ; (ACTION_TILE "110" "(set_tnotecolor_no 110)") ; (ACTION_TILE "111" "(set_tnotecolor_no 111)") ; (ACTION_TILE "112" "(set_tnotecolor_no 112)") ; (ACTION_TILE "113" "(set_tnotecolor_no 113)") ; (ACTION_TILE "114" "(set_tnotecolor_no 114)") ; (ACTION_TILE "115" "(set_tnotecolor_no 115)") ; (ACTION_TILE "116" "(set_tnotecolor_no 116)") ; (ACTION_TILE "117" "(set_tnotecolor_no 117)") ; (ACTION_TILE "118" "(set_tnotecolor_no 118)") ; (ACTION_TILE "119" "(set_tnotecolor_no 119)") ; (ACTION_TILE "120" "(set_tnotecolor_no 120)") ; (ACTION_TILE "121" "(set_tnotecolor_no 121)") ; (ACTION_TILE "122" "(set_tnotecolor_no 122)") ; (ACTION_TILE "123" "(set_tnotecolor_no 123)") ; (ACTION_TILE "124" "(set_tnotecolor_no 124)") ; (ACTION_TILE "125" "(set_tnotecolor_no 125)") ; (ACTION_TILE "126" "(set_tnotecolor_no 126)") ; (ACTION_TILE "127" "(set_tnotecolor_no 127)") ; (ACTION_TILE "128" "(set_tnotecolor_no 128)") ; (ACTION_TILE "129" "(set_tnotecolor_no 129)") ; (ACTION_TILE "130" "(set_tnotecolor_no 130)") ; (ACTION_TILE "131" "(set_tnotecolor_no 131)") ; (ACTION_TILE "132" "(set_tnotecolor_no 132)") ; (ACTION_TILE "133" "(set_tnotecolor_no 133)") ; (ACTION_TILE "134" "(set_tnotecolor_no 134)") ; (ACTION_TILE "135" "(set_tnotecolor_no 135)") ; (ACTION_TILE "136" "(set_tnotecolor_no 136)") ; (ACTION_TILE "137" "(set_tnotecolor_no 137)") ; (ACTION_TILE "138" "(set_tnotecolor_no 138)") ; (ACTION_TILE "139" "(set_tnotecolor_no 139)") ; (ACTION_TILE "140" "(set_tnotecolor_no 140)") ; (ACTION_TILE "141" "(set_tnotecolor_no 141)") ; (ACTION_TILE "142" "(set_tnotecolor_no 142)") ; (ACTION_TILE "143" "(set_tnotecolor_no 143)") ; (ACTION_TILE "144" "(set_tnotecolor_no 144)") ; (ACTION_TILE "145" "(set_tnotecolor_no 145)") ; (ACTION_TILE "146" "(set_tnotecolor_no 146)") ; (ACTION_TILE "147" "(set_tnotecolor_no 147)") ; (ACTION_TILE "148" "(set_tnotecolor_no 148)") ; (ACTION_TILE "149" "(set_tnotecolor_no 149)") ; (ACTION_TILE "150" "(set_tnotecolor_no 150)") ; (ACTION_TILE "151" "(set_tnotecolor_no 151)") ; (ACTION_TILE "152" "(set_tnotecolor_no 152)") ; (ACTION_TILE "153" "(set_tnotecolor_no 153)") ; (ACTION_TILE "154" "(set_tnotecolor_no 154)") ; (ACTION_TILE "155" "(set_tnotecolor_no 155)") ; (ACTION_TILE "156" "(set_tnotecolor_no 156)") ; (ACTION_TILE "157" "(set_tnotecolor_no 157)") ; (ACTION_TILE "158" "(set_tnotecolor_no 158)") ; (ACTION_TILE "159" "(set_tnotecolor_no 159)") ; (ACTION_TILE "160" "(set_tnotecolor_no 160)") ; (ACTION_TILE "161" "(set_tnotecolor_no 161)") ; (ACTION_TILE "162" "(set_tnotecolor_no 162)") ; (ACTION_TILE "163" "(set_tnotecolor_no 163)") ; (ACTION_TILE "164" "(set_tnotecolor_no 164)") ; (ACTION_TILE "165" "(set_tnotecolor_no 165)") ; (ACTION_TILE "166" "(set_tnotecolor_no 166)") ; (ACTION_TILE "167" "(set_tnotecolor_no 167)") ; (ACTION_TILE "168" "(set_tnotecolor_no 168)") ; (ACTION_TILE "169" "(set_tnotecolor_no 169)") ; (ACTION_TILE "170" "(set_tnotecolor_no 170)") ; (ACTION_TILE "171" "(set_tnotecolor_no 171)") ; (ACTION_TILE "172" "(set_tnotecolor_no 172)") ; (ACTION_TILE "173" "(set_tnotecolor_no 173)") ; (ACTION_TILE "174" "(set_tnotecolor_no 174)") ; (ACTION_TILE "175" "(set_tnotecolor_no 175)") ; (ACTION_TILE "176" "(set_tnotecolor_no 176)") ; (ACTION_TILE "177" "(set_tnotecolor_no 177)") ; (ACTION_TILE "178" "(set_tnotecolor_no 178)") ; (ACTION_TILE "179" "(set_tnotecolor_no 179)") ; (ACTION_TILE "180" "(set_tnotecolor_no 180)") ; (ACTION_TILE "181" "(set_tnotecolor_no 181)") ; (ACTION_TILE "182" "(set_tnotecolor_no 182)") ; (ACTION_TILE "183" "(set_tnotecolor_no 183)") ; (ACTION_TILE "184" "(set_tnotecolor_no 184)") ; (ACTION_TILE "185" "(set_tnotecolor_no 185)") ; (ACTION_TILE "186" "(set_tnotecolor_no 186)") ; (ACTION_TILE "187" "(set_tnotecolor_no 187)") ; (ACTION_TILE "188" "(set_tnotecolor_no 188)") ; (ACTION_TILE "189" "(set_tnotecolor_no 189)") ; (ACTION_TILE "190" "(set_tnotecolor_no 190)") ; (ACTION_TILE "191" "(set_tnotecolor_no 191)") ; (ACTION_TILE "192" "(set_tnotecolor_no 192)") ; (ACTION_TILE "193" "(set_tnotecolor_no 193)") ; (ACTION_TILE "194" "(set_tnotecolor_no 194)") ; (ACTION_TILE "195" "(set_tnotecolor_no 195)") ; (ACTION_TILE "196" "(set_tnotecolor_no 196)") ; (ACTION_TILE "197" "(set_tnotecolor_no 197)") ; (ACTION_TILE "198" "(set_tnotecolor_no 198)") ; (ACTION_TILE "199" "(set_tnotecolor_no 199)") ; (ACTION_TILE "200" "(set_tnotecolor_no 200)") ; (ACTION_TILE "201" "(set_tnotecolor_no 201)") ; (ACTION_TILE "202" "(set_tnotecolor_no 202)") ; (ACTION_TILE "203" "(set_tnotecolor_no 203)") ; (ACTION_TILE "204" "(set_tnotecolor_no 204)") ; (ACTION_TILE "205" "(set_tnotecolor_no 205)") ; (ACTION_TILE "206" "(set_tnotecolor_no 206)") ; (ACTION_TILE "207" "(set_tnotecolor_no 207)") ; (ACTION_TILE "208" "(set_tnotecolor_no 208)") ; (ACTION_TILE "209" "(set_tnotecolor_no 209)") ; (ACTION_TILE "210" "(set_tnotecolor_no 210)") ; (ACTION_TILE "211" "(set_tnotecolor_no 211)") ; (ACTION_TILE "212" "(set_tnotecolor_no 212)") ; (ACTION_TILE "213" "(set_tnotecolor_no 213)") ; (ACTION_TILE "214" "(set_tnotecolor_no 214)") ; (ACTION_TILE "215" "(set_tnotecolor_no 215)") ; (ACTION_TILE "216" "(set_tnotecolor_no 216)") ; (ACTION_TILE "217" "(set_tnotecolor_no 217)") ; (ACTION_TILE "218" "(set_tnotecolor_no 218)") ; (ACTION_TILE "219" "(set_tnotecolor_no 219)") ; (ACTION_TILE "220" "(set_tnotecolor_no 220)") ; (ACTION_TILE "221" "(set_tnotecolor_no 221)") ; (ACTION_TILE "222" "(set_tnotecolor_no 222)") ; (ACTION_TILE "223" "(set_tnotecolor_no 223)") ; (ACTION_TILE "224" "(set_tnotecolor_no 224)") ; (ACTION_TILE "225" "(set_tnotecolor_no 225)") ; (ACTION_TILE "226" "(set_tnotecolor_no 226)") ; (ACTION_TILE "227" "(set_tnotecolor_no 227)") ; (ACTION_TILE "228" "(set_tnotecolor_no 228)") ; (ACTION_TILE "229" "(set_tnotecolor_no 229)") ; (ACTION_TILE "230" "(set_tnotecolor_no 230)") ; (ACTION_TILE "231" "(set_tnotecolor_no 231)") ; (ACTION_TILE "232" "(set_tnotecolor_no 232)") ; (ACTION_TILE "233" "(set_tnotecolor_no 233)") ; (ACTION_TILE "234" "(set_tnotecolor_no 234)") ; (ACTION_TILE "235" "(set_tnotecolor_no 235)") ; (ACTION_TILE "236" "(set_tnotecolor_no 236)") ; (ACTION_TILE "237" "(set_tnotecolor_no 237)") ; (ACTION_TILE "238" "(set_tnotecolor_no 238)") ; (ACTION_TILE "239" "(set_tnotecolor_no 239)") ; (ACTION_TILE "240" "(set_tnotecolor_no 240)") ; (ACTION_TILE "241" "(set_tnotecolor_no 241)") ; (ACTION_TILE "242" "(set_tnotecolor_no 242)") ; (ACTION_TILE "243" "(set_tnotecolor_no 243)") ; (ACTION_TILE "244" "(set_tnotecolor_no 244)") ; (ACTION_TILE "245" "(set_tnotecolor_no 245)") ; (ACTION_TILE "246" "(set_tnotecolor_no 246)") ; (ACTION_TILE "247" "(set_tnotecolor_no 247)") ; (ACTION_TILE "248" "(set_tnotecolor_no 248)") ; (ACTION_TILE "249" "(set_tnotecolor_no 249)") ; (ACTION_TILE "250" "(set_tnotecolor_no 250)") ; (ACTION_TILE "251" "(set_tnotecolor_no 251)") ; (ACTION_TILE "252" "(set_tnotecolor_no 252)") ; (ACTION_TILE "253" "(set_tnotecolor_no 253)") ; (ACTION_TILE "254" "(set_tnotecolor_no 254)") ; (ACTION_TILE "255" "(set_tnotecolor_no 255)") ; (ACTION_TILE "color_edit" "(get_color_no(get_tile\"color_edit\"))") ;_ end of action_tile (ACTION_TILE "cancel" "(set_tnotecolor_no cur_colr)") ;;; (SET_TILE "color_edit" ;;; (citocs (IF cur_colr ;;; cur_colr ;;; 0 ;;; ) ;_ end of if ;;; ) ;_ end of citocs ;;; ) ;_ end of set_tile ;;; (set_tnotecolor_no cur_colr) ;;; (COND ((EQUAL part_txt "DFIT") ;;; (SET_TILE "part_lbl" "Pipe Fitting (dbl) line") ;;; ) ;;; ((EQUAL part_txt "SFIT") ;;; (SET_TILE "part_lbl" "Pipe Fitting (sgl) line") ;;; ) ;;; ((EQUAL part_txt "DBL") ;;; (SET_TILE "part_lbl" " Double Line piping") ;;; ) ;;; ((EQUAL part_txt "SGL") ;;; (SET_TILE "part_lbl" " Single Line piping") ;;; ) ;;; ((EQUAL part_txt "CTR") ;;; (SET_TILE "part_lbl" " Piping centerline") ;;; ) ;;; ) ;_ end of cond (START_DIALOG) (set_color_swatch) ) ;_ end of defun ;;;******************************************************************** (DEFUN set_ascolor () (IF (AND ascii_color (EQ (TYPE (READ ascii_color)) 'int) mycolor_text) (PROGN (SETQ sel_color (ATOI ascii_color)) (SET_TILE mycolor_text ascii_color) (COND ((WCMATCH mycolor_text "ldr*") (SETQ tnote_ldrc ascii_color)) ((WCMATCH mycolor_text "txt*") (SETQ tnote_txtc ascii_color)) ) ;_ end of COND (COND ((NOT tno_color_list) (SETQ tno_color_list (LIST (CONS (STRCASE ascii_color) (STRCASE ascii_color)))) ) ((AND tno_color_list (MEMBER (CONS (STRCASE ascii_color) (STRCASE ascii_color)) tno_color_list)) nil ) ((AND tno_color_list (ASSOC (STRCASE ascii_color) tno_color_list)) (SETQ tno_color_list (SUBST (CONS (STRCASE ascii_color) (STRCASE ascii_color)) (ASSOC (STRCASE ascii_color) tno_color_list) tno_color_list ) ;_ end of SUBST ) ;_ end of SETQ ) (T (SETQ tno_color_list (APPEND tno_color_list (LIST (CONS (STRCASE ascii_color) (STRCASE ascii_color))))) ) ) ;_ end of COND (set_color_swatch) ) ;_ end of PROGN ) ;_ end of IF ) ;_ end of DEFUN ;;;******************************************************************** (DEFUN set_color_swatch () (COND ((WCMATCH mycolor_text "ldr*") (START_IMAGE "ldrc_swatch") (VECTOR_IMAGE 0 0 (DIMX_TILE "ldrc_swatch") (DIMY_TILE "ldrc_swatch") sel_color) (FILL_IMAGE 0 0 (DIMX_TILE "ldrc_swatch") (DIMY_TILE "ldrc_swatch") sel_color) (END_IMAGE) (SETQ ascii_color (ITOA sel_color) tnote_ldrc ascii_color ) ;_ end of SETQ (SET_TILE "ldrc_value" ascii_color) ) ((WCMATCH mycolor_text "txt*") (START_IMAGE "txtc_swatch") (VECTOR_IMAGE 0 0 (DIMX_TILE "txtc_swatch") (DIMY_TILE "txtc_swatch") sel_color) (FILL_IMAGE 0 0 (DIMX_TILE "txtc_swatch") (DIMY_TILE "txtc_swatch") sel_color) (END_IMAGE) (SETQ ascii_color (ITOA sel_color) tnote_txtc ascii_color ) ;_ end of SETQ (SET_TILE "txtc_value" ascii_color) ) ) ;_ end of COND ) ;_ end of DEFUN ;;;******************************************************************** ;;; ;;; CSTOCI -- Color string to color index ;;; Convert an arbitrary case string into a color index. ;;; Returns nil if string is not a valid color. ;;; (DEFUN cstoci (str) (IF (AND str (EQ (TYPE str) 'str)) (PROGN (SETQ str (STRCASE str)) (COND ((= str "RED") 1) ((= str "YELLOW") 2) ((= str "GREEN") 3) ((= str "CYAN") 4) ((= str "BLUE") 5) ((= str "MAGENTA") 6) ((= str "WHITE") 7) ((= str "DARK GRAY") 8) ((= str "LIGHT GRAY") 9) ((AND (< 0 (ATOI str)) (> 256 (ATOI str))) (ATOI str)) (T nil) ) ;_ end of cond ) ;_ end of PROGN ) ;_ end of IF ) ;_ end of defun ;;;******************************************************************** ;;; CITOCS -- Convert color index into standard color name. ;;; Will return the standard and logical color names as text ;;; strings. Returns nil for out-of-range color indicies. ;;; (DEFUN citocs (i) (COND ((= i 1) "red") ((= i 2) "yellow") ((= i 3) "green") ((= i 4) "cyan") ((= i 5) "blue") ((= i 6) "magenta") ((= i 7) "white") ((AND (< 0 i) (> 256 i)) (ITOA i)) (nil) ) ;_ end of cond ) ;_ end of defun ;;;******************************************************************** (DEFUN get_color_no (str /) (SETQ color_no (cstoci str)) (IF color_no (PROGN (START_IMAGE "color_image") (FILL_IMAGE 0 0 40 40 color_no) (END_IMAGE) (SETQ sel_color (cstoci (GET_TILE "color_edit"))) ) ;_ end of progn (IF cur_colr (PROGN (START_IMAGE "color_image") (FILL_IMAGE 0 0 40 40 cur_colr) (END_IMAGE) (SET_TILE "color_edit" (citocs cur_colr)) ) ;_ end of progn ) ;_ end of if ) ;_ end of if ) ;_ end of defun ;;;******************************************************************** (DEFUN set_tnotecolor_no (int /) (IF (AND int (EQ (TYPE int) 'int)) (PROGN (SET_TILE "color_edit" (citocs int)) (START_IMAGE "color_image") (FILL_IMAGE 0 0 40 40 int) (END_IMAGE) (COND ((< int 10) nil) ((< int 20) (SET_TILE "cno_10" (ITOA int)) (SETQ colr_lbl "A")) ((< int 30) (SET_TILE "cno_20" (ITOA int)) (SETQ colr_lbl "B")) ((< int 40) (SET_TILE "cno_30" (ITOA int)) (SETQ colr_lbl "C")) ((< int 50) (SET_TILE "cno_40" (ITOA int)) (SETQ colr_lbl "D")) ((< int 60) (SET_TILE "cno_50" (ITOA int)) (SETQ colr_lbl "F")) ((< int 70) (SET_TILE "cno_60" (ITOA int)) (SETQ colr_lbl "F")) ((< int 80) (SET_TILE "cno_70" (ITOA int)) (SETQ colr_lbl "G")) ((< int 90) (SET_TILE "cno_80" (ITOA int)) (SETQ colr_lbl "G")) ((< int 100) (SET_TILE "cno_90" (ITOA int)) (SETQ colr_lbl "H")) ((< int 110) (SET_TILE "cno_100" (ITOA int)) (SETQ colr_lbl "H")) ((< int 120) (SET_TILE "cno_110" (ITOA int)) (SETQ colr_lbl "I")) ((< int 130) (SET_TILE "cno_120" (ITOA int)) (SETQ colr_lbl "J")) ((< int 140) (SET_TILE "cno_130" (ITOA int)) (SETQ colr_lbl "K")) ((< int 150) (SET_TILE "cno_140" (ITOA int)) (SETQ colr_lbl "L")) ((< int 160) (SET_TILE "cno_150" (ITOA int)) (SETQ colr_lbl "M")) ((< int 170) (SET_TILE "cno_160" (ITOA int)) (SETQ colr_lbl "N")) ((< int 180) (SET_TILE "cno_170" (ITOA int)) (SETQ colr_lbl "O")) ((< int 190) (SET_TILE "cno_180" (ITOA int)) (SETQ colr_lbl "P")) ((< int 200) (SET_TILE "cno_190" (ITOA int)) (SETQ colr_lbl "Q")) ((< int 210) (SET_TILE "cno_200" (ITOA int)) (SETQ colr_lbl "R")) ((< int 220) (SET_TILE "cno_210" (ITOA int)) (SETQ colr_lbl "S")) ((< int 230) (SET_TILE "cno_220" (ITOA int)) (SETQ colr_lbl "S")) ((< int 240) (SET_TILE "cno_230" (ITOA int)) (SETQ colr_lbl "T")) ((< int 250) (SET_TILE "cno_240" (ITOA int)) (SETQ colr_lbl "T")) ((= int 250) (SETQ colr_lbl "U")) ((= int 251) (SETQ colr_lbl "V")) ((= int 252) (SETQ colr_lbl "W")) ((= int 253) (SETQ colr_lbl "X")) ((= int 254) (SETQ colr_lbl "Y")) ((= int 255) (SETQ colr_lbl "Z")) ) ;_ end of COND (SETQ sel_color (cstoci (GET_TILE "color_edit"))) (SET_TILE mycolor_text (ITOA sel_color)) ) ;_ end of PROGN ) ;_ end of IF ) ;_ end of DEFUN ;;;******************************************************************** (DEFUN set_just (this_option /) (COND ((WCMATCH this_option "just_mr") (SETQ do_right_just "Yes")) ((WCMATCH just_option "just_ml") (SETQ do_right_just "No")) ) ;_ end of COND (SETQ just_option this_option) (IF (AND just_option (WCMATCH just_option "just_mr")) (PROGN (SETQ do_right_just "Yes" just_option "just_mr" ) ;_ end of SETQ ;;; (ALERT "Yes") ) ;_ end of PROGN (PROGN (SETQ do_right_just "No" just_option "just_ml" ) ;_ end of SETQ ;;; (ALERT "No") ) ;_ end of PROGN ) ;_ end of IF ;;; (SET_TILE "error" this_option) ) ;_ end of defun ;;;******************************************************************** (DEFUN copyto_wsp () (newitem_mgr) (SET_TILE "non_item1" (SUBSTR tn_newitem 1 88)) (IF (> (STRLEN tn_newitem) 88) (SET_TILE "non_item2" (SUBSTR tn_newitem 89 88)) (SET_TILE "non_item2" "") ) ;_ end of if (IF (> (STRLEN tn_newitem) 176) (SET_TILE "non_item3" (SUBSTR tn_newitem 177)) (SET_TILE "non_item3" "") ) ;_ end of if ) ;_ end of defun ;;;******************************************************************** (DEFUN paste_wsedits () (newitem_mgr) (IF (> (STRLEN non_item) 264) (SET_TILE "error" "Your workspace note exceeds the maximum allowed 264 characters!") (PROGN (SETQ tn_newitem non_item) (tn_set_caps) (set_pview)) ) ;_ end of IF ) ;_ end of defun ;;;******************************************************************** (DEFUN newitem_mgr () (SETQ new_item (GET_TILE "new_item")) (SETQ new_item2 (GET_TILE "new_item2")) (SETQ tn_newitem (STRCAT new_item (IF (AND new_item2 (EQ (TYPE new_item2) 'str)) new_item2 "" ) ;_ end of IF ) ;_ end of strcat ) ;_ end of setq (SETQ tn_tokens (DOS_STRTOKENS tn_newitem " ")) (SETQ tn_srch_str tn_newitem from_newitem_mgr T ) ;_ end of SETQ (IF from_srch (SETQ from_srch nil) (srch_tnlist) ) ;_ end of IF (IF (AND srch_result (MEMBER tn_newitem tndat_lst)) (PROGN (SETQ this_note_dat (ASSOC tn_newitem tndat_lst)) (IF (EQ (LENGTH this_note_dat) 7) (SETQ tn_wrap_lines (NTH 6 this_note_dat)) (SETQ tn_wrap_lines "0") ) ;_ end of IF (SET_TILE "detail_desg" (NTH 1 this_note_dat)) (SET_TILE "sheet_locn" (NTH 2 this_note_dat)) (SET_TILE "Wrap_value" (IF new_tn_wrap_len new_tn_wrap_len (NTH 3 this_note_dat) ) ;_ end of IF ) ;_ end of SET_TILE (SET_TILE "Wrap_slide" (IF new_tn_wrap_slide new_tn_wrap_slide (NTH 3 this_note_dat) ) ;_ end of IF ) ;_ end of SET_TILE (SETQ new_tn_wrap_len nil new_tn_wrap_slide nil ) ;_ end of SETQ (tn_set_caps) (set_pview) (SET_TILE "leroy_size" (NTH 4 this_note_dat)) (IF (>= (LENGTH this_note_dat) 6) (SET_TILE "sheet_from" (NTH 5 this_note_dat)) (SET_TILE "sheet_from" "") ) ;_ end of IF (SET_TILE "Wrap_lines" (ITOA (1- (LENGTH pview_lst)))) ) ;_ end of PROGN (PROGN (SETQ tn_wrap_len# (IF new_tn_wrap_len (ATOI new_tn_wrap_len) (MIN 65 (STRLEN tn_newitem)) ) ;_ end of IF tn_wrap_slide# tn_wrap_len# wrap_int (IF (> (STRLEN tn_newitem) tn_wrap_len#) (FIX (/ (STRLEN tn_newitem) 2.0)) 0 ;this is an index # so 0 = 1 line ) ;_ end of IF tn_wrap_len (ITOA tn_wrap_len#) tn_wrap_slide (ITOA tn_wrap_slide#) tn_wrap_lines (ITOA wrap_int) new_tn_wrap_len nil new_tn_wrap_slide nil ) ;_ end of SETQ (SET_TILE "Wrap_value" tn_wrap_len) (SET_TILE "Wrap_slide" tn_wrap_slide) (tn_set_caps) (set_pview) (SET_TILE "Wrap_lines" (ITOA (1- (LENGTH pview_lst)))) ) ;_ end of PROGN ) ;_ end of IF (SETQ non_item (STRCAT (GET_TILE "non_item1") (GET_TILE "non_item2") (GET_TILE "non_item3"))) (IF (EQ (GET_TILE "non_item1") "Use these edit boxes when working with long notes (over 132 characters) Copy your 'Current Note' to here or" ) ;_ end of eq (SET_TILE "non_item1" "") ) ;_ end of if (IF (EQ (GET_TILE "non_item2") "just start editing here. When your edits are done paste them into the 'Current Note' edit boxes for placement or" ) ;_ end of eq (SET_TILE "non_item2" "") ) ;_ end of if (IF (EQ (GET_TILE "non_item3") "other actions. 'Current Note' maximum is 264 characters. An error message shows if this maximum is exceeded." ) ;_ end of eq (SET_TILE "non_item3" "") ) ;_ end of if (IF (AND (> (STRLEN non_item) 264) (NOT (WCMATCH non_item "Use these edit boxes when working with long notes*")) ) ;_ end of and (SET_TILE "error" "Your workspace note exceeds the maximum allowed 264 characters!") (SET_TILE "error" "") ) ;_ end of IF ) ;_ end of defun ;;;******************************************************************** (DEFUN do_abstr () (SETQ wrap_int (1+ (ATOI (GET_TILE "Wrap_lines")))) ;;; (fix_pview_lst) (SETQ tn_wrap_len (ITOA (+ (FIX (/ (STRLEN new_item) wrap_int)) (1+ wrap_int)))) (SET_TILE "Wrap_value" tn_wrap_len) (SET_TILE "Wrap_slide" tn_wrap_len) (SET_TILE "error" (STRCAT "wrap_int=" (ITOA wrap_int) "; tn_wrap_len=" tn_wrap_len)) ) ;_ end of defun ;;;******************************************************************** (DEFUN fix_pview_lst () (SETQ tn_wrap_len (ITOA (/ (STRLEN tn_newitem) wrap_int))) (set_pview) (WHILE (> (LENGTH pview_lst) wrap_int) (SETQ tn_wrap_len (ITOA (1+ (ATOI tn_wrap_len)))) (set_pview) ) ;_ end of WHILE (IF (< (LENGTH pview_lst) wrap_int) (PROGN ;evaluated sum of the number of 'words' in each item in pview_lst catches instance where the number of words is less than wrap_int (SETQ word_count (EVAL (CONS '+ (MAPCAR '(LAMBDA (x) (LENGTH (DOS_STRTOKENS x " "))) pview_lst)))) (WHILE (AND (>= word_count wrap_int) ;pview_lst contains less than wrap_int lines of text (< (LENGTH pview_lst) wrap_int) ) ;while so, reduce the wrap length by 1 (SETQ tn_wrap_len (ITOA (1- (ATOI tn_wrap_len))) tn_wrap_slide tn_wrap_len ) ;refresh the preview (set_pview) ) ;_ end of WHILE (IF (= (LENGTH pview_lst) wrap_int) (SETQ wrap_len (ITOA (EVAL (CONS 'MAX (MAPCAR 'STRLEN pview_lst)))) wrap_slide wrap_len ) ;_ end of SETQ (PROGN (WHILE (AND (> word_count wrap_int) (> (LENGTH pview_lst) wrap_int)) (SETQ tn_wrap_len (ITOA (1+ (ATOI tn_wrap_len))) tn_wrap_slide tn_wrap_len ) ;_ end of SETQ (set_pview) ) ;_ end of WHILE ;;; (SETQ pview_lst_a NIL ;;; pview_lst_b NIL ;;; pview_lst_c NIL ;;; ) ;;; (SETQ wordlen_lst (MAPCAR 'STRLEN pview_lst));list of string lengths of items in pview_lst ;;; (SETQ minwords_lst (MAPCAR '+ (REVERSE (CDR (REVERSE wordlen_lst))) (CDR wordlen_lst))) ;;; (SETQ minwords_ndx (-(LENGTH minwords_lst)(LENGTH (MEMBER (EVAL (CONS 'MIN minwords_lst)) minwords_lst)))) ;;; (SETQ ndx_cnt 0) ;;; (WHILE (< ndx_cnt minwords_ndx) ;;; (SETQ pview_lst_a (APPEND pview_lst_a (LIST (NTH ndx_cnt pview_lst)))) ;;; (SETQ ndx_cnt (1+ ndx_cnt)) ;;; ) ;;; (SETQ pview_lst_b (LIST (STRCAT (NTH minwords_ndx pview_lst) " " (NTH (1+ minwords_ndx) pview_lst)))) ;;; (SETQ ndx_cnt (+ ndx_cnt 2)) ;;; (WHILE (< ndx_cnt (LENGTH pview_lst)) ;;; (SETQ pview_lst_c (APPEND pview_lst_c (LIST (NTH ndx_cnt pview_lst)))) ;;; (SETQ ndx_cnt (1+ ndx_cnt)) ;;; ) ;;; (SETQ pview_lst (APPEND pview_lst_a pview_lst_b pview_lst_c)) ) ;_ end of PROGN ) ;_ end of IF ) ;_ end of PROGN ) ;_ end of IF ) ;_ end of DEFUN ;;;******************************************************************** (DEFUN set_colr_mode () (IF colr_over nil (SETQ colr_over "0") ) ;_ end of IF (MODE_TILE "txtc_value" (ABS (1- (ATOI colr_over)))) (MODE_TILE "ldrc_value" (ABS (1- (ATOI colr_over)))) (MODE_TILE "txtc_swatch" (ABS (1- (ATOI colr_over)))) (MODE_TILE "ldrc_swatch" (ABS (1- (ATOI colr_over)))) (IF (EQ colr_over "1") (PROGN (SETQ tnote_cusc T) (SETQ tnote_ldrc (GET_TILE "ldrc_value")) (SETQ tnote_txtc (GET_TILE "txtc_value")) ) ;_ end of progn (SETQ tnote_cusc nil) ) ;_ end of IF ) ;_ end of defun ;;;******************************************************************** (DEFUN setv_ldrc () (SETQ tnote_ldrc (GET_TILE "ldrc_value")) (SET_TILE "ldr_slide" tnote_ldrc)) ;;;******************************************************************** (DEFUN setv_txtc () (SETQ tnote_txtc (GET_TILE "txtc_value")) (SET_TILE "txt_slide" tnote_txtc)) ;;;******************************************************************** (DEFUN sets_ldrc () (SETQ tnote_ldrc (GET_TILE "ldr_slide")) (SET_TILE "ldrc_value" tnote_ldrc)) ;;;******************************************************************** (DEFUN sets_txtc () (SETQ tnote_txtc (GET_TILE "txt_slide")) (SET_TILE "txtc_value" tnote_txtc)) ;;;******************************************************************** (DEFUN set_decimal (tn_decval /) (IF (EQ (SUBSTR tn_decval 1 1) ".") (SETQ tn_decval (STRCAT "0" tn_decval)) ) ;_ end of IF (IF (OR (EQ (TYPE (READ tn_decval)) 'real) (EQ (TYPE (READ tn_decval)) 'int)) (PROGN (SETQ dec2ler (* (ATOF tn_decval) 1000.0) remcnt 1 tst_real dec2ler ) ;_ end of SETQ (WHILE (AND (/= (REM tst_real 1) 0.0) (< remcnt 5)) (SETQ tst_real (* 10.0 tst_real) remcnt (1+ remcnt) ) ;_ end of SETQ ) ;_ end of WHILE (SETQ tn_thts (RTOS dec2ler 2 (1- remcnt))) (SET_TILE "leroy_size" tn_thts) ) ;_ end of PROGN (SET_TILE "error" "Value entered for Decimal size is invalid!") ) ;_ end of IF ) ;_ end of DEFUN ;;;******************************************************************** (DEFUN set_leroy (tn_lerval /) (IF (EQ (SUBSTR tn_lerval 1 1) ".") (SETQ tn_lerval (STRCAT "0" tn_lerval)) ) ;_ end of IF (IF (OR (EQ (TYPE (READ tn_lerval)) 'real) (EQ (TYPE (READ tn_lerval)) 'int)) (PROGN (SETQ tst_real (ATOF tn_lerval) remcnt 4 ) ;_ end of SETQ (WHILE (AND (EQ (REM tst_real 1) 0.0) (> remcnt 0)) (SETQ tst_real (/ tst_real 10.0) remcnt (1- remcnt) ) ;_ end of SETQ ) ;_ end of WHILE (SETQ ler2dec (/ (ATOF tn_lerval) 1000.0) tn_thts tn_lerval siz_prec (+ remcnt 2) ) ;_ end of SETQ (SETQ dechts (RTOS ler2dec 2 remcnt)) (SET_TILE "decimal_size" dechts) ) ;_ end of PROGN (SET_TILE "error" "Value entered for Leroy size is invalid!") ) ;_ end of IF ) ;_ end of DEFUN ;;;******************************************************************** (DEFUN set_bubl () (SETQ tn_wrap_len (GET_TILE "Wrap_value")) (SETQ tn_add_bubble (GET_TILE "add_bubble")) (SETQ tn_detail_desg (GET_TILE "detail_desg")) ;_ end of SETQ (SETQ tn_sheet_from (GET_TILE "sheet_from")) ;_ end of SETQ (SETQ tn_sheet_locn (GET_TILE "sheet_locn")) ;_ end of SETQ (SETQ tn_wrap_lines (GET_TILE "Wrap_lines")) ;_ end of SETQ (IF (MEMBER (ASSOC tn_newitem tndat_lst) tndat_lst) (SETQ tndat_lst (SUBST (CONS tn_newitem (LIST tn_detail_desg tn_sheet_locn tn_wrap_len tn_thts tn_sheet_from tn_wrap_lines) ) ;_ end of CONS (ASSOC tn_newitem tndat_lst) tndat_lst ) ;_ end of SUBST ) ;_ end of SETQ ) ;_ end of IF (MODE_TILE "detail_desg" (ABS (1- (ATOI tn_add_bubble)))) (MODE_TILE "sheet_from" (ABS (1- (ATOI tn_add_bubble)))) (MODE_TILE "sheet_locn" (ABS (1- (ATOI tn_add_bubble)))) ) ;_ end of defun ;;;******************************************************************** (DEFUN f_tnote (/) (set_tnote_list) (chk_tnlst) (START_LIST "Major" 3) (MAPCAR 'ADD_LIST tnote_list) (END_LIST) (PRINC) ) ;_ end of defun ;;;******************************************************************** (DEFUN srch_tnlist (/) (SETQ srch_result nil) (SET_TILE "error" "") (FOREACH n tnote_list (IF (WCMATCH (STRCASE n) (STRCASE tn_srch_str)) (SETQ srch_result (APPEND srch_result (LIST n))) ) ;_ end of if ) ;_ end of foreach (IF (AND srch_result (NOT from_newitem_mgr)) (PROGN (SETQ sel_key nil) (NEW_DIALOG "srchres" tn_num) ;;; (mode_tile "dtl_desg" 1) ;;; (mode_tile "sht_locn" 1) (ACTION_TILE "Results" "(setq sel_key(get_tile\"Results\"))(setq sel_str (nth (read sel_key) srch_result))(set_srchbubl)(if(eq $reason 4)(done_dialog 1))" ) ;_ end of action_tile (ACTION_TILE "Filter" "(setq fltr_str (strcat \"*\"(get_tile \"filter_item\")\"*\"))(fltr_tnlist)") (ACTION_TILE "ok" "(done_dialog 1)") (ACTION_TILE "cancel" "(done_dialog 0)") (START_LIST "Results" 3) (MAPCAR 'ADD_LIST srch_result) (END_LIST) (IF (EQ (START_DIALOG) 1) (IF sel_key (PROGN (SETQ sel_key (ITOA (1- (LENGTH (MEMBER (NTH (READ sel_key) srch_result) (REVERSE tnote_list)))))) (SET_TILE "Major" sel_key) (MODE_TILE "Major" 2) (set_tnote_ebox) (SETQ tn_newitem (STRCAT (GET_TILE "new_item") (GET_TILE "new_item2"))) (newitem_mgr) (set_wrap) (set_pview) (SET_TILE "Wrap_lines" (ITOA (1- (LENGTH pview_lst)))) ) ;_ end of progn (SET_TILE "error" "Nothing selected from search results") ) ;_ end of if (SET_TILE "error" "Search cancelled") ) ;_ end of if ) ;_ end of PROGN (IF from_newitem_mgr (SETQ from_newitem_mgr nil) (SET_TILE "error" "Search string did not match any note") ) ;_ end of IF ) ;_ end of IF (PRINC) ) ;_ end of DEFUN ;;;******************************************************************** (DEFUN fltr_tnlist (/) (SETQ fltr_result nil) (SET_TILE "error" "") (FOREACH n srch_result (IF (WCMATCH (STRCASE n) (STRCASE fltr_str)) (SETQ fltr_result (APPEND fltr_result (LIST n))) ) ;_ end of if ) ;_ end of foreach (IF fltr_result (PROGN (SETQ srch_result fltr_result) (START_LIST "Results" 3) (MAPCAR 'ADD_LIST fltr_result) (END_LIST) ) ;_ end of progn (SET_TILE "error" "No matches found for filter text!") ) ;_ end of if ) ;_ end of DEFUN ;;;******************************************************************** (DEFUN set_srchbubl (/) (SET_TILE "filter_item" sel_str) (FOREACH n tndat_lst (IF (EQ (NTH 0 n) sel_str) (PROGN (SET_TILE "dtl_desg" (NTH 1 n)) (SET_TILE "sht_locn" (NTH 2 n))) ;_ end of progn ) ;_ end of if ) ;_ end of foreach ) ;_ end of DEFUN ;;;******************************************************************** (DEFUN tn_set_caps (/) (IF (EQ tn_fcaps "1") (IF tn_newitem (SETQ tn_newitem (STRCASE tn_newitem)) ) ;_ end of IF ) ;_ end of IF ) ;_ end of defun ;;;******************************************************************** (DEFUN pview (/) (IF (AND tn_newitem (EQ (GET_TILE "force_caps") "1")) (PROGN (SETQ tn_newitem (STRCASE tn_newitem)) (FOREACH n pview_lst (SETQ pview_lst (SUBST (STRCASE n) n pview_lst))) (IF (> (STRLEN tn_newitem) 132) (PROGN (SET_TILE "new_item" (SUBSTR tn_newitem 1 132)) (SET_TILE "new_item2" (SUBSTR tn_newitem 133)) ) ;_ end of PROGN (PROGN (SET_TILE "new_item" tn_newitem) (SET_TILE "new_item2" "")) ) ;_ end of IF ) ;_ end of progn ) ;_ end of IF (IF pview_lst (SET_TILE "Wrap_lines" (ITOA (- (LENGTH pview_lst)))) ) ;_ end of IF (START_LIST "note_view") (MAPCAR 'ADD_LIST (IF tn_newitem pview_lst (LIST "") ) ;_ end of IF ) ;_ end of MAPCAR (END_LIST) (PRINC) ) ;_ end of defun ;;;******************************************************************** (DEFUN get_tnotedat_file () (IF (NOT (OR (FINDFILE (STRCAT (GETVAR "dwgprefix") "tnote.tnd")) (FINDFILE (STRCAT (GETVAR "dwgprefix") "tnote.dat")) ) ;_ end of or ) ;_ end of not (PROGN (SETQ tmp_datf (OPEN (STRCAT (GETVAR "dwgprefix") "tnote.tnd") "w")) (CLOSE tmp_datf) (ALERT (STRCAT "The default TNOTE data file for the current drawing folder:" "\n\"" (GETVAR "dwgprefix") "tnote.tnd\"" "\ndid not exist and has been created as a new empty data file." "\n\nThis file in your current folder is selected by default;" "\nhowever, you may select any other existing TNOTE data (.tnd) file." (IF (FINDFILE "L:/Util/tnote.dat") (STRCAT "\n\nYou may have been using \"L:/Util/tnote.dat\" before now." "\nIf so open it, select [Backup] and create a backup in the project folder," "\n(You will be prompted to overwrite the empty data file created just now)," "\nopen the backup file and select [Save]. [Save] will convert the current" "\nbackup into a local copy of tnote.tnd and set it current." ) ;_ end of STRCAT "" ) ;_ end of IF ) ;_ end of STRCAT ) ;_ end of ALERT ) ;_ end of progn (COND ((AND tn_file (NOT do_browse) (NOT change_datlocn)) nil) (do_browse (SETQ tn_file nil)) (change_datlocn (COND ((AND (EQ tn_datlocn "tn_updir") (SETQ tn_file (FINDFILE (STRCAT (EVAL (CONS 'STRCAT (MAPCAR '(LAMBDA (x) (STRCAT x "\\")) (REVERSE (CDR (REVERSE (DOS_STRTOKENS (GETVAR "dwgprefix") "\\")))) ) ;_ end of MAPCAR ) ;_ end of CONS ) ;_ end of EVAL "tnote.tnd" ) ;_ end of STRCAT ) ;_ end of FINDFILE ) ;_ end of SETQ ) ;_ end of AND (SETQ change_datlocn nil) ) ((AND (EQ tn_datlocn "tn_here") (SETQ tn_file (FINDFILE (STRCAT (GETVAR "DWGPREFIX") "tnote.tnd")))) (SETQ change_datlocn nil) ) (T (SETQ tn_file nil change_datlocn nil ) ;_ end of SETQ ) ) ;_ end of COND ) ((FINDFILE (STRCAT (GETVAR "dwgprefix") "tnote.tnd")) (SETQ tn_file (STRCAT (GETVAR "dwgprefix") "tnote.tnd")) ) ((FINDFILE (STRCAT (GETVAR "dwgprefix") "tnote.dat")) (SETQ tn_file (STRCAT (GETVAR "dwgprefix") "tnote.dat")) ) ) ;_ end of COND ) ;_ end of if (IF (OR do_browse (NOT tn_file)) (SETQ do_browse nil tn_file (DOS_GETFILED "Open Typical Notes Data File" (GETVAR "dwgprefix") "TNOTE Data|tnote.tnd|TNOTE Data Backup|*.tnb|Old TNOTE Data|tnote.dat||" ) ;_ end of dos_getfiled ) ;_ end of setq ) ;_ end of IF (IF tn_file (PROGN (SET_TILE "tnote_path" tn_file) (IF (SETQ oldtn_file (FINDFILE tn_file)) (PROGN (IF (WCMATCH (STRCASE tn_file) "*.DAT") (PROGN (SETQ newtn_file (STRCAT (SUBSTR oldtn_file 1 (- (STRLEN oldtn_file) 3)) "tnd")) (IF (FINDFILE newtn_file) (PROGN (SETQ write_tnotedat (DOS_MSGBOX (STRCAT newtn_file " \nalready exists, Do you want to overwrite it with\n" oldtn_file " \nafter renaming it with TNOTE's .tnd extension?" ) ;_ end of STRCAT "Rename .dat file with .tnd extension" 5 1 ) ;_ end of dos_msgbox ) ;Returns: 6=Yes; 3=No; 1=Cancel (IF (EQ write_tnotedat 6) (PROGN (DOS_DELETE oldtn_file) (SETQ tn_file newtn_file)) ) ;_ end of IF ) ;_ end of PROGN (SETQ write_tnotedat 6 tn_file newtn_file ) ;_ end of SETQ ) ;_ end of IF (IF (EQ write_tnotedat 6) (PROGN (DOS_RENAME oldtn_file newtn_file) (SETQ tn_file newtn_file)) ) ;_ end of IF ) ;_ end of PROGN ) ;_ end of IF (SETQ tnote_list nil tndat_lst nil ) ;_ end of setq (COND ((SETQ temp_tn_file (FINDFILE tn_file))) ((SETQ temp_tn_file (FINDFILE (STRCAT (SUBSTR tn_file 1 (- (STRLEN tn_file) 4)) ".dat")))) ) ;_ end of COND (IF temp_tn_file (SETQ tn_file temp_tn_file) ) ;_ end of IF (SETQ tn_dat (OPEN (FINDFILE tn_file) "r")) (WHILE (SETQ str (READ-LINE tn_dat)) (IF (AND (EQ (SUBSTR str 1 1) (CHR 40)) ; Line begins with a parenthesis, and (EQ (SUBSTR str (STRLEN str) 1) (CHR 41)) ; Line ends with a parenthesis ) ;_ end of and (SETQ tndat_lst (APPEND tndat_lst (LIST (READ str)))) ; Then strip off string quotes and add/create tndat_lst (SETQ tndat_lst (APPEND tndat_lst (LIST (LIST str "" "" (ITOA (MIN 65 (STRLEN str))) (IF do_cmud "100" "110" ) ;_ end of IF (ITOA (FIX (/ (STRLEN str) (MIN 65 (STRLEN str))))) ) ;_ end of LIST ) ;_ end of LIST ) ;_ end of APPEND ) ;_ end of SETQ ; Else add/create tndat_lst using the string ) ;_ end of if ) ;_ end of while (CLOSE tn_dat) (FOREACH n tndat_lst ; tndat_lst=Data list including specified detail bubble text (IF tnote_list (SETQ tnote_list (APPEND tnote_list (LIST (CAR n)))) ; Extract note string from list (SETQ tnote_list (LIST (CAR n))) ) ;_ end of if ) ;_ end of foreach (IF tnote_list (IF (SETQ tn_lst (ACAD_STRLSORT tnote_list)) ; Finally, sort the note list (SETQ tnote_list tn_lst) (PRINC "\nNot enough memory to sort tnote group list. ") ) ;_ end of if (SET_TILE "error" "*** NOTICE *** DAT file contains no notes! Add notes or open another file.") ) ;_ end of IF (chk_tnlst) ;Why Do this? (START_LIST "Major" 3) (MAPCAR 'ADD_LIST tnote_list) (END_LIST) ) ;_ end of PROGN (SET_TILE "error" "TNOTE Data File not specified!") ) ;_ end of IF (COND ((WCMATCH (STRCASE tn_file) (STRCASE (STRCAT ;Construct the 'up-one-folder' path (EVAL (CONS 'STRCAT (MAPCAR '(LAMBDA (x) (STRCAT x "\\")) (REVERSE (CDR (REVERSE (DOS_STRTOKENS (GETVAR "dwgprefix") "\\")))) ) ;_ end of MAPCAR ) ;_ end of CONS ) ;_ end of EVAL "tnote.*" ) ;_ end of STRCAT ) ;_ end of STRCASE ) ;_ end of WCMATCH (SET_TILE "tn_datlocn" "tn_updir") ) ((WCMATCH (STRCASE tn_file) (STRCAT (STRCASE (GETVAR "DWGPREFIX")) "TNOTE.*")) (SET_TILE "tn_datlocn" "tn_here") ) (T (SET_TILE "tn_datlocn" "tn_other")) ) ;_ end of COND ) ;_ end of progn (SET_TILE "tnote_path" "NO DATA FILE WAS SELECTED!") ) ;_ end of IF (IF tnote_list (SET_TILE "error" "") ) ;_ end of IF (PRINC) ) ;_ end of defun ;;;******************************************************************** (DEFUN renametnbfile () (IF (WCMATCH (STRCASE tn_file) "*.TNB") (PROGN (SETQ newtn_file (STRCAT (SUBSTR oldtn_file 1 (- (STRLEN oldtn_file) 3)) "tnd")) (IF (FINDFILE newtn_file) (PROGN (SETQ write_tnotedat (DOS_MSGBOX (STRCAT newtn_file " \nData file already exists, Do you want to replace it with Backup file\n" oldtn_file " \nafter renaming it with TNOTE's Data file (.tnd) extension?" ) ;_ end of STRCAT "Save Backup (.tnb) file as Data (.tnd) File" 5 1 ) ;_ end of dos_msgbox ) ;Returns: 6=Yes; 3=No; 1=Cancel (IF (EQ write_tnotedat 6) (PROGN (DOS_DELETE oldtn_file) (SETQ tn_file newtn_file)) ) ;_ end of IF ) ;_ end of PROGN (SETQ write_tnotedat 6 tn_file newtn_file ) ;_ end of SETQ ) ;_ end of IF (IF (EQ write_tnotedat 6) (PROGN (DOS_RENAME oldtn_file newtn_file) (SETQ tn_file newtn_file)) ) ;_ end of IF ) ;_ end of PROGN ) ;_ end of IF ) ;_ end of DEFUN ;;;******************************************************************** (DEFUN set_tnote_list (/) (IF tndat_lst nil (PROGN (IF tn_file (PROGN (SET_TILE "tnote_path" tn_file) (get_tnotedat_file)) (PROGN (SETQ tnote_list nil tndat_lst nil tndat_ndx nil ) ;_ end of setq (COND ((EQ tn_datlocn "tn_updir") (SETQ tn_file (FINDFILE (STRCAT (EVAL (CONS 'STRCAT (MAPCAR '(LAMBDA (x) (STRCAT x "\\")) (REVERSE (CDR (REVERSE (DOS_STRTOKENS (GETVAR "dwgprefix") "\\")))) ) ;_ end of MAPCAR ) ;_ end of CONS ) ;_ end of EVAL "tnote.tnd" ) ;_ end of STRCAT ) ;_ end of FINDFILE ) ;_ end of SETQ (get_tnotedat_file) ) ((EQ tn_datlocn "tn_here") (SETQ tn_file (FINDFILE (STRCAT (GETVAR "DWGPREFIX") "tnote.tnd"))) (get_tnotedat_file) ) ((EQ tn_datlocn "tn_other") (SETQ tn_file nil) (get_tnotedat_file)) ) ;_ end of COND ) ;_ end of PROGN ) ;_ end of IF (SET_TILE "tnote_path" tn_file) (SETQ tn_dat (OPEN tn_file "r")) (WHILE (SETQ str (READ-LINE tn_dat)) (IF (AND (EQ (SUBSTR str 1 1) (CHR 40)) ; Line begins with a parenthesis, and (EQ (SUBSTR str (STRLEN str) 1) (CHR 41)) ; Line ends with a parenthesis ) ;_ end of and (SETQ tndat_lst (APPEND tndat_lst (LIST (READ str)))) ; Then strip off string quotes and add/create tndat_lst (SETQ tndat_lst (APPEND tndat_lst (LIST (LIST str "" "" (ITOA (MIN 65 (STRLEN str))) (IF do_cmud "100" "110" ) ;_ end of IF (ITOA (FIX (/ (STRLEN str) (MIN 65 (STRLEN str))))) ) ;_ end of LIST ) ;_ end of LIST ) ;_ end of APPEND ) ;_ end of SETQ ; Else add/create tndat_lst using the string ) ;_ end of if ) ;_ end of while (CLOSE tn_dat) (tnote_sorter) ) ;_ end of PROGN ) ;_ end of IF (PRINC) ) ;_ end of defun ;;;******************************************************************** (DEFUN tnote_sorter () (SETQ ndx_cnt 0 tndat_ndx nil tnote_list nil ) ;_ end of SETQ (FOREACH n tndat_lst ; tndat_lst=Data list including specified detail bubble text (IF tndat_ndx (SETQ tndat_ndx (APPEND tndat_ndx (LIST (CONS (CAR n) ndx_cnt)))) (SETQ tndat_ndx (LIST (CONS (CAR n) ndx_cnt))) ) ;_ end of IF (SETQ ndx_cnt (1+ ndx_cnt)) (IF (AND tnote_list (NOT (MEMBER (CAR n) tnote_list))) (SETQ tnote_list (APPEND tnote_list (LIST (CAR n)))) ; Extract note string from list (IF tnote_list nil (SETQ tnote_list (LIST (CAR n))) ) ;_ end of IF ) ;_ end of if ) ;_ end of foreach (IF tnote_list (IF (SETQ tn_lst (ACAD_STRLSORT tnote_list)) ; Finally, sort the note list (PROGN (SETQ tnote_list tn_lst) (SETQ tndat_tas nil) (FOREACH n tnote_list (IF tndat_tas (SETQ tndat_tas (APPEND tndat_tas (LIST (NTH (CDR (ASSOC n tndat_ndx)) tndat_lst)))) (SETQ tndat_tas (LIST (NTH (CDR (ASSOC n tndat_ndx)) tndat_lst))) ) ;_ end of IF ) ;_ end of foreach (SETQ tndat_lst tndat_tas) ) ;_ end of PROGN (PRINC "\nNot enough memory to sort tnote group list. ") ) ;_ end of if (SET_TILE "error" "*** NOTICE *** DAT file contains no notes! Add notes or open another file.") ;_ end of set_tile ) ;_ end of IF ) ;_ end of DEFUN ;;;******************************************************************** (DEFUN set_wrap () (IF (AND (ASSOC (NTH (ATOI sel_key) tnote_list) tndat_lst) (/= (NTH 3 (ASSOC (NTH (ATOI sel_key) tnote_list) tndat_lst)) "") ;_ end of /= (EQ (TYPE (READ (NTH 3 (ASSOC (NTH (ATOI sel_key) tnote_list) tndat_lst))) ;_ end of READ ) ;_ end of TYPE 'int ) ;_ end of EQ ) ;_ end of AND (PROGN (SETQ tn_wrap_len (NTH 3 (ASSOC (NTH (ATOI sel_key) tnote_list) tndat_lst)) ;_ end of NTH ) ;_ end of SETQ (SET_TILE "Wrap_value" tn_wrap_len) ) ;_ end of PROGN ) ;_ end of IF ) ;_ end of DEFUN ;;;******************************************************************** (DEFUN set_tnote_ebox (/) (SETQ sel_key (GET_TILE "Major")) (SETQ note_txt (NTH (ATOI sel_key) tnote_list)) (IF (> (STRLEN note_txt) 132) (PROGN (SET_TILE "new_item" (SUBSTR note_txt 1 132)) (SET_TILE "new_item2" (SUBSTR note_txt 133))) (PROGN (SET_TILE "new_item" note_txt) (SET_TILE "new_item2" "")) ) ;_ end of IF (res_tn_thts note_txt) (IF (MEMBER note_txt tndat_lst) ;only true if note is a string and not a list in tndat_lst (PROGN (SET_TILE "add_bubble" "0") (SET_TILE "detail_desg" "") (SET_TILE "sheet_from" "") (SET_TILE "sheet_locn" "") (MODE_TILE "detail_desg" 1) (MODE_TILE "sheet_from" 1) (MODE_TILE "sheet_locn" 1) ) ;_ end of progn (PROGN (SETQ note_ctr 0 not_yet T ) ;_ end of setq (SETQ note_str (NTH (ATOI sel_key) tnote_list)) (WHILE (AND (< note_ctr (LENGTH tndat_lst)) not_yet) (COND ((EQ (TYPE (NTH note_ctr tndat_lst)) 'LIST) (IF (EQ (CAR (NTH note_ctr tndat_lst)) note_str) (SETQ not_yet nil) ) ;_ end of if ) ) ;_ end of cond (SETQ note_ctr (1+ note_ctr)) ) ;_ end of while (IF (EQ (TYPE (NTH (1- note_ctr) tndat_lst)) 'LIST) (PROGN (SET_TILE "detail_desg" (NTH 1 (NTH (1- note_ctr) tndat_lst))) ;_ end of set_tile (IF (>= (LENGTH (NTH (1- note_ctr) tndat_lst)) 6) (SET_TILE "sheet_from" (NTH 5 (NTH (1- note_ctr) tndat_lst))) ;_ end of set_tile (SET_TILE "sheet_from" "") ) ;_ end of IF (SET_TILE "sheet_locn" (NTH 2 (NTH (1- note_ctr) tndat_lst))) ;_ end of set_tile (IF (AND (/= (NTH 3 (NTH (1- note_ctr) tndat_lst)) "") (EQ (TYPE (READ (NTH 3 (NTH (1- note_ctr) tndat_lst)))) 'int) ;_ end of EQ ) ;_ end of AND (SET_TILE "Wrap_value" (NTH 3 (NTH (1- note_ctr) tndat_lst))) ;_ end of set_tile ) ;_ end of IF (IF (>= (LENGTH (NTH (1- note_ctr) tndat_lst)) 5) (PROGN (SET_TILE "leroy_size" (NTH 4 (NTH (1- note_ctr) tndat_lst))) (set_leroy (NTH 4 (NTH (1- note_ctr) tndat_lst))) ) ;_ end of PROGN ) ;_ end of IF (IF (AND (EQ (GET_TILE "detail_desg") "") (EQ (GET_TILE "sheet_from") "") (EQ (GET_TILE "sheet_locn") "") ) ;_ end of and (PROGN (SET_TILE "add_bubble" "0") (MODE_TILE "detail_desg" 1) (MODE_TILE "sheet_from" 1) (MODE_TILE "sheet_locn" 1) ) ;_ end of progn (PROGN (SET_TILE "add_bubble" "1") (MODE_TILE "detail_desg" 0) (MODE_TILE "sheet_from" 0) (MODE_TILE "sheet_locn" 0) ) ;_ end of progn ) ;_ end of if ) ;_ end of progn ) ;_ end of if ) ;_ end of progn ) ;_ end of if (PRINC) ) ;_ end of defun ;;;******************************************************************** (DEFUN repl_item (/) (IF (EQ (TYPE (READ tn_repl_key)) 'int) (PROGN (SETQ exst_str (NTH (ATOI tn_repl_key) tnote_list) repl_str (STRCAT (GET_TILE "new_item") (GET_TILE "new_item2")) rslen (STRLEN repl_str) chrcnt 1 ) ;_ end of setq (SETQ new_tnote_list (SUBST repl_str exst_str tnote_list) tnote_list new_tnote_list ) ;_ end of setq ;;; (COND ;;; ((MEMBER exst_str tndat_lst) ; No bubble associated yet ;;; (COND ((EQ (GET_TILE "add_bubble") "0") ;;; ; No bubble associated this instance - No change ;;; (SETQ tndat_lst ;;; (SUBST repl_str ;;; exst_str ;;; tndat_lst ;;; ) ;_ end of subst ;;; ) ;_ end of setq ;;; ) ;;; ((EQ (GET_TILE "add_bubble") "1") ;;; ; Bubble associated this instance - add bubble data (SETQ tndat_lst (SUBST (CONS repl_str (LIST (GET_TILE "detail_desg") (GET_TILE "sheet_locn") (GET_TILE "Wrap_value") (GET_TILE "leroy_size") (GET_TILE "sheet_from") (GET_TILE "Wrap_lines") ) ;_ end of LIST ) ;_ end of cons exst_str tndat_lst ) ;_ end of subst ) ;_ end of setq ;;; ) ;;; ) ;_ end of cond ;;; ) ;;; ((ASSOC exst_str tndat_lst) ;;; (COND ((EQ (GET_TILE "add_bubble") "0") ;;; (SETQ tndat_lst ;;; (SUBST (CONS repl_str (CDR (ASSOC exst_str tndat_lst))) ;;; (ASSOC exst_str tndat_lst) ;;; tndat_lst ;;; ) ;_ end of subst ;;; ) ;_ end of setq ;;; ) ;;; ((EQ (GET_TILE "add_bubble") "1") ;;; (SETQ tndat_lst ;;; (SUBST ;;; (CONS ;;; repl_str ;;; (LIST (GET_TILE "detail_desg") ;;; (GET_TILE "sheet_locn") ;;; (GET_TILE "Wrap_value") ;;; (GET_TILE "leroy_size") ;;; ) ;_ end of LIST ;;; ) ;_ end of cons ;;; (ASSOC exst_str tndat_lst) ;;; tndat_lst ;;; ) ;_ end of subst ;;; ) ;_ end of setq ;;; ) ;;; ) ;_ end of cond ;;; ) ;;; ) ;_ end of cond (SET_TILE "new_item" "") (SET_TILE "new_item2" "") (MODE_TILE "new_item" 2) (START_LIST "Major" 1 (ATOI tn_repl_key)) (ADD_LIST repl_str) (END_LIST) (SET_TILE "Major" tn_repl_key) (IF (> (STRLEN (NTH (ATOI tn_repl_key) tnote_list)) 132) (PROGN (SET_TILE "new_item" (SUBSTR (NTH (ATOI tn_repl_key) tnote_list) 1 132)) (SET_TILE "new_item2" (SUBSTR (NTH (ATOI tn_repl_key) tnote_list) 133)) ) ;_ end of PROGN (PROGN (SET_TILE "new_item" (NTH (ATOI tn_repl_key) tnote_list)) (SET_TILE "new_item2" "")) ) ;_ end of IF (MODE_TILE "new_item" 3) (upd_tnote_dat) ) ;_ end of progn ) ;_ end of if (PRINC) ) ;_ end of defun ;;;******************************************************************** (DEFUN upd_tnote_dat (/) (IF tnote_list (PROGN (IF tn_file (renametnbfile) (PROGN (ALERT "B") (get_tnotedat_file)) ) ;_ end of IF (IF tn_file (PROGN (SET_TILE "tnote_path" tn_file) (SETQ tn_dat (OPEN tn_file "w")) (IF tn_dat (PROGN (FOREACH n tndat_lst (IF n (PROGN (PRIN1 n tn_dat) (IF (EQUAL n (LAST tndat_lst)) nil (PRINC "\n" tn_dat) ) ;_ end of IF ) ;_ end of PROGN ) ;_ end of IF ) ;_ end of foreach (IF (AND tn_dat tndat_lst) (SET_TILE "error" (STRCAT "Saved changes to " tn_file)) ) ;_ end of IF ) ;_ end of PROGN (PROGN (SET_TILE "error" "Unable to open .tnd file!")) ;_ end of PROGN ) ;_ end of IF (IF tn_dat (CLOSE tn_dat) ) ;_ end of IF ) ;_ end of PROGN ) ;_ end of IF ) ;_ end of progn (PROGN (SET_TILE "error" "Nothing to Save!")) ;_ end of PROGN ) ;_ end of if (PRINC) ) ;_ end of defun ;;;******************************************************************** (DEFUN new_tnote_dat (/) (PROGN (SETQ tn_file (DOS_GETFILENAV "Save As New Tnote Data File" (STRCAT (GETVAR "dwgprefix") "tnote.tnd") "tnd" 1)) (SET_TILE "tnote_path" tn_file) (SETQ tn_dat (OPEN tn_file "w")) (IF tn_dat (PROGN (FOREACH n tndat_lst (COND ((EQ (TYPE n) 'LIST) (SETQ tx_str (NTH 0 n) rslen (STRLEN tx_str) chrcnt 1 ) ;_ end of setq (IF (WCMATCH tx_str "*\"*") (WHILE (<= chrcnt rslen) (IF (EQ (SUBSTR tx_str chrcnt 1) "\"") (PROGN (SETQ tx_str (STRCAT (SUBSTR tx_str 1 (1- chrcnt)) (CHR 92) (CHR 34) (SUBSTR tx_str (1+ chrcnt))) ;_ end of strcat rslen (STRLEN tx_str) chrcnt (STRLEN (STRCAT (SUBSTR tx_str 1 (1- chrcnt)) (CHR 92) (CHR 34)) ;_ end of strcat ) ;_ end of strlen ) ;_ end of setq ) ;_ end of progn ) ;_ end of if (SETQ chrcnt (1+ chrcnt)) ) ;_ end of while ) ;_ end of if (SETQ tn_item (STRCAT (CHR 40) "\"" tx_str "\" \"" (NTH 1 n) "\" \"" (NTH 2 n) "\" \"" (NTH 3 n) (IF (>= (LENGTH n) 5) ;5 includes wrap length and text size values ;6 also includes wrap lines value (COND ((EQ (LENGTH n) 5) (STRCAT "\" \"" (NTH 4 n) "\"" (CHR 41))) ((EQ (LENGTH n) 6) (STRCAT "\" \"" (NTH 4 n) "\" \"" (NTH 5 n) "\"" (CHR 41))) ) ;_ end of COND (STRCAT "\" \"" (IF do_cmud "100" "125" ) ;_ end of IF "\"" (CHR 41) ) ;_ end of STRCAT ) ;_ end of IF ) ;_ end of strcat ) ;_ end of setq (WRITE-LINE tn_item tn_dat) ) ((EQ (TYPE n) 'str) (WRITE-LINE n tn_dat)) ) ;_ end of cond ) ;_ end of foreach (IF (AND tn_dat tndat_lst) (SET_TILE "error" (STRCAT "Saved As " tn_file)) ) ;_ end of IF ) ;_ end of PROGN (PROGN (SET_TILE "error" "Unable to open .dat file!")) ;_ end of PROGN ) ;_ end of IF (SETQ new_tnote_list nil) (CLOSE tn_dat) ) ;_ end of PROGN (PRINC) ) ;_ end of defun ;;;******************************************************************** (DEFUN mandatbak (/) (IF tndat_lst (PROGN (SETQ tnbak_file (DOS_GETFILENAV "Create Typical Note Data Backup File" (IF tn_file (SUBSTR tn_file 1 (- (STRLEN tn_file) 4)) (STRCAT (GETVAR "dwgprefix") "tnote.tnb") ) ;_ end of IF "tnb" 1 ) ;_ end of GETFILED ) ;_ end of SETQ (IF tnbak_file (PROGN (SET_TILE "tnote_path" tnbak_file) (SETQ tnbak_dat (OPEN tnbak_file "w")) (IF tnbak_dat (PROGN (FOREACH n tndat_lst (IF n (PROGN (PRIN1 n tnbak_dat) (IF (EQUAL n (LAST tndat_lst)) nil (PRINC "\n" tnbak_dat) ) ;_ end of IF ) ;_ end of PROGN ) ;_ end of IF ) ;_ end of foreach (IF (AND tnbak_dat tndat_lst) (SET_TILE "error" (STRCAT "Backup written to " tnbak_file)) ) ;_ end of IF ) ;_ end of PROGN (PROGN (SET_TILE "error" "Unable to open backup file!")) ;_ end of PROGN ) ;_ end of IF (CLOSE tnbak_dat) ) ;_ end of PROGN ) ;_ end of IF (SETQ tn_file tnbak_file) ) ;_ end of progn (PROGN (SET_TILE "error" "Nothing to backup!")) ;_ end of PROGN ) ;_ end of if (PRINC) ) ;_ end of defun ;;;******************************************************************** (DEFUN add_tn_item (/) (IF (OR (EQ tn_newitem "") (AND tn_newitem (MEMBER tn_newitem tnote-list))) nil (PROGN (SETQ new_tnote_list tnote_list) (SETQ tnote_list (APPEND tnote_list (LIST tn_newitem))) (chk_tnlst) (START_LIST "Major" 3) (MAPCAR 'ADD_LIST tnote_list) (END_LIST) (IF tndat_lst (COND ((EQ (GET_TILE "add_bubble") "0") (SETQ tndat_lst (APPEND tndat_lst (LIST (LIST tn_newitem "" "" (GET_TILE "Wrap_value") (GET_TILE "leroy_size"))) ;_ end of LIST ) ;_ end of APPEND ) ;_ end of setq ) ((EQ (GET_TILE "add_bubble") "1") (SETQ tndat_lst (APPEND tndat_lst (LIST (LIST tn_newitem (GET_TILE "detail_desg") (GET_TILE "sheet_locn") (GET_TILE "Wrap_value") (GET_TILE "leroy_size") (GET_TILE "sheet_from") (GET_TILE "Wrap_lines") ) ;_ end of list ) ;_ end of list ) ;_ end of append ) ;_ end of setq ) ) ;_ end of cond (COND ((EQ (GET_TILE "add_bubble") "0") (SETQ tndat_lst (LIST (LIST tn_newitem "" "" (GET_TILE "Wrap_value"))) ;_ end of LIST ) ;_ end of SETQ ) ((EQ (GET_TILE "add_bubble") "1") (SETQ tndat_lst (LIST (LIST tn_newitem (GET_TILE "detail_desg") (GET_TILE "sheet_locn") (GET_TILE "Wrap_value") (GET_TILE "leroy_size") (GET_TILE "sheet_from") (GET_TILE "Wrap_lines") ) ;_ end of list ) ;_ end of list ) ;_ end of setq ) ) ;_ end of cond ) ;_ end of if (tnote_sorter) (upd_tnote_dat) ;;; (SETQ tn_newitem nil) ) ;_ end of progn ) ;_ end of if (PRINC) ) ;_ end of defun ;;;******************************************************************** (DEFUN set-place-tnote-text () (SETQ tnote-text-list (LIST typ_t1 typ_t2 typ_t3 typ_t4 typ_t5 typ_t6 typ_t7 typ_t8 typ_t9 typ_t10 typ_t11 typ_t12 typ_t13 typ_t14 typ_t15 typ_t16 typ_t17 typ_t18 typ_t19 typ_t20 ) ;_ end of LIST ) ;_ end of SETQ (IF debug-tnote-text-list (PROGN (SETQ save-tnote-text-list (LIST typ_t1 typ_t2 typ_t3 typ_t4 typ_t5 typ_t6 typ_t7 typ_t8 typ_t9 typ_t10 typ_t11 typ_t12 typ_t13 typ_t14 typ_t15 typ_t16 typ_t17 typ_t18 typ_t19 typ_t20 ) ;_ end of LIST ) ;_ end of SETQ ) ;_ end of PROGN ) ;_ end of IF (IF dimscl nil (LOAD "DIMSCL" "\nFile DIMSCL.LSP not loaded! ") ) ;_ end of IF (WHILE (AND dimscl (NOT dimsc)) (dimscl)) (COND ;;; (MyTxtWid (SETQ maxtxtwid MyTxtWid)) (tn_wrap_len (SETQ maxtxtwid (* (ATOI tn_wrap_len) (/ dimsc 10.0)))) (T (SETQ textboxlst (MAPCAR '(LAMBDA (x) (IF x (TEXTBOX (LIST (CONS 0 "TEXT") (CONS 1 x) (CONS 40 (* (IF dimsc dimsc 1.0 ) ;_ end of IF 0.11 ) ;_ end of * ) ;_ end of CONS ) ;_ end of LIST ) ;_ end of TEXTBOX ) ;_ end of IF ) ;_ end of LAMBDA tnote-text-list ) ;_ end of MAPCAR ) ;_ end of SETQ (SETQ textwidlst (MAPCAR '(LAMBDA (x) (IF x (- (CAADR x) (CAAR x)) ) ;_ end of IF ) ;_ end of LAMBDA textboxlst ) ;_ end of MAPCAR ) ;_ end of SETQ (FOREACH n textwidlst (IF n (SETQ strwidlst (APPEND strwidlst (LIST n))) ) ;_ end of IF ) ;_ end of FOREACH (SETQ maxtxtwid (IF strwidlst (EVAL (CONS 'MAX strwidlst)) 2.0 ) ;_ end of IF ) ;_ end of SETQ (IF debug_maxtxtwid (PROGN (PRINC "\nmaxtxtwid = ") (PRINC maxtxtwid) (PRINC)) ) ;_ end of IF ) ) ;_ end of COND (IF c:mymldr nil (LOAD "mymldr" "\nFile MYMLDR.LSP not loaded! ") ) ;_ end of IF (SETQ tnote-text-list (MAPCAR '(LAMBDA (x) (IF (AND x (/= x "")) (STRCAT x " ") "" ) ;_ end of IF ) ;_ end of LAMBDA tnote-text-list ) ;_ end of MAPCAR ) ;_ end of SETQ (SETQ tnote-text-str (EVAL (CONS 'STRCAT tnote-text-list)) tnote-text-str (SUBSTR tnote-text-str 1 (1-(STRLEN tnote-text-str ))) ) ;;; (IF from_ulbl ;;; (SETQ from_ulbl nil) (IF from_ulbl (SETQ done_from_ulbl T) ) ;_ end of IF (c:mymldr) ;;; ) ;_ end of IF (SETQ typ_t1 nil typ_t2 nil typ_t3 nil typ_t4 nil typ_t5 nil typ_t6 nil typ_t7 nil typ_t8 nil typ_t9 nil typ_t10 nil typ_t11 nil typ_t12 nil typ_t13 nil typ_t14 nil typ_t15 nil typ_t16 nil typ_t17 nil typ_t18 nil typ_t19 nil typ_t20 nil ) ;_ end of SETQ (SETQ tnote-text-list nil textboxlst nil textwidlst nil ;;; maxtxtwid nil strwidlst nil ) ;_ end of SETQ ) ;_ end of defun ;;;******************************************************************** (DEFUN place_note (/ nxt_char chr_indx var_indx fst_break lst_break) (VL-LOAD-COM) ;;; (upd_tnote_dat) (SETQ do_tnote T) (SETQ char_index 1 tmp1_index 1 ) ;_ end of setq (COND ((EQ (GETVAR "tilemode") 1) nil) ((EQ tn_space "tn_msp") (VLA-PUT-MSPACE (VLA-GET-ACTIVEDOCUMENT (VLAX-GET-ACAD-OBJECT)) :VLAX-TRUE) ;;; (command ".mspace") ) ((EQ tn_space "tn_psp") (VLA-PUT-MSPACE (VLA-GET-ACTIVEDOCUMENT (VLAX-GET-ACAD-OBJECT)) :VLAX-FALSE) ;;; (command ".pspace") ) ) ;_ end of cond (IF (= tn_newitem "") (PRINC) (PROGN (IF debug_tnote (PROGN (PRINC "\ntn_newitem(2) = ") (PRINC tn_newitem) (PRINC)) ) ;_ end of IF (upd_tn_thts tn_newitem tnpset_size) (IF debug_tnote (PROGN (PRINC "\ntn_newitem(3) = ") (PRINC tn_newitem) (PRINC)) ) ;_ end of IF (SETQ note_txt tn_newitem) ;;; (IF (EQ (TYPE (READ tn_wrap_len)) 'int) ;;; (PROGN (SETQ word_list (DOS_STRTOKENS tn_newitem " ")) ;;; (SETQ wrap_int (MAX (EVAL (CONS 'MAX (MAPCAR 'STRLEN word_list))) (ATOI tn_wrap_len))) ;character position to wrap lines of the note (never smaller than the longest word in the note) ;;; (SETQ symb_cnt 0 ;incrementer for symbol typ_t# (will be incremented +1 during each use) ;;; word-cnt 0 ;word index position in word_list ;;; str-list (LIST (NTH word-cnt word_list)) ;start str-list with first word in list ;;; ) ;_ end of SETQ ;;; (WHILE str-list ;;; (WHILE (AND (< word-cnt (LENGTH word_list)) ;until all words are processed ;;; (< (STRLEN (EVAL (CONS 'STRCAT (MAPCAR '(LAMBDA (x) (STRCAT x " ")) str-list)))) wrap_int) ;;; ;and the current concatenation of words is less than the wrap_len ;;; ) ;_ end of AND ;;; (SETQ word-cnt (1+ word-cnt) ;;; str-list (APPEND str-list (LIST (NTH word-cnt word_list))) ;add another word from word_list ;;; ) ;_ end of SETQ ;;; ) ;_ end of WHILE ;;; (IF str-list ;;; (PROGN ;;; (IF (> (LENGTH str-list) 1) ;;; (PROGN ;;; (SETQ tn-part-str ;;; (EVAL ;;; (CONS 'STRCAT (MAPCAR '(LAMBDA (x) (STRCAT x " ")) (REVERSE (CDR (REVERSE str-list))))) ;;; ) ;_ end of EVAL ;;; ) ;concatenate the string removing the last word (which exceeds the wrap_len) ;;; (SETQ str-list (LAST str-list)) ;;; ) ;;; (PROGN ;;; (SETQ tn-part-str ;;; (EVAL ;;; (CONS 'STRCAT (MAPCAR '(LAMBDA (x) (STRCAT x " ")) str-list)) ;;; ) ;_ end of EVAL ;;; ) ;concatenate the string removing the last word (which exceeds the wrap_len) ;;; (IF (AND (SETQ next-str-list (MEMBER (CAR str-list) word_list))(>(LENGTH next-str-list) 1)) ;;; (SETQ str-list (CADR next-str-list)) ;;; (SETQ str-list NIL) ;;; ) ;;; ) ;;; ) ;;; ;reset str-list beginning with the last word removed from the previous str-list ;;; (SETQ tn-part-str (SUBSTR tn-part-str 1 (1- (STRLEN tn-part-str)))) ;;; ;remove the trailing space from the concatenated string ;;; ) ;_ end of PROGN ;;; (SETQ tn-part-str nil) ;no str-list? then no tn-part-str ;;; ) ;_ end of IF ;;; (SETQ str-list nil) ;;; (SET (READ (STRCAT "typ_t" (ITOA (SETQ symb_cnt (1+ symb_cnt))))) ;;; ;increment the typ_t# symbol counter and set the value for typ_t (i.e. typ_t1, typ_t2, typ_t3,..., typ_t(n)) ;;; tn-part-str ;;; ) ;_ end of SET ;;; ) ;_ end of WHILE ;;; ) ;_ end of PROGN (SETQ typ_t1 note_txt) ;Do this if NO WRAP ;;; ) ;_ end of IF (IF c:mlt nil (LOAD "mlt" "\nFile MLT.LSP not loaded! ") ) ;_ end of IF (IF upoint nil (LOAD "upoint" "\nFile UPOINT.LSP not loaded! ") ) ;_ end of IF (IF (EQ m-leader "1") (set-place-tnote-text) (c:mlt) ) ;_ end of IF (SETQ typ_t1 nil typ_t2 nil typ_t3 nil typ_t4 nil typ_t5 nil typ_t6 nil typ_t7 nil typ_t8 nil typ_t9 nil typ_t10 nil typ_t11 nil typ_t12 nil typ_t13 nil typ_t14 nil typ_t15 nil typ_t16 nil typ_t17 nil typ_t18 nil typ_t19 nil typ_t20 nil do_tnote nil ) ;_ end of setq (IF (EQ tn_add_bubble "1") (IF (FINDFILE "viewbubble.dwg") (PROGN (SETQ temp-circle (ENTMAKE (LIST (CONS 0 "CIRCLE") (CONS 10 (IF used_mlpt1 used_mlpt1 (LIST (CAR (GETVAR "LASTPOINT")) (CADR (GETVAR "LASTPOINT")) 0.0) ) ;_ end of IF ) ;_ end of CONS (CONS 40 (* dimsc 0.3125)) (CONS 8 "0") ) ;_ end of LIST ) ;_ end of ENTMAKE ) ;_ end of SETQ (IF temp-circle (PROGN (SETQ temp-circle-ss (SSGET "x" (LIST (CONS 0 "CIRCLE") (CONS 10 (IF used_mlpt1 used_mlpt1 (LIST (CAR (GETVAR "LASTPOINT")) (CADR (GETVAR "LASTPOINT")) 0.0) ) ;_ end of IF ) ;_ end of CONS (CONS 40 (* dimsc 0.3125)) (CONS 8 "0") ) ;_ end of LIST ) ;_ end of SSGET ) ;_ end of SETQ (SETQ old_tnab_orthomode (GETVAR "ORTHOMODE")) (SETVAR "ORTHOMODE" 0) (SETQ old_tnab_clayer (GETVAR "CLAYER")) (IF used_layer (SETVAR "CLAYER" used_layer) ) ;_ end of IF (COMMAND ".MOVE" temp-circle-ss "" (CDR (ASSOC 10 (ENTGET (SSNAME temp-circle-ss 0)))) pause) (SETQ bubble-pt (CDR (ASSOC 10 (ENTGET (SSNAME temp-circle-ss 0))))) (ENTDEL (SSNAME temp-circle-ss 0)) (COMMAND ".INSERT" "viewbubble" bubble-pt dimsc dimsc (- (* (/ (GETVAR "viewtwist") PI) 180.0)) (NTH 1 this_note_dat) (NTH 2 this_note_dat) ) ;_ end of COMMAND (SETVAR "ORTHOMODE" old_tnab_orthomode) (IF used_layer (SETVAR "CLAYER" old_tnab_clayer) ) ;_ end of IF ) ;_ end of PROGN ) ;_ end of IF ) ;_ end of PROGN (ALERT "Could not find VIEWBUBBLE.DWG to insert!") ) ;_ end of IF ) ;_ end of IF ) ;_ end of PROGN ) ;_ end of IF (PRINC) ) ;_ end of DEFUN ;;;******************************************************************** (DEFUN set_pview (/ nxt_char chr_indx wrap_len# var_indx fst_break lst_break) (SETQ char_index 1 tmp1_index 1 ) ;_ end of setq (IF (OR (NOT tn_newitem) (= tn_newitem "")) (PROGN (SETQ pview_lst nil) (START_LIST "note_view") (MAPCAR 'ADD_LIST (LIST "")) (END_LIST)) (PROGN (IF debug_tnote (PROGN (PRINC "\ntn_newitem(1) = ") (PRINC tn_newitem) (PRINC)) ) ;_ end of IF (SETQ note_txt tn_newitem) (IF tn_wrap_len (PROGN (SETQ chr_indx 1 var_indx 1 wrap_len# (ATOI tn_wrap_len) ) ;_ end of setq (SETQ nxt_char (SUBSTR note_txt chr_indx 1)) (WHILE (AND (NOT note_done) (NOT (EQ "" note_txt))) (IF (EQ nxt_char " ") ;if breakpoint (PROGN (IF lst_break (SETQ fst_break lst_break) ) ;_ end of if (SETQ lst_break chr_indx) ) ;_ end of PROGN ) ;_ end of if (IF (EQ nxt_char "") ;if endpoint (PROGN (IF lst_break (SETQ fst_break lst_break) ) ;_ end of if (SETQ lst_break chr_indx done_note T ) ;_ end of setq ) ;_ end of PROGN ) ;_ end of if (COND ((OR (> lst_break wrap_len#) (WCMATCH (STRCASE (SUBSTR note_txt 1 5)) "NOTE:")) (SET (READ (STRCAT "typ_t" (ITOA var_indx))) (IF fst_break (SUBSTR note_txt 1 (1- fst_break)) (IF (WCMATCH (STRCASE (SUBSTR note_txt 1 5)) "NOTE:") (SUBSTR note_txt 1 5) (SUBSTR note_txt 1 (1- lst_break)) ) ;_ end of IF ) ;_ end of if ) ;_ end of set (SETQ note_txt (IF fst_break (SUBSTR note_txt (1+ fst_break)) (IF (WCMATCH (STRCASE (SUBSTR note_txt 1 5)) "NOTE:") (SUBSTR note_txt 7) (SUBSTR note_txt (1+ lst_break)) ) ;_ end of IF ) ;_ end of if chr_indx 1 var_indx (1+ var_indx) fst_break nil lst_break nil nxt_char (SUBSTR note_txt 1 1) ) ;_ end of setq ) ((EQ lst_break wrap_len#) ;if 2nd break = wrap length (SET (READ (STRCAT "typ_t" (ITOA var_indx))) (SUBSTR note_txt 1 (1- lst_break))) ;_ end of set (IF (> (STRLEN note_txt) wrap_len#) (SETQ note_txt (SUBSTR note_txt (1+ lst_break)) chr_indx 1 var_indx (1+ var_indx) fst_break nil lst_break nil nxt_char (SUBSTR note_txt 1 1) ) ;_ end of setq (SETQ nxt_char "" note_done T ) ;_ end of setq ) ;_ end of if ) ((<= (STRLEN note_txt) wrap_len#) (SET (READ (STRCAT "typ_t" (ITOA var_indx))) note_txt) ;_ end of set (SETQ nxt_char "" note_done T ) ;_ end of setq ) ) ;_ end of COND (SETQ chr_indx (1+ chr_indx) nxt_char (SUBSTR note_txt chr_indx 1) ) ;_ end of setq ) ;_ end of WHILE (IF note_done (SETQ note_done nil) (PROGN (SET (READ (STRCAT "typ_t" (ITOA var_indx))) note_txt) ;_ end of set ) ;_ end of PROGN ) ;_ end of IF ) ;_ end of PROGN (SETQ typ_t1 note_txt) ;Do this if NO WRAP ) ;_ end of IF (PRINC fst_break) (PRINC lst_break) (IF typ_t1 (PROGN (SETQ pview_lst (LIST typ_t1)) (IF typ_t2 (PROGN (SETQ pview_lst (APPEND pview_lst (LIST typ_t2))) (IF typ_t3 (PROGN (SETQ pview_lst (APPEND pview_lst (LIST typ_t3))) (IF typ_t4 (PROGN (SETQ pview_lst (APPEND pview_lst (LIST typ_t4))) (IF typ_t5 (PROGN (SETQ pview_lst (APPEND pview_lst (LIST typ_t5))) ;_ end of setq (IF typ_t6 (PROGN (SETQ pview_lst (APPEND pview_lst (LIST typ_t6)) ;_ end of append ) ;_ end of setq (IF typ_t7 (PROGN (SETQ pview_lst (APPEND pview_lst (LIST typ_t7)) ;_ end of append ) ;_ end of setq (IF typ_t8 (PROGN (SETQ pview_lst (APPEND pview_lst (LIST typ_t8)) ;_ end of append ) ;_ end of setq (IF typ_t9 (PROGN (SETQ pview_lst (APPEND pview_lst (LIST typ_t9)) ;_ end of append ) ;_ end of setq (IF typ_t10 (PROGN (SETQ pview_lst (APPEND pview_lst (LIST typ_t10) ;_ end of list ) ;_ end of append ) ;_ end of setq (IF typ_t11 (PROGN (SETQ pview_lst (APPEND pview_lst (LIST typ_t11) ;_ end of list ) ;_ end of append ) ;_ end of setq (IF typ_t12 (PROGN (SETQ pview_lst (APPEND pview_lst (LIST typ_t12) ;_ end of list ) ;_ end of append ) ;_ end of setq (IF typ_t13 (PROGN (SETQ pview_lst (APPEND pview_lst (LIST typ_t13) ;_ end of list ) ;_ end of append ) ;_ end of setq (IF typ_t14 (PROGN (SETQ pview_lst (APPEND pview_lst (LIST typ_t14) ;_ end of list ) ;_ end of append ) ;_ end of setq (IF typ_t15 (PROGN (SETQ pview_lst (APPEND pview_lst (LIST typ_t15) ;_ end of list ) ;_ end of append ) ;_ end of setq (IF typ_t16 (PROGN (SETQ pview_lst (APPEND pview_lst (LIST typ_t16) ;_ end of list ) ;_ end of append ) ;_ end of setq (IF typ_t17 (PROGN (SETQ pview_lst (APPEND pview_lst (LIST typ_t17) ;_ end of list ) ;_ end of append ) ;_ end of setq (IF typ_t18 (PROGN (SETQ pview_lst (APPEND pview_lst (LIST typ_t18) ;_ end of list ) ;_ end of append ) ;_ end of setq (IF typ_t19 (PROGN (SETQ pview_lst (APPEND pview_lst (LIST typ_t19) ;_ end of list ) ;_ end of append ) ;_ end of setq (IF typ_t20 (PROGN (SETQ pview_lst (APPEND pview_lst (LIST typ_t20) ;_ end of list ) ;_ end of append ) ;_ end of setq ) ;_ end of progn (PRINC) ) ;_ end of if ) ;_ end of progn (PRINC) ) ;_ end of if ) ;_ end of progn (PRINC) ) ;_ end of if ) ;_ end of progn (PRINC) ) ;_ end of if ) ;_ end of progn (PRINC) ) ;_ end of if ) ;_ end of progn (PRINC) ) ;_ end of if ) ;_ end of progn (PRINC) ) ;_ end of if ) ;_ end of progn (PRINC) ) ;_ end of if ) ;_ end of progn (PRINC) ) ;_ end of if ) ;_ end of progn (PRINC) ) ;_ end of if ) ;_ end of progn (PRINC) ) ;_ end of if ) ;_ end of progn (PRINC) ) ;_ end of if ) ;_ end of progn (PRINC) ) ;_ end of if ) ;_ end of progn (PRINC) ) ;_ end of if ) ;_ end of progn (PRINC) ) ;_ end of if ) ;_ end of progn (PRINC) ) ;_ end of if ) ;_ end of progn (PRINC) ) ;_ end of if ) ;_ end of progn (PRINC) ) ;_ end of if ) ;_ end of progn (PRINC) ) ;_ end of if ) ;_ end of progn (PRINC) ) ;_ end of if (pview) (SETQ typ_t1 nil typ_t2 nil typ_t3 nil typ_t4 nil typ_t5 nil typ_t6 nil typ_t7 nil typ_t8 nil typ_t9 nil typ_t10 nil typ_t11 nil typ_t12 nil typ_t13 nil typ_t14 nil typ_t15 nil typ_t16 nil typ_t17 nil typ_t18 nil typ_t19 nil typ_t20 nil fst_break nil lst_break nil ) ;_ end of setq (PRINC "\010\010\010\010\010\010 \010\010\010\010\010\010") ;_ end of princ ) ;_ end of PROGN ) ;_ end of IF (SET_TILE "error" "") (PRINC) ) ;_ end of DEFUN ;;;******************************************************************** (DEFUN intchk (ivar /) (IF (ATOI ivar) nil (SETQ ivar "0") ) ;_ end of if (PRINC) ) ;_ end of defun ;;;******************************************************************** (DEFUN chk_tnlst () (SETQ tmptn_lst nil) (IF tnote_list (PROGN (FOREACH n tnote_list (IF (AND tmptn_lst n) (SETQ tmptn_lst (APPEND tmptn_lst (LIST n))) (IF n (SETQ tmptn_lst (LIST n)) ) ;_ end of IF ) ;_ end of IF ) ;_ end of FOREACH (SETQ tmptn_lst (ACAD_STRLSORT tmptn_lst)) (SETQ tnote_list tmptn_lst) (SETQ prev_tnlst tnote_lst) ) ;_ end of PROGN ) ;_ end of IF ) ;_ end of DEFUN ;;;******************************************************************** (DEFUN upd_tn_thts (note_str size /) (IF (SETQ curnote_lst (ASSOC note_str tndat_lst)) (PROGN (COND ((AND (EQ (LENGTH curnote_lst) 5) (/= (NTH 4 curnote_lst) size)) (SETQ tndat_lst (SUBST (REVERSE (CONS size (CDR (REVERSE curnote_lst)))) curnote_lst tndat_lst)) ) ((EQ (LENGTH curnote_lst) 4) (SETQ tndat_lst (SUBST (REVERSE (CONS size (REVERSE curnote_lst))) curnote_lst tndat_lst)) ) ) ;_ end of COND ) ;_ end of PROGN ) ;_ end of IF ) ;_ end of DEFUN ;;;******************************************************************** (DEFUN res_tn_thts (note_str /) (IF (SETQ curnote_lst (ASSOC note_str tndat_lst)) (IF (EQ (LENGTH curnote_lst) 5) (PROGN (IF debug_tnote (PROGN (PRINC "\n(NTH 4 curnote_lst)=") (PRINC (TYPE (NTH 4 curnote_lst))) (PRINC (STRCAT "\nWe set the leroy size to " (NTH 4 curnote_lst) ". ")) (PRINC) ) ;_ end of PROGN ) ;_ end of IF (SET_TILE "leroy_size" (NTH 4 curnote_lst)) (set_leroy (NTH 4 curnote_lst)) ) ;_ end of PROGN ) ;_ end of IF (IF debug_tnote (PROGN (PRINC "\nnote_str=") (PRINC note_str) (PRINC)) ) ;_ end of IF ) ;_ end of IF ) ;_ end of DEFUN ;;;******************************************************************** (DEFUN del_tnlines () (SETQ del_note (NTH (ATOI tn_del_key) tnote_list)) (SETQ tnote_list (SUBST nil del_note tnote_list)) (chk_tnlst) (SETQ new_tnote_list tnote_list) (SETQ del_dat (ASSOC del_note tndat_lst)) (SETQ tndat_lst (SUBST nil del_dat tndat_lst)) (SETQ tmptn_lst nil) (FOREACH n tndat_lst (IF (AND tmptn_lst n) (SETQ tmptn_lst (APPEND tmptn_lst (LIST n))) (IF n (SETQ tmptn_lst (LIST n)) ) ;_ end of IF ) ;_ end of IF ) ;_ end of FOREACH (SETQ tndat_lst tmptn_lst) ;;; (SETQ del_ndx_lst ;;; nil ;;; cur_list nil ;;; ) ;_ end of setq ;;; (SETQ new_tnote_list nil) ;;; (SETQ count 1) ;;; (WHILE (<= count (STRLEN tn_del_key)) ;;; (WHILE (AND (EQ (SUBSTR tn_del_key count 1) " ") ;;; (NOT (> count (STRLEN tn_del_key))) ;;; ) ;_ end of and ;;; (SETQ count (1+ count)) ;;; ) ;_ end of while ;;; (SETQ strt_cnt count ;;; end_cnt 0 ;;; ) ;_ end of setq ;;; (WHILE (AND (NOT (EQ (SUBSTR tn_del_key count 1) " ")) ;;; (NOT (> count (STRLEN tn_del_key))) ;;; ) ;_ end of and ;;; (SETQ count (1+ count) ;;; end_cnt (1+ end_cnt) ;;; ) ;_ end of setq ;;; ) ;_ end of while ;;; (IF (<= strt_cnt (STRLEN tn_del_key)) ;;; (SETQ del_ndx_lst ;;; (IF del_ndx_lst ;;; (APPEND del_ndx_lst ;;; (LIST (ATOI (SUBSTR tn_del_key strt_cnt end_cnt))) ;;; ) ;_ end of append ;;; (LIST (ATOI (SUBSTR tn_del_key strt_cnt end_cnt))) ;;; ) ;_ end of if ;;; ) ;_ end of setq ;;; ) ;_ end of if ;;; ) ;_ end of while ;;; (SETQ cur_list tnote_list) ;;; (FOREACH n del_ndx_lst ;;; (SETQ cur_list ;;; (SUBST nil (NTH n cur_list) cur_list) ;;; ) ;_ end of setq ;;; ) ;_ end of foreach ;;; (FOREACH n cur_list ;;; (IF n ;;; (SETQ new_tnote_list ;;; (IF new_tnote_list ;;; (APPEND new_tnote_list (LIST n)) ;;; (LIST n) ;;; ) ;_ end of if ;;; ) ;_ end of setq ;;; ) ;_ end of if ;;; ) ;_ end of foreach (START_LIST "Major") (MAPCAR 'ADD_LIST new_tnote_list) (END_LIST) (upd_tnote_dat) (MODE_TILE "Major" 2) (SET_TILE "Major" tn_del_key) (PRINC) ) ;_ end of defun ;;;******************************************************************** (DEFUN tn-pcpyrt (/) (SETQ cr (LIST "w" "o" "r" "y" "d" "u" "e" "t" "h" "f" "a" "g" "n" "c" "i" "p" "r" "s" "j" "l" "v" "b") ;_ end of LIST ;_ end of LIST ;_ end of LIST ;_ end of list wrd1 (STRCAT ;Copyright (STRCASE (NTH 13 cr)) (NTH 1 cr) (NTH 15 cr) (NTH 3 cr) (NTH 2 cr) (NTH 14 cr) (NTH 11 cr) (NTH 8 cr) (NTH 7 cr) ) ;_ end of strcat wrd2 " " wrd3 (STRCAT (ITOA 1996) "-" (ITOA 2015)) wrd4 ", " wrd4b (STRCAT ;by (NTH 21 cr) (NTH 3 cr) ) ;_ end of strcat wrd5 (STRCAT ;Henry (STRCASE (NTH 8 cr)) (NTH 6 cr) (NTH 12 cr) (NTH 2 cr) (NTH 3 cr) ) ;_ end of strcat wrd6 (STRCASE (NTH 13 cr)) ;C wrd6a ". " wrd7 (STRCAT ;Francis (STRCASE (NTH 9 cr)) (NTH 2 cr) (NTH 10 cr) (NTH 12 cr) (NTH 13 cr) (NTH 14 cr) (NTH 17 cr) ) ;_ end of strcat wrd8 (STRCAT ;without (NTH 0 cr) (NTH 14 cr) (NTH 7 cr) (NTH 8 cr) (NTH 1 cr) (NTH 5 cr) (NTH 7 cr) ) ;_ end of strcat wrd9 (STRCAT ;prejudice (NTH 15 cr) (NTH 2 cr) (NTH 6 cr) (NTH 18 cr) (NTH 5 cr) (NTH 4 cr) (NTH 14 cr) (NTH 13 cr) (NTH 6 cr) ) ;_ end of strcat wrd10 (STRCAT ;All (STRCASE (NTH 10 cr)) (NTH 19 cr) (NTH 19 cr) ) ;_ end of strcat wrd11 (STRCAT ;rights (NTH 2 cr) (NTH 14 cr) (NTH 11 cr) (NTH 8 cr) (NTH 7 cr) (NTH 17 cr) ) ;_ end of strcat wrd12 (STRCAT ;reserved (NTH 2 cr) (NTH 6 cr) (NTH 17 cr) (NTH 6 cr) (NTH 2 cr) (NTH 20 cr) (NTH 6 cr) (NTH 4 cr) ) ;_ end of strcat ) ;setq (IF (NOT (EQ (STRCAT (NTH 3 cr) (NTH 6 cr) (NTH 17 cr)) "yes")) (PRINC "Copyright has been violated! ") (PROGN (PRINC "\nCLG Doctor - ver. 1.01a\n") (PRINC wrd1) (PRINC wrd2) (PRINC wrd3) (PRINC wrd2) (PRINC wrd4b) (PRINC wrd2) (PRINC wrd5) (PRINC wrd2) (PRINC wrd6) (PRINC wrd6a) (PRINC wrd7) (PRINC wrd4) (PRINC wrd10) (PRINC wrd2) (PRINC wrd11) (PRINC wrd2) (PRINC wrd12) (PRINC wrd2) (PRINC wrd8) (PRINC wrd2) (PRINC wrd9) (PRINC wrd6a) ) ;_ end of progn ) ;_ end of if (PRINC) ) ;_ end of defun (DEFUN c:tnote_trace () (TRACE c:tnote) (TRACE c:mlt) (TRACE c:mklayr) (TRACE c:svlayr) (TRACE c:rslayr) (TRACE gvpno) (TRACE txtsize) (TRACE getstyle) (TRACE cmud_colr) (TRACE set_txt_colr) (TRACE tn-pcpyrt) (TRACE del_tnlines) (TRACE res_tn_thts) (TRACE upd_tn_thts) (TRACE chk_tnlst) (TRACE intchk) (TRACE set_pview) (TRACE place_note) (TRACE add_tn_item) (TRACE upd_tnote_dat) (TRACE repl_item) (TRACE set_tnote_ebox) (TRACE set_wrap) (TRACE tnote_sorter) (TRACE set_tnote_list) (TRACE get_tnotedat_file) (TRACE pview) (TRACE tn_set_caps) (TRACE f_tnote) (TRACE set_bubl) (TRACE set_leroy) (TRACE set_decimal) (TRACE sets_txtc) (TRACE sets_ldrc) (TRACE setv_txtc) (TRACE setv_ldrc) (TRACE set_colr_mode) ) ;_ end of DEFUN (DEFUN c:tnote_untrace () (UNTRACE c:tnote) (UNTRACE c:mlt) (UNTRACE c:mklayr) (UNTRACE c:svlayr) (UNTRACE c:rslayr) (UNTRACE gvpno) (UNTRACE txtsize) (UNTRACE getstyle) (UNTRACE cmud_colr) (UNTRACE set_txt_colr) (UNTRACE tn-pcpyrt) (UNTRACE del_tnlines) (UNTRACE res_tn_thts) (UNTRACE upd_tn_thts) (UNTRACE chk_tnlst) (UNTRACE intchk) (UNTRACE set_pview) (UNTRACE place_note) (UNTRACE add_tn_item) (UNTRACE upd_tnote_dat) (UNTRACE repl_item) (UNTRACE set_tnote_ebox) (UNTRACE set_wrap) (UNTRACE tnote_sorter) (UNTRACE set_tnote_list) (UNTRACE get_tnotedat_file) (UNTRACE pview) (UNTRACE tn_set_caps) (UNTRACE f_tnote) (UNTRACE set_bubl) (UNTRACE set_leroy) (UNTRACE set_decimal) (UNTRACE sets_txtc) (UNTRACE sets_ldrc) (UNTRACE setv_txtc) (UNTRACE setv_ldrc) (UNTRACE set_colr_mode) ) ;_ end of DEFUN (PRINC) ;|«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! ***|;