;;;Break a text string into two strings and automatically.
;;;Places the 'cut' string above or below the first at the same
;;;justification, etc. with 1/2 text height space between.
;;;Optionally: Adds a line of text above or below existing text.
;;;
;;;
;;;              
;;;
;;;>	Author:	Henry C. Francis
;;;>		425 N. Ashe St.
;;;>		Southern Pines, NC 28387
;;;>		http://paracadd.com
;;;>		All rights reserved.
;;;
;;;>		COPYRIGHT: 1995
;;;>		   EDITED: 09-30-2005
;;;
(defun c:bstr (/ ename ent1 ent2 oldsl old10 old11 old40 old50 newsl
	       new10 new11 tss)
  (if dimscl
    nil
    (load "dimscl")
  ) ;_ end of if
  (dimscl)
  (if ukword
    NIL
    (load "ukword" "\nFile UKWORD.LSP not loaded! ")
  ) ;_ end of IF
  (if ustr
    NIL
    (load "ustr" "\nFile USTR.LSP not loaded! ")
  ) ;_ end of IF
  (setq	bstr_func
	 (ukword
	   1
	   "BReak Above BElow Symbol"
	   "<BR>eak existing text, add line <A>bove, add line <BE>low, or <S>ymbol?"
	   (if bstr_func
	     bstr_func
	     "BReak"
	   ) ;_ end of if
	 ) ;_ end of ukword
  ) ;_ end of setq
  (if (not bstr_func)
    (setq bstr_func "BReak")
  ) ;_ end of if
  (cond
    ((eq bstr_func "BReak")
     (setq add_leading_word  nil
	   add_trailing_word nil
	   symbolize_it	     nil
	   bstr_func_msg     "\nSelect Text to Break: "
     ) ;_ end of setq
    )
    ((eq bstr_func "Above")
     (setq add_leading_word  t
	   add_trailing_word nil
	   symbolize_it	     nil
	   bstr_func_msg     "\nSelect Text to add line above: "
     ) ;_ end of setq
    )
    ((eq bstr_func "BElow")
     (setq add_leading_word  nil
	   add_trailing_word t
	   symbolize_it	     nil
	   bstr_func_msg     "\nSelect Text to add line below: "
     ) ;_ end of setq
    )
    ((eq bstr_func "Symbol")
     (setq add_leading_word  nil
	   add_trailing_word nil
	   symbolize_it	     t
	   bstr_func_msg     "\nSelect Text to break into symbol form: "
     ) ;_ end of setq
    )
  ) ;_ end of cond

  (while
    (setq tspt (cadr (entsel bstr_func_msg)))
;;;     (if (and (setq CURVNO (getvar "cvport"))
;;;	      (> CURVNO 1)
;;;	      (eq (getvar "tilemode") 0)
;;;	 ) ;_ end of and
;;;       (progn
;;;	 (command ".pspace")
;;;	 (setq scrnsz	(getvar "screensize")
;;;	       psviewsz	(getvar "viewsize")
;;;	 ) ;_ end of setq
;;;	 (command ".mspace")
;;;	 (setq msviewsz (getvar "viewsize"))
;;;	 (setq viewsz (* (/ psviewsz 8.0) msviewsz))
;;;       ) ;_ end of progn
;;;       (progn
;;;	 (setq scrnsz (getvar "screensize")
;;;	       viewsz (getvar "viewsize")
;;;	 ) ;_ end of setq
;;;       ) ;_ end of progn
;;;     ) ;_ end of if
;;;if read while in PSPACE this sets the polar distance between corner points of the pickbox in MSPACE
;;;     (if (and (setq CURVNO (getvar "cvport"))
;;;	      (> CURVNO 1)
;;;	      (eq (getvar "tilemode") 0)
;;;	 ) ;_ end of and
;;;       (progn
;;;	 (command ".pspace")
;;;         (setq pboxsz (*(/(GETVAR"PICKBOX")(CADR(GETVAR"SCREENSIZE")))(GETVAR"VIEWSIZE")1.5(GETVAR"ZOOMFACTOR")))
;;;	 (command ".mspace")
;;;       )
     (setq
       pboxsz (* (/ (getvar "PICKBOX") (cadr (getvar "SCREENSIZE")))
		 (getvar "VIEWSIZE")
	      ) ;_ end of *
     ) ;_ end of setq
;;;     )
     (setq dvwtwst (getvar "viewtwist"))
     (setq tspt1  (polar tspt
			 (- (* 1.25 pi) dvwtwst)
			 (* (sin (* 0.25 pi)) pboxsz 2.0)
		  ) ;_ end of polar
	   tspt1a (polar tspt1 (- 0 dvwtwst) (* 2.0 pboxsz))
	   tspt2  (polar tspt
			 (- (* 0.25 pi) dvwtwst)
			 (* (sin (* 0.25 pi)) pboxsz 2.0)
		  ) ;_ end of polar
	   tspt2a (polar tspt2 (- 0 dvwtwst pi) (* 2.0 pboxsz))
     ) ;_ end of setq
;;;     (command "PLINE"
;;;	      TSTPT1
;;;	      (list (car TSTPT2) (cadr TSTPT1))
;;;	      TSTPT2
;;;	      (list (car TSTPT1) (cadr TSTPT2))
;;;     ) ;_ end of COMMAND
;;;    (princ "\n\n		scrnsz=	")
;;;    (PRINC scrnsz)
;;;    (princ "\n\n		viewsz=	")
;;;    (PRINC viewsz)
;;;    (princ "\n\n		dvwtwst=	")
;;;    (PRINC dvwtwst)
;;;    (princ "\n\n		pboxsz=	")
;;;    (PRINC pboxsz)
;;;    (princ (strcat "\n\n		tspt1=	(POLAR tspt1 (-(* 1.25 PI) " (RTOS DVWTWST 2 4) ") (*(SIN(* 0.25 PI)) " (RTOS PBOXSZ 2 4) " 2.0))"))
;;;    (princ (strcat "\n\n		tspt1a=	(POLAR tspt (- 0 " (RTOS DVWTWST 2 4) ") (* 2.0 " (RTOS PBOXSZ 2 4) "))"))
;;;    (PRINC)
;;;    (COMMAND "PLINE" TSPT1 TSPT1A TSPT2 TSPT2A "C"); tests CP pick points for match w/ pickbox at mult. zoom MS/PS combos
     (setq tss (ssget "CP"
		      (list tspt1 tspt1a tspt2 tspt2a tspt1)
		      '((0 . "TEXT"))
	       ) ;_ end of ssget
     ) ;_ end of setq
     (if tss
       (progn
	 (setq ename  (ssname tss 0)
	       ent1   (entget ename)
	       old1   (cdr (assoc 1 ent1))
	       oldsl  (strlen old1)
	       old10  (cdr (assoc 10 ent1))
	       old11  (cdr (assoc 11 ent1))
	       old40d (cond
			(symbolize_it
			 (* (cdr (assoc 40 ent1)) 0.25)
					;spacing 0.5 x height
			)
			(t
			 (* (cdr (assoc 40 ent1)) 1.5)
					;spacing 1.5 x height
			)
		      ) ;_ end of cond
	       old50d (- (cdr (assoc 50 ent1)) (* pi 0.5))
	       old50a (cdr (assoc 50 ent1))
	 ) ;_ end of setq
	 (cond
	   (add_leading_word
	    (setq leading_word
		   (ustr 0
			 "New text to place above selection?"
			 (if leading_word
			   leading_word
			   ""
			 ) ;_ end of if
			 t
		   ) ;_ end of ustr
	    ) ;_ end of setq
	    (setq newstr old1
		  newsl	 oldsl
		  old1	 (strcat leading_word " " old1)
		  oldsl	 (strlen old1)
	    ) ;_ end of setq
	   )
	   (add_trailing_word
	    (setq trailing_word
		   (ustr 0
			 "New text to place below selection?"
			 (if trailing_word
			   trailing_word
			   ""
			 ) ;_ end of if
			 t
		   ) ;_ end of ustr
	    ) ;_ end of setq
	    (setq newstr old1
		  newsl	 oldsl
		  old1	 (strcat old1 " " trailing_word)
		  oldsl	 (strlen old1)
	    ) ;_ end of setq
	   )
	   (symbolize_it
	    (setq leading_word (substr old1 1 1)
		  newstr       (substr old1 2)
		  newsl	       oldsl
		  old1	       (strcat leading_word " " newstr)
		  oldsl	       (strlen old1)
	    ) ;_ end of setq
	   )
	   (t
	    (princ
	      "\nDelete text to form new line including all leading or trailing spaces. "
	    ) ;_ end of princ
	    (command ".ddedit" ename "")
	    (setq ent1	 (entget ename)
		  newstr (cdr (assoc 1 ent1))
		  newsl	 (strlen newstr)
	    ) ;_ end of setq
	   )
	 ) ;_ end of cond
	 (if (or
	       (> (strlen newstr) (strlen old1))
	       (and
		 (not (wcmatch old1 (strcat newstr "*")))
		 (not (wcmatch old1 (strcat "*" newstr)))
		 (not (wcmatch old1 "*`#*"))
		 (not (wcmatch old1 "*`@*"))
		 (not (wcmatch old1 "*`.*"))
		 (not (wcmatch old1 "*`**"))
		 (not (wcmatch old1 "*`?*"))
		 (not (wcmatch old1 "*`~*"))
		 (not (wcmatch old1 "*`,*"))
		 (not forceit)
	       ) ;_ end of and
	     ) ;_ end of or
	   (progn
;;;	     (princ "\nlen newstr = ")
;;;	     (princ (strlen newstr))
;;;	     (princ "\nlen old1 = ")
;;;	     (princ (strlen old1))
;;;	     (princ "\nnewstr = ")
;;;	     (princ newstr)
;;;	     (princ "\nold1 = ")
;;;	     (princ old1)
	     (while (wcmatch old1 "* ")
	       (setq old1 (substr old1 1 (1- (strlen old1))))
	     ) ;_ end of WHILE
	     (while (wcmatch old1 " *")
	       (setq old1 (substr old1 2))
	     ) ;_ end of WHILE
	     (setq ent1
		    (subst (cons 1 old1)
			   (assoc 1 ent1)
			   ent1
		    ) ;_ end of subst
	     ) ;_ end of setq
	     (entmod ent1)
	     (princ
	       "\nError: Use DDEDIT to add/remove text.  Please try BSTR again. "
	     ) ;_ end of princ
	     (setq ask_forceit
		    (ukword 1
			    "Yes No"
			    "Do you want to force it? <Yes or No>"
			    ask_forceit
		    ) ;_ end of ukword
	     ) ;_ end of setq
	   ) ;_ end of progn
	   (progn
	     (if (eq newstr (substr old1 1 (strlen newstr)))
	       (if (/= (substr old1 (1+ newsl) 1) " ")
		 (setq new2 (substr old1 (+ newsl 1)))
		 (setq new2 (substr old1 (+ newsl 2)))
	       ) ;_ end of if
	       (if (/= (substr old1 newsl 1) " ")
		 (setq new2 (substr old1 1 (- oldsl newsl)))
		 (setq new2 (substr old1 1 (- oldsl newsl 1)))
	       ) ;_ end of if
	     ) ;_ end of if
	     (if (wcmatch (strcase old1) "%%U*")
	       (setq new2 (strcat "%%U" new2))
	     ) ;_ end of IF
	   ) ;_ end of PROGN
	 ) ;_ end of if
	 (if (eq newstr (substr old1 1 (strlen newstr)))
	   (setq new10 (polar old10 old50d old40d)
		 new11 (polar old11 old50d old40d)
	   ) ;_ end of setq
	   (setq new10 (polar old10 (+ old50d pi) old40d)
		 new11 (polar old11 (+ old50d pi) old40d)
	   ) ;_ end of setq
	 ) ;_ end of if
	 (while	(wcmatch new2 "* ")
	   (setq new2 (substr new2 1 (1- (strlen new2))))
	 ) ;_ end of WHILE
	 (while	(wcmatch new2 " *")
	   (setq new2 (substr new2 2))
	 ) ;_ end of WHILE
	 (if symbolize_it
	   (progn
	     (setq ent1
			(subst (cons 10 (polar old10 old50a (* 1.5 old40d)))
			       (assoc 10 ent1)
			       ent1
			) ;_ end of subst
		   ent1
			(subst (cons 11 (polar old11 old50a (* 1.5 old40d)))
			       (assoc 11 ent1)
			       ent1
			) ;_ end of subst
		   ent1
			(subst (cons 1 newstr) (assoc 1 ent1) ent1)
	     ) ;_ end of setq
	     (entmod ent1)
	   ) ;_ end of progn
	 ) ;_ end of if
	 (setq ent2 (cdr ent1)
	       ent2
		    (subst (cons 10 new10)
			   (assoc 10 ent2)
			   ent2
		    ) ;_ end of subst
	       ent2
		    (subst (cons 11 new11)
			   (assoc 11 ent2)
			   ent2
		    ) ;_ end of subst
	       ent2
		    (subst (cons 1 new2)
			   (assoc 1 ent2)
			   ent2
		    ) ;_ end of subst
	 ) ;_ end of setq
	 (if
	   (and
	     (not (wcmatch old1 (strcat newstr "*")))
	     (not (wcmatch old1 (strcat "*" newstr)))
	     (not (wcmatch old1 "*`#*"))
	     (not (wcmatch old1 "*`@*"))
	     (not (wcmatch old1 "*`.*"))
	     (not (wcmatch old1 "*`**"))
	     (not (wcmatch old1 "*`?*"))
	     (not (wcmatch old1 "*`~*"))
	     (not (wcmatch old1 "*`,*"))
	     (not forceit)
	   ) ;_ end of and
	    (princ)
	    (entmake ent2)
	 ) ;_ end of if
	 (if (eq ask_forceit "Yes")
	   (setq forceit t
		 ask_forceit
		  nil
	   ) ;_ end of setq
	   (setq forceit nil)
	 ) ;_ end of if
       ) ;_ end of PROGN
     ) ;_ end of IF
  ) ;_ end of while
  (princ)
) ;_ end of defun

;|«Visual LISP© Format Options» (72 2 40 2 T "end of " 60 9 1 0 0 T T nil T)
 ***Don't add text below the comment!***|;