;;;"Glue" text strings.  All adopt first's properties.
;;;
;;;>	Author:	Henry C. Francis
;;;>		425 N. Ashe St.
;;;>		Southern Pines, NC 28387
;;;>		http://paracadd.com
;;;>		All rights reserved.
;;;
;;;>		COPYRIGHT: 12/15/2004
;;;>		   EDITED: 08-23-2005
;;;
(defun c:gstr (/	      gstr_ename     gstr_ent1
	       gstr_ent2      gstr_old1	     gstr_oldsl
	       gstr_old10     gstr_old11     gstr_old40
	       gstr_old50     gstr_newstr    gstr_newsl
	       gstr_new1      gstr_new10     gstr_new11
	      )
  (IF dimscl
    NIL
    (LOAD "dimscl" "\nFile DIMSCL.LSP not loaded! ")
  ) ;_ end of IF
  (dimscl)
  (while
    (and
      (setq gstrselent (entsel "\nSelect first text string to join: "))
      (eq(type (cadr gstrselent))'LIST)
      (eq(type (car gstrselent))'ENAME)
      (eq(cdr(assoc 0(entget(car gstrselent))))"TEXT")
    )
     (setq gstr_tspt (cadr gstrselent))
     (setq scrnsz     (getvar "screensize")
;;;	   viewsz (getvar "viewsize")
;;;	   pboxsz (* (/ viewsz (cadr scrnsz)) 2 (getvar "pickbox"))
	   pbdiag     (* 1.41421
			 (* 0.000001 (getvar "pickbox") dimsc (cadr scrnsz))
			 (getvar "pickbox")
		      ) ;_ end of *
;;;	   pbdiag (* 1.41421 (/ viewsz (cadr scrnsz)) (getvar "pickbox"))
	   gstr_tspt1 (polar gstr_tspt (* 1.25 pi) pbdiag)
	   gstr_tspt2 (polar gstr_tspt (* 0.25 pi) pbdiag)
     ) ;_ end of setq
     (setq gstr_tss (ssget "C" gstr_tspt1 gstr_tspt2 '((0 . "TEXT"))))
     (if gstr_tss
       (progn
     (setq gstr_ent1 (entget (ssname gstr_tss 0)))
     (setq gstr_new1 (cdr (assoc 1 gstr_ent1)))
     (while (and (wcmatch gstr_new1 " *")
		 (eq (substr gstr_new1 (1- (strlen gstr_new1)) 1) " ")
	    ) ;_ end of and
       (setq gstr_new1 (substr gstr_new1 1 (1- (strlen gstr_new1))))
     ) ;_ end of while
     (redraw (cdr (assoc -1 gstr_ent1)) 3)
     (princ "\nSelect text to join: ")
     (while
       (not
	 (and
	   (setq gstr_tss (ssget '((0 . "TEXT"))))
	   (>= (sslength gstr_tss) 1)
	 ) ;_ end of and
       ) ;_ end of not
	(princ "\nERROR! No TEXT selected. Select text to join: ")
     ) ;_ end of while
     (setq join_cnt 0)
     (while (< join_cnt (sslength gstr_tss))
       (setq gstr_entdef (entget (ssname gstr_tss join_cnt)))
       (if (eq (cdr (assoc -1 gstr_entdef)) (cdr (assoc -1 gstr_ent1)))
	 nil
	 (progn
	   (setq new2 (cdr (assoc 1 gstr_entdef)))
	   (while (eq (substr new2 1 1) " ")
	     (setq new2 (substr new2 2))
	   ) ;_ end of while
	   (setq gstr_new1 (strcat gstr_new1 " " new2))
	 ) ;_ end of progn
       ) ;_ end of if
       (setq join_cnt (1+ join_cnt))
     ) ;_ end of while
     (setq gstr_ent1
	    (subst (cons 1 gstr_new1) (assoc 1 gstr_ent1) gstr_ent1)
     ) ;_ end of setq
     (if (entmod gstr_ent1)
       (progn
	 (setq del_cnt 0)
	 (while	(< del_cnt (sslength gstr_tss))
	   (if (/= (cdr (assoc -1 gstr_ent1)) (ssname gstr_tss del_cnt))
	     (entdel (ssname gstr_tss del_cnt))
	   ) ;_ end of if
	   (setq del_cnt (1+ del_cnt))
	 ) ;_ end of while
       ) ;_ end of progn
       (princ "\nERROR! Unable to join selected text! ")
     ) ;_ end of if
     )
       )
  ) ;_ end of while
  (princ)
) ;_ end of defun
(defun c:rgstr (/	       gstr_ename     gstr_ent1
		gstr_ent2      gstr_old1      gstr_oldsl
		gstr_old10     gstr_old11     gstr_old40
		gstr_old50     gstr_newstr    gstr_newsl
		gstr_new1      gstr_new10     gstr_new11
	       )
  (while
    (setq gstr_ename1
	   (car (entsel "\nSelect first text string to join: "))
    ) ;_ end of setq
     (while
       (not
	 (and
	   (setq gstr_ent1 (entget gstr_ename1))
	   (eq (cdr (assoc 0 gstr_ent1)) "TEXT")
	 ) ;_ end of and
       ) ;_ end of not
     ) ;_ end of while
     (setq gstr_old1 (cdr (assoc 1 gstr_ent1)))
     (while
       (not
	 (and
	   (setq gstr_ename2
		  (car (entsel "\nSelect second text string to join: ")
		  ) ;_ end of car
	   ) ;_ end of setq
	   (setq gstr_ent2 (entget gstr_ename2))
	   (eq (cdr (assoc 0 gstr_ent2)) "TEXT")
	   (not (eq gstr_ename1 gstr_ename2))
	 ) ;_ end of and
       ) ;_ end of not
     ) ;_ end of while
     (setq gstr_old2 (cdr (assoc 1 gstr_ent2)))
     (setq gstr_new1 (strcat gstr_old2 " " gstr_old1)
	   gstr_ent1
		     (subst (cons 1 gstr_new1)
			    (assoc 1 gstr_ent1)
			    gstr_ent1
		     ) ;_ end of subst
     ) ;_ end of setq
     (entmod gstr_ent1)
     (entdel gstr_ename2)
  ) ;_ end of while
  (princ)
) ;_ end of defun

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