懒惰的打字员文本编辑：
这是一个同事奇怪的请求：
假设您有一个文本“15 LF OF 2”X6“水平支撑”
和另一个文字“20 LF OF 2”X10“水平和垂直支撑”，
如果你想把单词“AND VERTICAL”复制到第一篇文章的中间句
要获得“15 LF OF 2”X6“水平和垂直支撑”，该怎么做？
双击、剪切和粘贴？
_查找？
如果…怎么办
第一个文本“10 20 30 60 70”
第二个文本“40 80 100 60 50 30”
从第二个文本中抓取“40”和“50”，得到“10 20 30 40 50 60 70”
或者你用这个：
(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)
))
)
)
仍然需要做很多工作，但编写代码很有趣
这很有趣的代码^^但我认为Ctrl C和Ctrl V更快，除了文字抓取不连续^^谢谢！
如果同时选择2个文本和列表框2个文本内容与列表框，效果会更好，更改可以立即显示
格式化呢？
好建议。。并在底部实时显示结果字符串。。。
也在努力。我真的没有花太多时间在这上面，我认为这是李-麦克所说的一个新奇的项目。也许我可以把它变成一个有趣的游戏。（这是一个想法）
谢谢Alanjt
这是我正在研究的一个（只想用另一个词替换第一个词）。这是可行的，但我失去了兴趣，放弃了这个项目。然而，一些编码可能有用。。。
(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))
)
)
)
)
)
编辑：添加缺少的子例程。
尊敬的埃罗先生：
添加了缺失的子例程，但这不是“完整的代码”，它是一个废弃的概念证明。如果有兴趣的话，我把它贴出来是为了pBe的挖掘。
@alanjt：你使用dos_proplist，并且。。。。。
arg。下载DosLib和其他缺失的内容，我会发布。
我应该把它交给pBe。
页:
[1]
2
假设您有一个文本“15 LF OF 2”X6“水平支撑”
和另一个文字“20 LF OF 2”X10“水平和垂直支撑”，
如果你想把单词“AND VERTICAL”复制到第一篇文章的中间句
要获得“15 LF OF 2”X6“水平和垂直支撑”，该怎么做？
双击、剪切和粘贴？
_查找？
如果…怎么办
第一个文本“10 20 30 60 70”
第二个文本“40 80 100 60 50 30”
从第二个文本中抓取“40”和“50”，得到“10 20 30 40 50 60 70”
或者你用这个：
(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)
))
)
)
仍然需要做很多工作，但编写代码很有趣
这很有趣的代码^^但我认为Ctrl C和Ctrl V更快，除了文字抓取不连续^^谢谢！
如果同时选择2个文本和列表框2个文本内容与列表框，效果会更好，更改可以立即显示 格式化呢？
好建议。。并在底部实时显示结果字符串。。。
也在努力。我真的没有花太多时间在这上面，我认为这是李-麦克所说的一个新奇的项目。也许我可以把它变成一个有趣的游戏。（这是一个想法）
谢谢Alanjt 这是我正在研究的一个（只想用另一个词替换第一个词）。这是可行的，但我失去了兴趣，放弃了这个项目。然而，一些编码可能有用。。。
(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))
)
)
)
)
)
编辑：添加缺少的子例程。 尊敬的埃罗先生： 添加了缺失的子例程，但这不是“完整的代码”，它是一个废弃的概念证明。如果有兴趣的话，我把它贴出来是为了pBe的挖掘。 @alanjt：你使用dos_proplist，并且。。。。。 arg。下载DosLib和其他缺失的内容，我会发布。
我应该把它交给pBe。
页:
[1]
2