Lazy Typist Text Edit:<Mid Sentence Edit>

This is a strange request from a co-worker:

Say you have a text "15 LF OF 2"X6" HORIZONTAL SUPPORT"

and another text "20 LF OF 2"X10" HORIZONTAL AND VERTICAL SUPPORT",

if you want to copy the words "AND VERTICAL" onto the mid-sentence of the first text

to get "15 LF OF 2"X6" HORIZONTAL AND VERTICAL SUPPORT", how would go about doing it?

Double click, cut and paste?

_find?

what if

1st text "10 20 30 60 70"

2nd text "40 80 100 60 50 30"

grab "40" and "50" from the 2nd text to get "10 20 30 40 50 60 70"

or you use this:

(defun c:MidSentence (/ CDiaStr ListBoxDia CollectStr 
                     StringList StrListS a RepStr b fnSTR)
(defun CDiaStr  ()
      (setq StrDiaFnme (vl-filename-mktemp "tmp.DCL"))
      (setq fnSTR (open StrDiaFnme "a"))
      (write-line
            "dcl_settings : default_dcl_settings { audit_level = 3; }
 MidSentence : dialog 
 { label = \"\"; key= \"Taytol\";
 : list_box { key = \"StrListS\"; multiple_select =
 true; width = 20; height = 20; } spacer ;
 ok_cancel;
 }"  fnSTR)
             (close fnSTR) T
      )
;;;       List Box Dialog ;;;
(defun ListBoxDia (DiaName DiaKey Title Lst)
       (setq StrDIA (load_dialog StrDiaFnme))
 (if (not (new_dialog DiaName StrDIA))
  (exit)
    )
 (start_list DiaKey)
  (mapcar 'add_list Lst)
  (end_list)
       (set_tile "Taytol" Title)
 (action_tile DiaKey (vl-prin1-to-string
        (quote (set (setq dd (read DiaKey)) (get_tile $key)))))
 (action_tile "accept" "(done_dialog 1)")
   (action_tile "cancel" "(done_dialog 0)")
 (start_dialog)
   (unload_dialog StrDIA)
       (mapcar '(lambda (x)
                              (atoi (chr x)))
                       (vl-remove
                             32
                             (vl-string->list (eval (read DiaKey)))))
        )
;;;      Collect String from List ;;;
(defun CollectStr  (LstS LstC)
     (apply 'Strcat
            (mapcar '(lambda (y) (strcat (nth y LstC) " ")) LstS))
     )      
;;;  String To List  ;;;
(defun StringList (ent / Str i Lst)
 (setq Str (cdr (assoc 1 (entget  (ssname ent 0)))))
  (while
        (setq i (vl-string-search " " str))
          (setq Lst (cons (substr str 1 i) Lst))
          (setq str (substr str (+ 2 i)))
        )
  (reverse (cons str Lst)))
            (cond ((and
 (setq a (ssget "_+.:S:E:L" '((0 . "*TEXT"))))
               (setq StrList (StringList a))
 (CDiaStr)
       (Setq RepStr (CollectStr
                                  (ListBoxDia
                                        "MidSentence"
                                        "StrListS"
                                        "Select String to Follow"
                                        StrList)
                                  StrList))
               (setq b (ssget "_+.:S:E:L" '((0 . "*TEXT"))))
               (setq StrList (StringList b))
(vla-put-textstring
      (setq a (vlax-ename->vla-object (ssname a 0)))
      (vl-string-subst
            (strcat RepStr (CollectStr
                  (ListBoxDia
                        "MidSentence"
                        "StrListS"
                        "Select String to Insert"
                        StrList)
                  StrList))
            RepStr
            (vla-get-textstring a)))
               (vl-file-delete StrDiaFnme)
               ))
             )
)

Still need a lot of work , but its fun coding it

It funny code ^^ But i think Ctrl C and Ctrl V is faster, except text to grab discontinuous ^^ Thank you !

It'll be more effect if you choice 2 text and list box 2 text contents with listbox as the same time, the change can be show instantly

What about formatting?

It'll be more effect if you choice 2 text and list box 2 text contents with listbox as the same time, the change can be show instantly

Good suggestion .. and show the resulting string at the bottom in real time...

What about formatting?

Working on that too. i didnt really put too much time on this, I consider it to be what Lee Mac calls a novelty program . may be i can turn this into a fun game. (thats a thought)

thanks Alanjt

Here's the one I was working on (only wanted to be able replace the first word with another). It works, but I lost interest and abandoned the project. However, some of the coding might be of use...

(defun _breakup (s / foo l i d l1 l2)

 (defun foo (s / f n)
   (setq s (strcase s))
   (foreach x '("\\N" " " "\\P")
     (and (setq f (vl-string-search x s)) (setq n (cons (list f x) n)))
   )
   n
 )

 (while
   (setq i (caar (setq l (vl-sort (foo s) '(lambda (a b) (< (car a) (car b))))))
         d (cadar l)
   )
    (setq l1 (cons (substr s 1 i) l1)
          l2 (cons (substr s (1+ i) (strlen d)) l2)
          s  (substr s (+ i 1 (strlen d)))
    )
 )
 (if l2
   (mapcar 'reverse (list (cons s l1) l2))
   s
 )
)


(defun c:REPF (/ _reunion text string replacement)
 ;; Alan J. Thompson, 06.20.11




;;;  (defun _breakup (s / i d l1 l2)
;;;    (while
;;;      (setq i (vl-some '(lambda (x) (vl-string-search (setq d x) (strcase s))) '("\\N" " " "\\P")))
;;;       (setq l1 (cons (substr s 1 i) l1)
;;;             l2 (cons (substr s (1+ i) (strlen d)) l2)
;;;             s  (substr s (+ i 1 (strlen d)))
;;;       )
;;;    )
;;;    (mapcar 'reverse (list (cons s l1) l2))
;;;  )



 (defun _reunion (lst)
   (apply 'strcat
          (apply 'append
                 (mapcar '(lambda (a b) (list a b))
                         (car lst)
                         (if (> (length (car lst)) (length (cadr lst)))
                           (append (cadr lst) (list ""))
                           (cadr lst)
                         )
                 )
          )
   )
 )

 (if
   (and
     (AT:GetSel
       entsel
       "\nSelect text to replace first word: "
       (lambda (x)
         (if (wcmatch (cdr (assoc 0 (entget (car x)))) "ATTDEF,ATTRIB,MTEXT,MULTILEADER,TEXT")
           (setq text   (vlax-ename->vla-object (car x))
                 string (_breakup (AT:TextString (car x)))
           )
         )
       )
     )
     (not (vl-position
            (setq replacement (AT:GetString "Specify replacement string" (caar string)))
            (list "" nil (caar string))
          )
     )
   )
    (vla-put-textstring text (_reunion (list (cons replacement (cdar string)) (cadr string))))
 )
 (princ)
)










(defun c:Test (/ _reunion text string replacement)


 (defun _reunion (lst)
   (apply 'strcat
          (apply 'append
                 (mapcar '(lambda (a b) (list a b))
                         (car lst)
                         (if (> (length (car lst)) (length (cadr lst)))
                           (append (cadr lst) (list ""))
                           (cadr lst)
                         )
                 )
          )
   )
 )

 (if
   (and
     (AT:GetSel
       entsel
       "\nSelect text to replace first word: "
       (lambda (x)
         (if (wcmatch (cdr (assoc 0 (entget (car x)))) "ATTDEF,ATTRIB,MTEXT,MULTILEADER,TEXT")
           (setq text   (vlax-ename->vla-object (car x))
                 string (_breakup (AT:TextString (car x)))
           )
         )
       )
     )
     (setq replacement (dos_proplist "" "" (mapcar '(lambda (x) (cons x x)) (car string))))
   )
    (vla-put-textstring text (_reunion (list (mapcar 'cdr replacement) (cadr string))))
 )
 (princ)
)





(defun AT:GetSel (meth msg fnc / ent)
 ;; meth - selection method (entsel, nentsel, nentselp)
 ;; msg - message to display (nil for default)
 ;; fnc - optional function to apply to selected object
 ;; Ex: (AT:GetSel entsel "\nSelect arc: " (lambda (x) (eq (cdr (assoc 0 (entget (car x)))) "ARC")))
 ;; Alan J. Thompson, 05.25.10
 (setvar 'ERRNO 0)
 (while
   (progn (setq ent (meth (cond (msg)
                                ("\nSelect object: ")
                          )
                    )
          )
          (cond ((eq (getvar 'ERRNO) 7) (princ "\nMissed, try again."))
                ((eq (type (car ent)) 'ENAME)
                 (if (and fnc (not (fnc ent)))
                   (princ "\nInvalid object!")
                 )
                )
          )
   )
 )
 ent
)





(defun AT:GetString (#Title #Default / #FileName #FileOpen #DclID #NewString)
 ;; Getstring Dialog Box
 ;; #Title - Title of dialog box
 ;; #Default - Default string within edit box
 ;; Alan J. Thompson, 08.25.09
 (setq #FileName (vl-filename-mktemp "" "" ".dcl")
       #FileOpen (open #FileName "W")
 )
 (foreach x '("TempEditBox : dialog {"                      "key = \"Title\";"
              "label = \"\";"        "initial_focus = \"Edit\";"
              "spacer;"              ": row {"              ": column {"
              "alignment = centered;"                       "fixed_width = true;"
              ": text {"             "label = \"\";"        "}"
              "}"                    ": edit_box {"         "key = \"Edit\";"
              "allow_accept = true;" "edit_width = 40;"     "fixed_width = true;"
              "}"                    "}"                    "spacer;"
              ": row {"              "fixed_width = true;"  "alignment = centered;"
              ": ok_button {"        "width = 11;"          "}"
              ": cancel_button {"    "width = 11;"          "}"
              "}"                    "}//"
             )
   (write-line x #FileOpen)
 )
 (close #FileOpen)
 (setq #DclID (load_dialog #FileName))
 (new_dialog "TempEditBox" #DclID)
 (set_tile "Title" #Title)
 (set_tile "Edit" #Default)
 (action_tile "accept" "(setq #NewString (get_tile \"Edit\"))(done_dialog)")
 (action_tile "cancel" "(done_dialog)")
 (start_dialog)
 (unload_dialog #DclID)
 (vl-file-delete #FileName)
 #NewString
)



(defun AT:TextString (Obj)
 ;; Extract textstring (with symbols) from text object
 ;; Works on: Attrib, Attdef, MText, Multileader, Text
 ;; Obj - Object to extract textstring from
 ;; Alan J. Thompson, 11.24.09 / 04.13.10
 (if Obj
   ((lambda (e)
      (cond ((eq (cdr (assoc 0 e)) "MULTILEADER") (cdr (assoc 304 e)))
            ((vl-position (cdr (assoc 0 e)) '("ATTDEF" "ATTRIB" "TEXT")) (cdr (assoc 1 e)))
            ((eq (cdr (assoc 0 e)) "MTEXT")
             (apply (function strcat)
                    (mapcar (function (lambda (x)
                                        (if (vl-position (car x) '(1 3))
                                          (cdr x)
                                          ""
                                        )
                                      )
                            )
                            e
                    )
             )
            )
      )
    )
     (entget (cond ((vl-consp Obj) (car Obj))
                   ((eq (type Obj) 'ENAME) Obj)
                   ((eq (type Obj) 'VLA-ObjECT) (vlax-vla-object->ename Obj))
             )
     )
   )
 )
)

EDIT: added missing subroutine.

Here's the one I was working on (only wanted to be able replace the first word with another). It works, but I lost interest and abandoned the project. However, some of the coding might be of use...

 

(defun _breakup (s / foo l i d l1 l2)

 (defun foo (s / f n)
   (setq s (strcase s))
   (foreach x '("\\N" " " "\\P")
     (and (setq f (vl-string-search x s)) (setq n (cons (list f x) n)))
   )
   n
 )

 (while
   (setq i (caar (setq l (vl-sort (foo s) '(lambda (a b) (< (car a) (car b))))))
         d (cadar l)
   )
    (setq l1 (cons (substr s 1 i) l1)
          l2 (cons (substr s (1+ i) (strlen d)) l2)
          s  (substr s (+ i 1 (strlen d)))
    )
 )
 (if l2
   (mapcar 'reverse (list (cons s l1) l2))
   s
 )
)


(defun c:REPF (/ _reunion text string replacement)
 ;; Alan J. Thompson, 06.20.11




;;;  (defun _breakup (s / i d l1 l2)
;;;    (while
;;;      (setq i (vl-some '(lambda (x) (vl-string-search (setq d x) (strcase s))) '("\\N" " " "\\P")))
;;;       (setq l1 (cons (substr s 1 i) l1)
;;;             l2 (cons (substr s (1+ i) (strlen d)) l2)
;;;             s  (substr s (+ i 1 (strlen d)))
;;;       )
;;;    )
;;;    (mapcar 'reverse (list (cons s l1) l2))
;;;  )



 (defun _reunion (lst)
   (apply 'strcat
          (apply 'append
                 (mapcar '(lambda (a b) (list a b))
                         (car lst)
                         (if (> (length (car lst)) (length (cadr lst)))
                           (append (cadr lst) (list ""))
                           (cadr lst)
                         )
                 )
          )
   )
 )

 (if
   (and
     (AT:GetSel
       entsel
       "\nSelect text to replace first word: "
       (lambda (x)
         (if (wcmatch (cdr (assoc 0 (entget (car x)))) "ATTDEF,ATTRIB,MTEXT,MULTILEADER,TEXT")
           (setq text   (vlax-ename->vla-object (car x))
                 string (_breakup (AT:TextString (car x)))
           )
         )
       )
     )
     (not (vl-position
            (setq replacement (AT:GetString "Specify replacement string" (caar string)))
            (list "" nil (caar string))
          )
     )
   )
    (vla-put-textstring text (_reunion (list (cons replacement (cdar string)) (cadr string))))
 )
 (princ)
)










(defun c:Test (/ _reunion text string replacement)


 (defun _reunion (lst)
   (apply 'strcat
          (apply 'append
                 (mapcar '(lambda (a b) (list a b))
                         (car lst)
                         (if (> (length (car lst)) (length (cadr lst)))
                           (append (cadr lst) (list ""))
                           (cadr lst)
                         )
                 )
          )
   )
 )

 (if
   (and
     (AT:GetSel
       entsel
       "\nSelect text to replace first word: "
       (lambda (x)
         (if (wcmatch (cdr (assoc 0 (entget (car x)))) "ATTDEF,ATTRIB,MTEXT,MULTILEADER,TEXT")
           (setq text   (vlax-ename->vla-object (car x))
                 string (_breakup (AT:TextString (car x)))
           )
         )
       )
     )
     (setq replacement (dos_proplist "" "" (mapcar '(lambda (x) (cons x x)) (car string))))
   )
    (vla-put-textstring text (_reunion (list (mapcar 'cdr replacement) (cadr string))))
 )
 (princ)
)





(defun AT:GetSel (meth msg fnc / ent)
 ;; meth - selection method (entsel, nentsel, nentselp)
 ;; msg - message to display (nil for default)
 ;; fnc - optional function to apply to selected object
 ;; Ex: (AT:GetSel entsel "\nSelect arc: " (lambda (x) (eq (cdr (assoc 0 (entget (car x)))) "ARC")))
 ;; Alan J. Thompson, 05.25.10
 (setvar 'ERRNO 0)
 (while
   (progn (setq ent (meth (cond (msg)
                                ("\nSelect object: ")
                          )
                    )
          )
          (cond ((eq (getvar 'ERRNO) 7) (princ "\nMissed, try again."))
                ((eq (type (car ent)) 'ENAME)
                 (if (and fnc (not (fnc ent)))
                   (princ "\nInvalid object!")
                 )
                )
          )
   )
 )
 ent
)





(defun AT:GetString (#Title #Default / #FileName #FileOpen #DclID #NewString)
 ;; Getstring Dialog Box
 ;; #Title - Title of dialog box
 ;; #Default - Default string within edit box
 ;; Alan J. Thompson, 08.25.09
 (setq #FileName (vl-filename-mktemp "" "" ".dcl")
       #FileOpen (open #FileName "W")
 )
 (foreach x '("TempEditBox : dialog {"                      "key = \"Title\";"
              "label = \"\";"        "initial_focus = \"Edit\";"
              "spacer;"              ": row {"              ": column {"
              "alignment = centered;"                       "fixed_width = true;"
              ": text {"             "label = \"\";"        "}"
              "}"                    ": edit_box {"         "key = \"Edit\";"
              "allow_accept = true;" "edit_width = 40;"     "fixed_width = true;"
              "}"                    "}"                    "spacer;"
              ": row {"              "fixed_width = true;"  "alignment = centered;"
              ": ok_button {"        "width = 11;"          "}"
              ": cancel_button {"    "width = 11;"          "}"
              "}"                    "}//"
             )
   (write-line x #FileOpen)
 )
 (close #FileOpen)
 (setq #DclID (load_dialog #FileName))
 (new_dialog "TempEditBox" #DclID)
 (set_tile "Title" #Title)
 (set_tile "Edit" #Default)
 (action_tile "accept" "(setq #NewString (get_tile \"Edit\"))(done_dialog)")
 (action_tile "cancel" "(done_dialog)")
 (start_dialog)
 (unload_dialog #DclID)
 (vl-file-delete #FileName)
 #NewString
)

dear sir eror

Command: TEST

Select text to replace first word: ; error: no function definition:

AT:TEXTSTRING

dear sir eror

added missing subroutine, but THIS IS NOT 'COMPLETED CODE', it's an abandoned proof of concept. I posted it for the benefit of pBe digging through, if interested.

@alanjt : you use dos_proplist, and .....

@alanjt : you use dos_proplist, and .....

arg. Download DosLib and anything else that's missing, I'll post.

I should have just pmed it to pBe.

 

I should have just pmed it to pBe.

I feel with you.

I feel with you.

No way dude, I'm married.

No way dude, I'm married.

Anyhoo.. found some useful bits on your code

Thanks Alanjt

PS: _Breakup and _reunion an inventive function name but somewhat appropriate. Nice Alanjt

Anyhoo.. found some useful bits on your code

 

Thanks Alanjt

 

PS: _Breakup and _reunion an inventive function name but somewhat appropriate. Nice Alanjt

Thanks and you're welcome. That's what I posted the code for, the rest is just to see how I used them.

Hope it helps.