pBe Posted July 28, 2011 Share Posted July 28, 2011 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 Quote Link to comment Share on other sites More sharing options...
ketxu Posted July 28, 2011 Share Posted July 28, 2011 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 Quote Link to comment Share on other sites More sharing options...
alanjt Posted July 28, 2011 Share Posted July 28, 2011 What about formatting? Quote Link to comment Share on other sites More sharing options...
pBe Posted July 29, 2011 Author Share Posted July 29, 2011 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... Quote Link to comment Share on other sites More sharing options...
pBe Posted July 29, 2011 Author Share Posted July 29, 2011 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 Quote Link to comment Share on other sites More sharing options...
alanjt Posted July 29, 2011 Share Posted July 29, 2011 (edited) 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. Edited July 30, 2011 by alanjt Quote Link to comment Share on other sites More sharing options...
autolisp Posted July 30, 2011 Share Posted July 30, 2011 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: TESTSelect text to replace first word: ; error: no function definition: AT:TEXTSTRING Quote Link to comment Share on other sites More sharing options...
alanjt Posted July 30, 2011 Share Posted July 30, 2011 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. Quote Link to comment Share on other sites More sharing options...
ketxu Posted July 30, 2011 Share Posted July 30, 2011 @alanjt : you use dos_proplist, and ..... Quote Link to comment Share on other sites More sharing options...
alanjt Posted July 30, 2011 Share Posted July 30, 2011 @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. Quote Link to comment Share on other sites More sharing options...
Tharwat Posted July 30, 2011 Share Posted July 30, 2011 I should have just pmed it to pBe. I feel with you. Quote Link to comment Share on other sites More sharing options...
alanjt Posted July 30, 2011 Share Posted July 30, 2011 I feel with you. No way dude, I'm married. Quote Link to comment Share on other sites More sharing options...
pBe Posted July 31, 2011 Author Share Posted July 31, 2011 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 Quote Link to comment Share on other sites More sharing options...
alanjt Posted July 31, 2011 Share Posted July 31, 2011 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. Quote Link to comment Share on other sites More sharing options...
Recommended Posts
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.