不用回车的KeyWord
;;(MyKeyWord "对齐[左(Z)/右(Y)]<Z>:")(defun MyKeyWord (str / CODE FLAG RETURN STR1 STR2)
(princ (strcat "\n " str))
(setq str1 (xd::string:regexps "[\(].[\)]" str ""))
(setq str1(mapcar '(lambda(x) (xd::string:regexps "[^\(|\)]" x "")) str1))
(setq str1(apply 'strcat (mapcar 'car str1)))
(setq str2 (xd::string:regexps "[\<].[\>]" str ""))
(setq str2 (xd::string:regexps "[^\<|\>]" (car str2) ""))
(setq str1 (strcat (strcase str1 nil) (strcase str1 t) " "))
(setq str1 (VL-STRING->LIST str1))
(while (not Flag)
(setq code (grread T 8))
(setq Flag (member (cadr code) str1))
)
(if (= (type Flag) 'LIST)
(setq return (strcase (VL-LIST->STRING (list (car Flag))) nil))
)
(if (= return " ")
(setq return (car str2))
)
return
) 试一下这个，不记得原作者是谁了，应该是来源于本论坛。
;;;(Get_Key_Word "\n1实体/2钢筋砼/3素砼/4墙体/5阳台/6卫生间/7厨房：<1>"'("1" "2" "3" "4" "5" "6" "7") "1")
(defun Get_Key_Word(pro lst def / kw val)
(setq lst (apply 'append (mapcar '(lambda(e) (list (ascii (strcase e)) (ascii (strcase e T)))) lst)) def (ascii def))
(prompt pro)
(while (not (and (setq kw (grread nil) val (car kw) kw (cadr kw)) (member val '(2 11 25))
(if (or (= val 25) (and (= val 11) (= kw 0)) (member kw '(13 32))) (setq kw def) (member kw lst)))))
(strcase (vl-list->string (list kw))))
本帖最后由 小菜123 于 2021-2-19 16:13 编辑
;|
功能 对字符串进行正则表达式匹配测试.
参数:
pat = 正则表达式模式 ,对应vbs正则表达式的模式(expression)。说明: \\号要用\\\\替代.
str = 字符串
key = \"i\" \"g\" \"m\" , \"i\"不区分大小写（Ignorecase）,\"g\"全局匹配（Global）.
\"m\"多行模式（Multiline），以上几个关键字可以组合使用，或用 \"\".
返回: 返回匹配的字符列表，或无一匹配返回nil
|;
(defun XD::String:RegExpS (pat str key / end keys matches x)
(if (not *xxvbsexp)
(setq *xxvbsexp (vlax-get-or-create-object "VBScript.RegExp"))
)
(vlax-put *xxvbsexp 'Pattern pat)
(if (not key)
(setq key "")
)
(setq key (strcase key))
(setq keys '(("I" "IgnoreCase") ("G" "Global")
("M" "Multiline")
)
)
(mapcar
'(lambda (x)
(if (wcmatch key (strcat "*" (car x) "*"))
(vlax-put *xxvbsexp (read (cadr x)) 0)
(vlax-put *xxvbsexp (read (cadr x)) -1)
)
)
keys
)
(setq matches (vlax-invoke *xxvbsexp 'Execute str))
(vlax-for x matches (setq end (cons (vla-get-value x) end)))
(reverse end)
)
黄大师还是按照自己的想法写完了，厉害厉害 黄大师，求一个快速对齐的lisp，实现的功能就是选择一个对象，直线或者块，再点选该对象中的一条直线，然后选中要对齐的线就直接对齐到此线段了。
明经里有不少这样的lisp，但是都不太完善，求大师指点，多多谢谢，前排占座等候 缺少xd::string:regexps函数 谢谢! 黄大师分享学习!!!!! 学习啦...................... 小菜123 发表于 2021-2-19 16:11
有了菜总的代码，省去了装晓东工具箱。 很方便，多谢黄大师热心分享
页:
[1]
2