不用回车的KeyWord

自贡黄明儒

1. ;;(MyKeyWord "对齐[左(Z)/右(Y)]<Z>:")
   
2. (defun MyKeyWord (str / CODE FLAG RETURN STR1 STR2)
   
3.   (princ (strcat "\n " str))
   
4.   (setq str1 (xd::string:regexps "[\(].[\)]" str ""))
   
5.   (setq str1(mapcar '(lambda(x) (xd::string:regexps "[^\(|\)]" x "")) str1))
   
6.   (setq str1(apply 'strcat (mapcar 'car str1)))
   
7.   (setq str2 (xd::string:regexps "[\<].[\>]" str ""))
   
8.   (setq str2 (xd::string:regexps "[^\<|\>]" (car str2) ""))  
   
9.   (setq str1 (strcat (strcase str1 nil) (strcase str1 t) " "))
   
10.   (setq str1 (VL-STRING->LIST str1))
    
11.   (while (not Flag)
    
12.     (setq code (grread T 8))
    
13.     (setq Flag (member (cadr code) str1))
    
14.   )
    
15.   (if (= (type Flag) 'LIST)
    
16.     (setq return (strcase (VL-LIST->STRING (list (car Flag))) nil))
    
17.   )
    
18.   (if (= return " ")
    
19.     (setq return (car str2))
    
20.   )
    
21.   return
    
22. )

;;(MyKeyWord "对齐[左(Z)/右(Y)]<Z>:")<br /> (defun MyKeyWord (str / CODE FLAG RETURN STR1 STR2)<br />   (princ (strcat "\n " str))<br />   (setq str1 (xd::string:regexps "[\(].[\)]" str ""))<br />   (setq str1(mapcar '(lambda(x) (xd::string:regexps "[^\(|\)]" x "")) str1))<br />   (setq str1(apply 'strcat (mapcar 'car str1)))<br />   (setq str2 (xd::string:regexps "[\<].[\>]" str ""))<br />   (setq str2 (xd::string:regexps "[^\<|\>]" (car str2) ""))  <br />   (setq str1 (strcat (strcase str1 nil) (strcase str1 t) " "))<br />   (setq str1 (VL-STRING->LIST str1))<br />   (while (not Flag)<br />     (setq code (grread T 8))<br />     (setq Flag (member (cadr code) str1))<br />   )<br />   (if (= (type Flag) 'LIST)<br />     (setq return (strcase (VL-LIST->STRING (list (car Flag))) nil))<br />   )<br />   (if (= return " ")<br />     (setq return (car str2))<br />   )<br />   return<br /> )

hf423

试一下这个，不记得原作者是谁了，应该是来源于本论坛。

2. ;;;(Get_Key_Word "\n1实体/2钢筋砼/3素砼/4墙体/5阳台/6卫生间/7厨房：<1>"'("1" "2" "3" "4" "5" "6" "7") "1")
   
3. (defun Get_Key_Word(pro lst def / kw val)
   
4.   (setq lst (apply 'append (mapcar '(lambda(e) (list (ascii (strcase e)) (ascii (strcase e T)))) lst)) def (ascii def))
   
5.   (prompt pro)
   
6.   (while (not (and (setq kw (grread nil) val (car kw) kw (cadr kw)) (member val '(2 11 25))
   
7.                    (if (or (= val 25) (and (= val 11) (= kw 0)) (member kw '(13 32))) (setq kw def) (member kw lst)))))
   
8.   (strcase (vl-list->string (list kw))))

;;;(Get_Key_Word "\n1实体/2钢筋砼/3素砼/4墙体/5阳台/6卫生间/7厨房：<1>"'("1" "2" "3" "4" "5" "6" "7") "1")<br /> (defun Get_Key_Word(pro lst def / kw val)<br />   (setq lst (apply 'append (mapcar '(lambda(e) (list (ascii (strcase e)) (ascii (strcase e T)))) lst)) def (ascii def))<br />   (prompt pro)<br />   (while (not (and (setq kw (grread nil) val (car kw) kw (cadr kw)) (member val '(2 11 25))<br />                    (if (or (= val 25) (and (= val 11) (= kw 0)) (member kw '(13 32))) (setq kw def) (member kw lst)))))<br />   (strcase (vl-list->string (list kw))))

小菜123

2. 
   
3. ;|
   
4. 功能 对字符串进行正则表达式匹配测试.
   
5. 参数:
   
6. pat = 正则表达式模式 ,对应vbs正则表达式的模式(expression)。说明: \\号要用\\\\替代.
   
7. str = 字符串
   
8. key = "i" "g" "m" , "i"不区分大小写（Ignorecase）,"g"全局匹配（Global）.
   
9.            "m"多行模式（Multiline），以上几个关键字可以组合使用，或用 "".
   
10. 返回: 返回匹配的字符列表，或无一匹配返回nil
    
11. 
    
12. |;
    
13. (defun XD::String:RegExpS (pat str key / end keys matches x)
    
14.   (if (not *xxvbsexp)
    
15.     (setq *xxvbsexp (vlax-get-or-create-object "VBScript.RegExp"))
    
16.   )
    
17.   (vlax-put *xxvbsexp 'Pattern pat)
    
18.   (if (not key)
    
19.     (setq key "")
    
20.   )
    
21.   (setq key (strcase key))
    
22.   (setq keys '(("I" "IgnoreCase") ("G" "Global")
    
23.          ("M" "Multiline")
    
24.         )
    
25.   )
    
26.   (mapcar
    
27.     '(lambda (x)
    
28.        (if (wcmatch key (strcat "*" (car x) "*"))
    
29.          (vlax-put *xxvbsexp (read (cadr x)) 0)
    
30.          (vlax-put *xxvbsexp (read (cadr x)) -1)
    
31.        )
    
32.      )
    
33.     keys
    
34.   )
    
35.   (setq matches (vlax-invoke *xxvbsexp 'Execute str))
    
36.   (vlax-for x matches (setq end (cons (vla-get-value x) end)))
    
37.   (reverse end)
    
38. )
    
39. 
    

<br /> ;|<br /> 功能 对字符串进行正则表达式匹配测试. <br /> 参数: <br /> pat = 正则表达式模式 ,对应vbs正则表达式的模式(expression)。说明: \\号要用\\\\替代.<br /> str = 字符串<br /> key = "i" "g" "m" , "i"不区分大小写（Ignorecase）,"g"全局匹配（Global）.<br />            "m"多行模式（Multiline），以上几个关键字可以组合使用，或用 "".<br /> 返回: 返回匹配的字符列表，或无一匹配返回nil<br /> <br /> |;<br /> (defun XD::String:RegExpS (pat str key / end keys matches x)<br />   (if (not *xxvbsexp)<br />     (setq *xxvbsexp (vlax-get-or-create-object "VBScript.RegExp"))<br />   )<br />   (vlax-put *xxvbsexp 'Pattern pat)<br />   (if (not key)<br />     (setq key "")<br />   )<br />   (setq key (strcase key))<br />   (setq keys '(("I" "IgnoreCase") ("G" "Global")<br />          ("M" "Multiline")<br />         )<br />   )<br />   (mapcar<br />     '(lambda (x)<br />        (if (wcmatch key (strcat "*" (car x) "*"))<br />          (vlax-put *xxvbsexp (read (cadr x)) 0)<br />          (vlax-put *xxvbsexp (read (cadr x)) -1)<br />        )<br />      )<br />     keys<br />   )<br />   (setq matches (vlax-invoke *xxvbsexp 'Execute str))<br />   (vlax-for x matches (setq end (cons (vla-get-value x) end)))<br />   (reverse end)<br /> )<br /> <br />

zixuan203344

黄大师还是按照自己的想法写完了，厉害厉害

andyzha

黄大师，求一个快速对齐的lisp，实现的功能就是选择一个对象，直线或者块，再点选该对象中的一条直线，然后选中要对齐的线就直接对齐到此线段了。

明经里有不少这样的lisp，但是都不太完善，求大师指点，多多谢谢，前排占座等候

paulpipi

xyp1964

缺少xd::string:regexps函数

yoyoho

谢谢! 黄大师分享学习!!!!!

Qwer1243

学习啦......................

tigcat

小菜123 发表于 2021-2-19 16:11

有了菜总的代码，省去了装晓东工具箱。

20060510412

很方便，多谢黄大师热心分享