;;;
;;;
;;;>	Author:	Henry C. Francis
;;;>		425 N. Ashe St.
;;;>		Southern Pines, NC 28387
;;;>		http://paracadd.com
;;;>		All rights reserved.
;;;
;;;>		COPYRIGHT: 3/27/2004
;;;>		   EDITED: 04-03-2004
;;;
(DEFUN c:tblfix	(/ itss	itss_len itss_cnt this_it head_it body_it unk_it bodynos tblno_lst head_txt
		 rawtxt_lst row_txt head_ename head_ent	text_def newtxt_def title_txt xorigin
		 xpt_max xpt_min xpt_min2 txtlen coltxt this_old assoc111 assoc211 assoc311 assoc411
		 assoc511 assoc611 assoc711 t_stops txt_miny begcnt colcnt endcnt xpt_lst splitcnt
		 word_txt word_as10 word_def beg_stops
		)
  (COMMAND ".undo" "m")
  (tblfix_sty)
  (IF do_spin
    (PRINC "\nSpinner is ON (type SPINIT to toggle) ")
    (PRINC "\nSpinner is OFF (type SPINIT to toggle) ")
  )
  (PRINC "Select Just one table. ")
  (princ)
  (SETQ	itss (SSGET '((-4 . "<OR")
		      (-4 . "<AND")
		      (0 . "INSERT")
		      (-4 . "<OR")
		      (2 . "HEAD#")
		      (2 . "BODY#")
		      (-4 . "OR>")
		      (-4 . "AND>")
		      (0 . "TEXT")
		      (-4 . "OR>")
		     )
	     ) ;_ end of ssget
  ) ;_ end of setq
  (SETQ itss_len (SSLENGTH itss))
  (SETQ itss_cnt 0)
  (WHILE (< itss_cnt itss_len)
    (SETQ this_it (ENTGET (SSNAME itss itss_cnt)))
    (COND
      ((EQ (CDR (ASSOC 0 this_it)) "INSERT")
       (COND
	 ((WCMATCH (CDR (ASSOC 2 this_it)) "HEAD*")
	  (SETQ head_it (APPEND head_it (LIST this_it)))
	 )
	 ((WCMATCH (CDR (ASSOC 2 this_it)) "BODY*")
	  (SETQ body_it (APPEND body_it (LIST this_it)))
	  (IF (AND bodynos (MEMBER (SUBSTR (CDR (ASSOC 2 this_it)) 5) bodynos))
	    nil
	    (SETQ bodynos (APPEND bodynos (LIST (SUBSTR (CDR (ASSOC 2 this_it)) 5))))
	  ) ;_ end of if
	 )
	 ((WCMATCH (CDR (ASSOC 2 this_it)) "*")
	  (SETQ unk_it (APPEND unk_it (LIST this_it)))
	 )
       ) ;_ end of cond
      )
      ((EQ (CDR (ASSOC 0 this_it)) "TEXT")
       (IF text_def
	 nil
	 (SETQ text_def this_it)
       ) ;_ end of if
       (SETQ rawtxt_lst
	      (APPEND rawtxt_lst
		      (LIST (LIST (CDR (ASSOC 10 this_it)) (CDR (ASSOC 1 this_it))))
	      ) ;_ end of append
       ) ;_ end of setq
      )
    ) ;_ end of cond
    (SETQ itss_cnt (1+ itss_cnt))
  ) ;_ end of while
  (SETQ beg_stops nil)
  (FOREACH n rawtxt_lst
    (COND
      ((<= (STRLEN (CADR n)) 3)
       (SETQ tblno_lst (LIST (CAR n) (CADR n)))
      )
      ((AND (< (CADDR (ASSOC 10 (CAR head_it))) (CADAR n))
	    (OR
	      (WCMATCH (CADR n) "*         @ @ @ *")
	      (WCMATCH (CADR n) "*FROM*TO*")
	    )
       )
       (SETQ head_txt (APPEND head_txt (LIST (LIST (CAR n) (CADR n)))))
      )
      ((/= (CADDR (ASSOC 10 (CAR head_it))) (CADAR n))
       (SETQ row_txt (APPEND row_txt (LIST (LIST (CAR n) (CADR n)))))
      )
      (T (PRINC "\n\t\t*** SOME TABLE TEXT COULD NOT BE CLASSIFIED! ***"))
    ) ;_ end of cond
  ) ;_ end of foreach
  (SETQ head_ename (TBLOBJNAME "block" (CDR (ASSOC 2 (NTH 0 head_it)))))
  (WHILE
    (SETQ head_ename (ENTNEXT head_ename))
     (SETQ head_ent (ENTGET head_ename))
     (IF (AND xpt_lst (MEMBER (CADR (ASSOC 10 head_ent)) xpt_lst))
       nil
       (IF (AND xpt_lst (NOT (MEMBER nil xpt_lst)))
	 (SETQ xpt_lst (APPEND xpt_lst (LIST (CADR (ASSOC 10 head_ent)))))
	 (SETQ xpt_lst (LIST (CADR (ASSOC 10 head_ent))))
       ) ;_ end of IF
     ) ;_ end of if
     (IF (AND xpt_lst (MEMBER (CADR (ASSOC 11 head_ent)) xpt_lst))
       nil
       (IF (AND xpt_lst (NOT (MEMBER nil xpt_lst)))
	 (SETQ xpt_lst (APPEND xpt_lst (LIST (CADR (ASSOC 11 head_ent)))))
	 (SETQ xpt_lst (LIST (CADR (ASSOC 11 head_ent))))
       ) ;_ end of IF
     ) ;_ end of if
  ) ;_ end of while
  (SETQ	xorigin	(CADR (ASSOC 10 (NTH 0 head_it)))
	yorigin	(CADDR (ASSOC 10 (NTH 0 head_it)))
  ) ;_ end of SETQ
  (SETQ xpt_lst (VL-SORT xpt_lst '<))
  (FOREACH n head_txt
    (COND
      ((WCMATCH (CADR n) "*         @ @ @ *")
       (SETQ title_txt (CADR n))
       (WHILE (WCMATCH title_txt "*    @ @ @ *")
	 (SETQ title_txt (SUBSTR title_txt 5))
       ) ;_ end of while
       (COND
	 ((WCMATCH title_txt "    @ @ @ *")
	  (SETQ title_txt (SUBSTR title_txt 5))
	 )
	 ((WCMATCH title_txt "   @ @ @ *")
	  (SETQ title_txt (SUBSTR title_txt 4))
	 )
	 ((WCMATCH title_txt "  @ @ @ *")
	  (SETQ title_txt (SUBSTR title_txt 3))
	 )
	 ((WCMATCH title_txt " @ @ @ *")
	  (SETQ title_txt (SUBSTR title_txt 2))
	 )
       ) ;_ end of cond
       (SETQ newtxt_def
	      (LIST
		(CONS 0 "text")
		(ASSOC 6 text_def)
		(ASSOC 7 text_def)
		(ASSOC 8 text_def)
		(CONS 10 (LIST 0 0 0))
		(CONS 11 (LIST (+ xorigin (/ (+ (LAST xpt_lst) (CAR xpt_lst)) 2.0)) (CADAR n) 0))
		(CONS 1 title_txt)
		(ASSOC 40 text_def)
		(ASSOC 62 text_def)
		(CONS 72 1)
	      ) ;_ end of list
       ) ;_ end of setq
       (ENTMAKE newtxt_def)
       (SETQ this_old (SSGET "x" (LIST (CONS 1 (CADR n)) (CONS 10 (CAR n)))))
       (ENTDEL (SSNAME this_old 0))
       (SETQ newtxt_def nil)
      )
      ((WCMATCH (CADR n) "*FROM*TO*")
       (SETQ xpt_max (LAST xpt_lst))
       (SETQ xpt_min1 (CADR (REVERSE xpt_lst)))
       (SETQ xpt_min2 (CADDR (REVERSE xpt_lst)))
       (SETQ newtxt_def
	      (LIST
		(CONS 0 "text")
		(ASSOC 6 text_def)
		(ASSOC 7 text_def)
		(ASSOC 8 text_def)
		(CONS 10 (LIST 0 0 0))
		(CONS 11
		      (LIST (+ xorigin
			       (/ (+ xpt_max
				     xpt_min1
				  ) ;_ end of +
				  2.0
			       ) ;_ end of /
			    ) ;_ end of +
			    (CADAR n)
			    0
		      ) ;_ end of list
		) ;_ end of cons
		(CONS 1 "TO")
		(ASSOC 40 text_def)
		(ASSOC 62 text_def)
		(CONS 72 1)
	      ) ;_ end of list
       ) ;_ end of setq
       (ENTMAKE newtxt_def)
       (SETQ newtxt_def
	      (SUBST
		(CONS 11
		      (LIST
			(+ xorigin
			   (/ (+ xpt_min1
				 xpt_min2
			      ) ;_ end of +
			      2.0
			   ) ;_ end of /
			) ;_ end of +
			(CADAR n)
			0
		      ) ;_ end of list
		) ;_ end of cons
		(ASSOC 11 newtxt_def)
		newtxt_def
	      ) ;_ end of subst
       ) ;_ end of SETQ
       (SETQ newtxt_def (SUBST (CONS 1 "FROM") (ASSOC 1 newtxt_def) newtxt_def))
       (ENTMAKE newtxt_def)
       (SETQ this_old (SSGET "x" (LIST (CONS 1 (CADR n)) (CONS 10 (CAR n)))))
       (ENTDEL (SSNAME this_old 0))
       (SETQ newtxt_def nil)
      )
      ((WCMATCH	(CADR n)
		"*CABLE*CABLE TYPE*WIRE NO. - COLOR*EQUIP/AREA*TERMINATION*EQUIP/AREA*TERMINATION*"
       ) ;_ end of WCMATCH
       (SETQ coltxt (CADR n))
       (WHILE (AND coltxt (> (STRLEN coltxt) 10))
	 (COND
	   ((WCMATCH coltxt "CABLE*CABLE*")
	    (SETQ coltxt_1 "CABLE"
		  assoc111 (LIST (+ (CAAR n)
				    (* (- (STRLEN (CADR n)) (STRLEN coltxt)) (CDR (ASSOC 40 text_def)))
				 ) ;_ end of +
				 (CADAR n)
				 0
			   ) ;_ end of LIST
	    ) ;_ end of SETQ
	   )
	   ((WCMATCH coltxt "CABLE TYPE*")
	    (SETQ coltxt_2 "CABLE TYPE"
		  assoc211 (LIST (+ (CAAR n)
				    (* (- (STRLEN (CADR n)) (STRLEN coltxt)) (CDR (ASSOC 40 text_def)))
				 ) ;_ end of +
				 (CADAR n)
				 0
			   ) ;_ end of LIST
	    ) ;_ end of SETQ
	   )
	   ((WCMATCH coltxt "WIRE NO.*")
	    (SETQ coltxt_3 "WIRE NO. - COLOR"
		  assoc311 (LIST (+ (CAAR n)
				    (* (- (STRLEN (CADR n)) (STRLEN coltxt)) (CDR (ASSOC 40 text_def)))
				 ) ;_ end of +
				 (CADAR n)
				 0
			   ) ;_ end of LIST
	    ) ;_ end of SETQ
	   )
	   ((WCMATCH coltxt "EQUIP/AREA*EQUIP/AREA*")
	    (SETQ coltxt_4 "EQUIP/AREA"
		  assoc411 (LIST (+ (CAAR n)
				    (* (- (STRLEN (CADR n)) (STRLEN coltxt)) (CDR (ASSOC 40 text_def)))
				 ) ;_ end of +
				 (CADAR n)
				 0
			   ) ;_ end of LIST
	    ) ;_ end of SETQ
	   )
	   ((WCMATCH coltxt "TERMINATION*TERMINATION*")
	    (SETQ coltxt   (SUBSTR coltxt 12)
		  coltxt_5 "TERMINATION"
		  assoc511 (LIST (+ -0.0333
				    (CAAR n)
				    (* (- (STRLEN (CADR n)) (STRLEN coltxt)) (CDR (ASSOC 40 text_def)))
				 ) ;_ end of +
				 (CADAR n)
				 0
			   ) ;_ end of LIST
	    ) ;_ end of SETQ
	   )
	   ((WCMATCH coltxt "EQUIP/AREA*TERMINATION")
	    (SETQ coltxt_6 "EQUIP/AREA"
		  assoc611 (LIST (+ (CAAR n)
				    (* (- (STRLEN (CADR n)) (STRLEN coltxt)) (CDR (ASSOC 40 text_def)))
				 ) ;_ end of +
				 (CADAR n)
				 0
			   ) ;_ end of LIST
	    ) ;_ end of SETQ
	   )
	   ((WCMATCH coltxt "TERMINATION")
	    (SETQ coltxt_7 "TERMINATION"
		  assoc711 (LIST (+ -0.0333 (CAAR n) (* (STRLEN (CADR n)) (CDR (ASSOC 40 text_def))))
				 (CADAR n)
				 0
			   ) ;_ end of LIST
	    ) ;_ end of SETQ
	   )
	 ) ;_ end of COND
	 (SETQ coltxt (SUBSTR coltxt 2))
       ) ;_ end of WHILE
       (SETQ newtxt_def
	      (LIST
		(CONS 0 "text")
		(ASSOC 6 text_def)
		(ASSOC 7 text_def)
		(ASSOC 8 text_def)
		(CONS 10 assoc111)
		(CONS 1 coltxt_1)
		(ASSOC 40 text_def)
		(ASSOC 62 text_def)
	      ) ;_ end of list
       ) ;_ end of setq
       (ENTMAKE newtxt_def)
       (SETQ newtxt_def
	      (LIST
		(CONS 0 "text")
		(ASSOC 6 text_def)
		(ASSOC 7 text_def)
		(ASSOC 8 text_def)
		(CONS 10 assoc211)
		(CONS 1 coltxt_2)
		(ASSOC 40 text_def)
		(ASSOC 62 text_def)
	      ) ;_ end of list
       ) ;_ end of setq
       (ENTMAKE newtxt_def)
       (SETQ newtxt_def
	      (LIST
		(CONS 0 "text")
		(ASSOC 6 text_def)
		(ASSOC 7 text_def)
		(ASSOC 8 text_def)
		(CONS 10 assoc311)
		(CONS 1 coltxt_3)
		(ASSOC 40 text_def)
		(ASSOC 62 text_def)
	      ) ;_ end of list
       ) ;_ end of setq
       (ENTMAKE newtxt_def)
       (SETQ newtxt_def
	      (LIST
		(CONS 0 "text")
		(ASSOC 6 text_def)
		(ASSOC 7 text_def)
		(ASSOC 8 text_def)
		(CONS 10 assoc411)
		(CONS 1 coltxt_4)
		(ASSOC 40 text_def)
		(ASSOC 62 text_def)
	      ) ;_ end of list
       ) ;_ end of setq
       (ENTMAKE newtxt_def)
       (SETQ newtxt_def
	      (LIST
		(CONS 0 "text")
		(ASSOC 6 text_def)
		(ASSOC 7 text_def)
		(ASSOC 8 text_def)
		(CONS 10 (LIST 0 0 0))
		(CONS 11 assoc511)
		(CONS 1 coltxt_5)
		(ASSOC 40 text_def)
		(ASSOC 62 text_def)
		(CONS 72 2)
	      ) ;_ end of list
       ) ;_ end of setq
       (ENTMAKE newtxt_def)
       (SETQ newtxt_def
	      (LIST
		(CONS 0 "text")
		(ASSOC 6 text_def)
		(ASSOC 7 text_def)
		(ASSOC 8 text_def)
		(CONS 10 assoc611)
		(CONS 1 coltxt_6)
		(ASSOC 40 text_def)
		(ASSOC 62 text_def)
	      ) ;_ end of list
       ) ;_ end of setq
       (ENTMAKE newtxt_def)
       (SETQ newtxt_def
	      (LIST
		(CONS 0 "text")
		(ASSOC 6 text_def)
		(ASSOC 7 text_def)
		(ASSOC 8 text_def)
		(CONS 10 (LIST 0 0 0))
		(CONS 11 assoc711)
		(CONS 1 coltxt_7)
		(ASSOC 40 text_def)
		(ASSOC 62 text_def)
		(CONS 72 2)
	      ) ;_ end of list
       ) ;_ end of setq
       (ENTMAKE newtxt_def)
       (SETQ this_old (SSGET "x" (LIST (CONS 1 (CADR n)) (CONS 10 (CAR n)))))
       (ENTDEL (SSNAME this_old 0))
       (SETQ newtxt_def nil)
      )
    ) ;_ end of COND
  ) ;_ end of foreach
  (PRINC "\nProcessing, please wait... ")
  (FOREACH n row_txt
    (SETQ txtlen (STRLEN (CADR n)))
    (IF	txt_miny
      (SETQ txt_miny (MIN (CADAR n) txt_miny))
      (SETQ txt_miny (CADAR n))
    ) ;_ end of IF
    (SETQ coltxt (CADR n)
	  colcnt 1
    ) ;_ end of SETQ
    (SETQ this_old (SSGET "x" (LIST (CONS 1 (CADR n)) (CONS 10 (CAR n)))))
    (ENTDEL (SSNAME this_old 0))
    (SETQ begcnt nil)
    (WHILE (AND coltxt (<= colcnt (STRLEN (CADR n))))
      (IF (OR
	    (WCMATCH (SUBSTR coltxt colcnt 1) "  ")
	    (AND
	      (<= colcnt 2)
	      (WCMATCH (SUBSTR coltxt colcnt 1) " ")
	    ) ;_ end of AND
	  ) ;_ end of OR
	(SETQ begcnt nil)
	(PROGN
	  (WHILE
	    (AND
	      (<= colcnt (STRLEN (CADR n)))
	      (OR
		(WCMATCH (SUBSTR coltxt colcnt 1) "@")
		(WCMATCH (SUBSTR coltxt colcnt 1) "#")
		(AND
		  (WCMATCH (SUBSTR coltxt colcnt 1) ".")
		  (NOT (WCMATCH (SUBSTR coltxt colcnt 2) "  "))
		) ;_ end of and
	      ) ;_ end of or
	    ) ;_ end of and
	     (IF begcnt
	       nil
	       (SETQ begcnt colcnt)
	     ) ;_ end of if
	     (SETQ colcnt (1+ colcnt))
	     (SETQ endcnt colcnt)
	  ) ;_ end of while
	  (IF (AND n begcnt endcnt)
	    (PROGN
	      (WHILE (EQ (SUBSTR (CADR n) begcnt 1) " ")
		(SETQ begcnt (1+ begcnt))
	      ) ;_ end of WHILE
	      (FOREACH o xpt_lst
		(IF (AND
		      (< (* begcnt (CDR (ASSOC 40 text_def))) o)
		      (> (* endcnt (CDR (ASSOC 40 text_def))) o)
		    ) ;_ end of and
		  (PROGN
		    (SETQ splitcnt begcnt)
		    (WHILE
		      (OR
			(/= (SUBSTR (CADR n) splitcnt 1) " ")
			(< (* splitcnt (CDR (ASSOC 40 text_def))) o)
		      ) ;_ end of OR
		       (SETQ splitcnt (1+ splitcnt))
		    ) ;_ end of while
		    (SETQ endcnt splitcnt
			  colcnt endcnt
		    ) ;_ end of SETQ
;;;		    (PRINC "\nThis word spans columns! ")
;;;		    (PRINC "\n(* begcnt (CDR (ASSOC 40 text_def))) = ")
;;;		    (princ (* begcnt (CDR (ASSOC 40 text_def))))
;;;		    (PRINC "\n(* endcnt (CDR (ASSOC 40 text_def))) = ")
;;;		    (princ (* endcnt (CDR (ASSOC 40 text_def))))
		  ) ;_ end of PROGN
		) ;_ end of if
	      ) ;_ end of foreach
;;;	      (PRINC "\nword = ")
;;;	      (PRINC (SUBSTR (CADR n) begcnt (- endcnt begcnt)))
;;;	      (PRINC)
	      (SETQ word_txt  (SUBSTR (CADR n) begcnt (- endcnt begcnt))
		    word_as10 (LIST (+ (CAAR n) (* (1- begcnt) (CDR (ASSOC 40 text_def)))) (CADAR n) 0)
	      ) ;_ end of SETQ
	      (SETQ word_def
		     (LIST
		       (CONS 0 "text")
		       (ASSOC 6 text_def)
		       (ASSOC 7 text_def)
		       (ASSOC 8 text_def)
		       (CONS 10 word_as10)
		       (CONS 1 word_txt)
		       (ASSOC 40 text_def)
		       (ASSOC 62 text_def)
		     ) ;_ end of list
	      ) ;_ end of SETQ
	      (ENTMAKE word_def)
	      (IF (MEMBER begcnt beg_stops)
		nil
		(SETQ beg_stops (APPEND beg_stops (LIST begcnt)))
	      ) ;_ end of IF
	    ) ;_ end of progn
	  ) ;_ end of IF
	  (SETQ begcnt nil)
	) ;_ end of progn
      ) ;_ end of IF
      (SETQ colcnt (1+ colcnt))
      (if do_spin
        (wait_spin)
      )
    ) ;_ end of WHILE
    (SETQ word_def nil)
    (SETQ word_lst nil)
  ) ;_ end of foreach
;;;  (PRINC "\n(CDR (ASSOC 2 (NTH 0 head_it))) = ")
;;;  (PRINC (CDR (ASSOC 2 (NTH 0 head_it))))
;;;  (PRINC)
  (PRINC "\010")
  (princ)
  (COND
    ((EQ "HEAD1" (CDR (ASSOC 2 (NTH 0 head_it))))
     (SETQ rjst1_ss
	    (SSGET "CP"
		   (LIST
		     (LIST (+ xorigin (NTH 4 xpt_lst)) (+ (* -2.0 (CDR (ASSOC 40 text_def))) yorigin))
		     (LIST (+ xorigin (NTH 4 xpt_lst) (* -3 (CDR (ASSOC 40 text_def))))
			   (+ (* -3.0 (CDR (ASSOC 40 text_def))) yorigin)
		     ) ;_ end of list
		     (LIST (+ xorigin (NTH 4 xpt_lst) (* -3 (CDR (ASSOC 40 text_def)))) txt_miny)
		     (LIST (+ xorigin (NTH 4 xpt_lst)) txt_miny)
		   ) ;_ end of LIST
		   '((0 . "TEXT"))
	    ) ;_ end of ssget
     ) ;_ end of SETQ
     (SETQ rjst2_ss
	    (SSGET "CP"
		   (LIST
		     (LIST (+ xorigin (LAST xpt_lst)) (+ (* -2.0 (CDR (ASSOC 40 text_def))) yorigin))
		     (LIST (+ xorigin (LAST xpt_lst) (* -3 (CDR (ASSOC 40 text_def))))
			   (+ (* -3.0 (CDR (ASSOC 40 text_def))) yorigin)
		     ) ;_ end of list
		     (LIST (+ xorigin (LAST xpt_lst) (* -3 (CDR (ASSOC 40 text_def)))) txt_miny)
		     (LIST (+ xorigin (LAST xpt_lst)) txt_miny)
		   ) ;_ end of LIST
		   '((0 . "TEXT"))
	    ) ;_ end of ssget
     ) ;_ end of SETQ
     (IF rjst1_ss
       (PROGN
	 (SETQ rjst_ent	(ENTGET (SSNAME rjst1_ss 0))
;;;	       rjst_font (assoc 7 rjst_ent)
	       rjst_ent (subst (cons 7 "TBLFIX_MONO")(assoc 7 rjst_ent)rjst_ent)
	       rjst_pt (LIST (+ (CADR (ASSOC 10 rjst_ent)) (CAADR (TEXTBOX rjst_ent)))
			     (CADDR (ASSOC 10 rjst_ent))
			     0
		       ) ;_ end of LIST
	 ) ;_ end of setq
         (txtj rjst1_ss)
       ) ;_ end of PROGN
     ) ;_ end of IF
     (IF rjst2_ss
       (PROGN
	 (SETQ rjst_ent	(ENTGET (SSNAME rjst2_ss 0))
	       rjst_ent (subst (cons 7 "TBLFIX_MONO")(assoc 7 rjst_ent)rjst_ent)
	       rjst_pt (LIST (+ (CADR (ASSOC 10 rjst_ent)) (CAADR (TEXTBOX rjst_ent)))
			     (CADDR (ASSOC 10 rjst_ent))
			     0
		       ) ;_ end of LIST
	 ) ;_ end of setq
         (txtj rjst2_ss)
       ) ;_ end of PROGN
     ) ;_ end of IF
    )
    ((EQ "HEAD2" (CDR (ASSOC 2 (NTH 0 head_it))))
     (SETQ rjst1_ss
	    (SSGET "CP"
		   (LIST
		     (LIST (+ xorigin (NTH 5 xpt_lst)) yorigin)
		     (LIST (+ xorigin (NTH 5 xpt_lst) (* -3 (CDR (ASSOC 40 text_def)))) yorigin)
		     (LIST (+ xorigin (NTH 5 xpt_lst) (* -3 (CDR (ASSOC 40 text_def)))) txt_miny)
		     (LIST (+ xorigin (NTH 5 xpt_lst)) txt_miny)
		   ) ;_ end of LIST
		   '((0 . "TEXT"))
	    ) ;_ end of ssget
     ) ;_ end of SETQ
     (SETQ rjst2_ss
	    (SSGET "CP"
		   (LIST
		     (LIST (+ xorigin (NTH 8 xpt_lst)) yorigin)
		     (LIST (+ xorigin (NTH 8 xpt_lst) (* -3 (CDR (ASSOC 40 text_def)))) yorigin)
		     (LIST (+ xorigin (NTH 8 xpt_lst) (* -3 (CDR (ASSOC 40 text_def)))) txt_miny)
		     (LIST (+ xorigin (NTH 8 xpt_lst)) txt_miny)
		   ) ;_ end of LIST
		   '((0 . "TEXT"))
	    ) ;_ end of ssget
     ) ;_ end of SETQ
     (IF rjst1_ss
       (PROGN
	 (SETQ rjst_ent	(ENTGET (SSNAME rjst1_ss 0))
	       rjst_pt (LIST (+ (CADR (ASSOC 10 rjst_ent)) (CAADR (TEXTBOX rjst_ent)))
			     (CADDR (ASSOC 10 rjst_ent))
			     0
		       ) ;_ end of LIST
	 ) ;_ end of setq
         (txtj rjst1_ss)
       ) ;_ end of PROGN
     ) ;_ end of IF
     (IF rjst2_ss
       (PROGN
	 (SETQ rjst_ent	(ENTGET (SSNAME rjst2_ss 0))
	       rjst_pt (LIST (+ (CADR (ASSOC 10 rjst_ent)) (CAADR (TEXTBOX rjst_ent)))
			     (CADDR (ASSOC 10 rjst_ent))
			     0
		       ) ;_ end of LIST
	 ) ;_ end of setq
         (txtj rjst2_ss)
       ) ;_ end of PROGN
     ) ;_ end of IF
    )
    ((EQ "HEAD3" (CDR (ASSOC 2 (NTH 0 head_it))))
     (SETQ rjst1_ss
	    (SSGET "CP"
		   (LIST
		     (LIST (+ xorigin (NTH 2 xpt_lst)) yorigin)
		     (LIST (+ xorigin (NTH 2 xpt_lst) (* -3 (CDR (ASSOC 40 text_def)))) yorigin)
		     (LIST (+ xorigin (NTH 2 xpt_lst) (* -3 (CDR (ASSOC 40 text_def)))) txt_miny)
		     (LIST (+ xorigin (NTH 2 xpt_lst)) txt_miny)
		   ) ;_ end of LIST
		   '((0 . "TEXT"))
	    ) ;_ end of ssget
     ) ;_ end of SETQ
     (SETQ rjst2_ss
	    (SSGET "CP"
		   (LIST
		     (LIST (+ xorigin (NTH 4 xpt_lst)) yorigin)
		     (LIST (+ xorigin (NTH 4 xpt_lst) (* -3 (CDR (ASSOC 40 text_def)))) yorigin)
		     (LIST (+ xorigin (NTH 4 xpt_lst) (* -3 (CDR (ASSOC 40 text_def)))) txt_miny)
		     (LIST (+ xorigin (NTH 4 xpt_lst)) txt_miny)
		   ) ;_ end of LIST
		   '((0 . "TEXT"))
	    ) ;_ end of ssget
     ) ;_ end of SETQ
     (SETQ rjst3_ss
	    (SSGET "CP"
		   (LIST
		     (LIST (+ xorigin (LAST xpt_lst)) yorigin)
		     (LIST (+ xorigin (LAST xpt_lst) (* -3 (CDR (ASSOC 40 text_def)))) yorigin)
		     (LIST (+ xorigin (LAST xpt_lst) (* -3 (CDR (ASSOC 40 text_def)))) txt_miny)
		     (LIST (+ xorigin (LAST xpt_lst)) txt_miny)
		   ) ;_ end of LIST
		   '((0 . "TEXT"))
	    ) ;_ end of ssget
     ) ;_ end of SETQ
     (IF rjst1_ss
       (PROGN
	 (SETQ rjst_ent	(ENTGET (SSNAME rjst1_ss 0))
	       rjst_pt (LIST (+ (CADR (ASSOC 10 rjst_ent)) (CAADR (TEXTBOX rjst_ent)))
			     (CADDR (ASSOC 10 rjst_ent))
			     0
		       ) ;_ end of LIST
	 ) ;_ end of setq
         (txtj rjst1_ss)
       ) ;_ end of PROGN
     ) ;_ end of IF
     (IF rjst2_ss
       (PROGN
	 (SETQ rjst_ent	(ENTGET (SSNAME rjst2_ss 0))
	       rjst_pt (LIST (+ (CADR (ASSOC 10 rjst_ent)) (CAADR (TEXTBOX rjst_ent)))
			     (CADDR (ASSOC 10 rjst_ent))
			     0
		       ) ;_ end of LIST
	 ) ;_ end of setq
         (txtj rjst2_ss)
       ) ;_ end of PROGN
     ) ;_ end of IF
     (IF rjst3_ss
       (PROGN
	 (SETQ rjst_ent	(ENTGET (SSNAME rjst3_ss 0))
	       rjst_pt (LIST (+ (CADR (ASSOC 10 rjst_ent)) (CAADR (TEXTBOX rjst_ent)))
			     (CADDR (ASSOC 10 rjst_ent))
			     0
		       ) ;_ end of LIST
	 ) ;_ end of setq
         (txtj rjst3_ss)
       ) ;_ end of PROGN
     ) ;_ end of IF
    )
  ) ;_ end of COND
;;;  (PRINC "\nt_stops = ")
;;;  (PRINC xpt_lst)
;;;  (PRINC (MAPCAR '(LAMBDA (x) (+ x (CADR (ASSOC 10 (NTH 0 head_it))))) xpt_lst))
  (PRINC)
) ;_ end of defun
(DEFUN txtj (jst_ss / tsln cntr edtw tj11 tj72 tj73 tent enty entz)
  (IF jst_ss
    (PROGN
      (SETQ tsln (SSLENGTH jst_ss)
	    cntr 0
	    tj72 2
	    tj73 0
	    tj11x (CAR rjst_pt)
      )			      ;setq
      (WHILE
	(IF (AND (< cntr tsln) jst_ss)
	  (SETQ tent (ENTGET (SSNAME jst_ss cntr)))
	)		      ;if
	 (SETQ edtw  (ENTGET (CDAR tent))
	       ent10 (ASSOC 10 edtw)
	       ent72 (ASSOC 72 edtw)
	       ent73 (ASSOC 73 edtw)
	       tj11y (CADDR ent10)
	       tj11z (CADDDR ent10)
	 )		      ;setq
	 (IF ent11
	   (SETQ edtw (SUBST (CONS 11 (LIST tj11x tj11y tj11z))(ASSOC 11 edtw) edtw))
	   (SETQ edtw (APPEND edtw (LIST (CONS 11 (LIST tj11x tj11y tj11z)))))
	 ) ;_ end of IF
	 (IF ent72
	   (SETQ edtw (SUBST (CONS 72 tj72) (ASSOC 72 edtw) edtw))
	   (SETQ edtw (APPEND edtw (LIST (CONS 72 tj72))))
	 ) ;_ end of IF
	 (IF ent73
	   (SETQ edtw (SUBST (CONS 73 tj73) (ASSOC 73 edtw) edtw))
	   (SETQ edtw (APPEND edtw (LIST (CONS 73 tj73))))
	 ) ;_ end of IF
	 (ENTMOD edtw)
	 (SETQ cntr (1+ cntr))
      ) ;_ end of while
    ) ;_ end of PROGN
  ) ;_ end of IF
  (PRINC)
)			      ;defun
(DEFUN wait_spin ()
  (COND ((AND (EQ waitic "|") (EQ ticsid 1)) (SETQ waitic "/"))
        ((EQ waitic "/")
         (SETQ waitic "-"
               ticsid 2
         ) ;_ end of SETQ
        )
        ((EQ waitic "-") (SETQ waitic "|"))
        ((AND (EQ waitic "|") (EQ ticsid 2)) (SETQ waitic "\\"))
        ((EQ waitic "\\")
         (SETQ waitic "|"
               ticsid 1
         ) ;_ end of SETQ
        )
        ((NOT waitic)
         (SETQ waitic "|"
               ticsid 1
         ) ;_ end of SETQ
        )
  ) ;_ end of COND
  (PRINC (STRCAT "\010" waitic))
  (PRINC)
) ;_ end of DEFUN
(DEFUN c:spinit ()
  (if do_spin
    (progn
      (setq do_spin nil)
      (princ "\nSpinner toggled OFF. ")
      (princ)
    )
    (progn
      (setq do_spin T)
      (princ "\nSpinner toggled ON. ")
      (princ)
    )
  )
  (princ)
)
(defun tblfix_sty ()
  (SETQ tblstyle (TBLNEXT "style" T))
  (WHILE tblstyle
    (IF style_list
      (SETQ style_list                  ;build complete list of styles and fonts used
             (APPEND style_list
                     (LIST (LIST (CDR (ASSOC 2 tblstyle))
                                 (CDR (ASSOC 3 tblstyle))
                           ) ;_ end of list
                     ) ;_ end of list
             ) ;_ end of append
      ) ;_ end of setq
      (SETQ style_list                  ;Initiate list of styles and fonts used
             (LIST (LIST (CDR (ASSOC 2 tblstyle))
                         (CDR (ASSOC 3 tblstyle))
                   ) ;_ end of list
             ) ;_ end of list
      ) ;_ end of setq
    ) ;_ end of IF
    (IF (EQ (STRCASE (CDR (ASSOC 2 tblstyle))) "TBLFIX_MONO")
      (SETQ tblfix_mono_exst T)              ;check style and tell if romans exists
    ) ;_ end of if
    (SETQ tblstyle (TBLNEXT "style"))
  ) ;_ end of while
  (IF tblfix_mono_exst                       ;verify/set correct RomanS style height = 0
    (IF (/= (CDR (ASSOC 3 (ENTGET (TBLOBJNAME "style" "TBLFIX_MONO"))))
            "monotxt.shx"
        ) ;_ end of /=
      (PROGN
        (SETQ nstyled
               (SUBST
                 (CONS 3 "monotxt.shx")
                 (ASSOC 3 (ENTGET (TBLOBJNAME "style" "TBLFIX_MONO")))
                 (ENTGET (TBLOBJNAME "style" "TBLFIX_MONO"))
               ) ;_ end of subst
        ) ;_ end of setq
        (ENTMOD nstyled)
      ) ;_ end of progn
    ) ;_ end of if
    (ENTMAKE (LIST (CONS 0 "style")     ;or create the RomanS style
                   (CONS 100 "AcDbSymbolTableRecord")
                   (CONS 100 "AcDbTextStyleTableRecord")
                   (CONS 2 "TBLFIX_MONO")
                   (CONS 70 0)
                   (CONS 40 0.0)
                   (CONS 41 1.0)
                   (CONS 50 0.0)
                   (CONS 71 0)
                   (CONS 42 0.1)        ;'last height used' might set this to 0.0875 * (a:scle)
                   (CONS 3 "monotxt.shx")
                   (CONS 4 "")
             ) ;_ end of list
    ) ;_ end of entmake
  ) ;_ end of if
)

(princ)
;|«Visual LISP© Format Options»
(100 2 30 2 T "end of " 100 9 2 1 1 T T nil T)
;*** DO NOT add text below the comment! ***|;