悬赏20个明经币求高手出手：关于字符串修改类的子函数

水吉空

字符串内容类似于：“墙12架13管144埋122” 转化为：字符串表（（“墙” "12"）("架 “ ” 13”）("管 “ ” 144”）("埋 “ ” 122”）)
悬赏20个明经币求关于字符串转为字符串表的子函数，望高手出手！！！！

xinxirong

(defun by:DIV( str / a )
  (Div_list_by_2 (BY:DivStrByCEN str))
  )

(defun Div_list_by_2 (lst / new_lst )
  (while lst
    (setq new_lst (append new_lst (list (list (car lst) (cadr lst))))
          lst (cddr lst)
          )
    );end while lst
  new_lst
  )

(defun BY:DivStrByCEN (str / &str1;合并后的同类子串
                       c n1 resultList  $oldtype $type )
  (setq resultList '())
  (while (/= str "")
    (setq c (substr str 1 1)
          n1 (ascii c)
          )
    ;读取一个字串符，并得到ascii码
    (cond
      ((and (< n1 128)                              ;英文的ascii码都小于128
            (or (< (ascii c) 48) (>  (ascii c) 57));非数字
            )
       (setq $type "英文")
       (if (/= $oldtype $type)
         (progn
           (if &str1 (setq resultList (append resultList (list &str1))))     ;上一种字符串加入表
           (setq &str1 c)
         )
         ;else合并
         (progn
           (setq &str1 (strcat &str1 c))
         )
       );end if
       (setq $oldtype "英文"
             str (substr str 2)                ;字符串前减1
             )
       );end 英文


      ((and (> (ascii c) 47)
            (<  (ascii c) 58))                ;数字
       (setq $type "数字")
       (if (/= $oldtype $type)
         (progn
           (if &str1 (setq resultList (append resultList (list &str1))))     ;上一种字符串加入表
           (setq &str1 c)
         )
         ;else合并
         (progn
           (setq &str1 (strcat &str1 c))
         )
       );end if
       (setq $oldtype "数字"
             str (substr str 2)                ;字符串前减1
             )
       );end 数字


      ((> n1 127)                                      ;中文
       (setq $type "中文")
       (if (/= $oldtype $type)
         (progn
           (if &str1 (setq resultList (append resultList (list &str1))))     ;上一种字符串加入表
           (setq &str1 (substr str 1 2));中文取两位
         )
         ;else合并
         (progn
           (setq &str1 (strcat &str1 (substr str 1 2)));中文取两位
         )
       );end if
       (setq $oldtype "中文"
             str (substr str 3)                ;字符串前减2
             )
       )

      );end cond
    );while
  (setq resultList (append resultList (list &str1)))     ;上一种字符串加入表
  ;返回
  resultList
);end defun

xinxirong

手机版显示有问题

xinxirong

把表情改为:即可，提资时自动转换为表情了。

llsheng_73

1. (defun StrType(a / b c d e);;字符串分离全角、符号、字母、数字,已知BUG:连续小数点与数字相连不能精确分离数字和小数点
   
2.   (setq b(vl-string->list a))
   
3.   (while b
   
4.     (setq a(car b)b(cdr b)c(last d))
   
5.     (if(or(not d)
   
6.           (and(< 0 a 32)(< 0 c 32));;非打印字符
   
7.           (or(= 46 a)(= 46 c)(and(< 47 a 58)(< 47 c 58)));数字和小数点
   
8.           (vl-every'(lambda(x)(vl-some'(lambda(y)(<(car y)x(cadr y)))'((31 48)(57 65)(90 98)(122 129))))(list a c));其它字符包括小数点
   
9.           (vl-every'(lambda(x)(vl-some'(lambda(y)(<(car y)x(cadr y)))'((64 91)(96 123))))(list a c));;字母
   
10.           (and(> a 128)(> c 128)));;全角字符
    
11.       (if(> a 128)(setq d(vl-list*(car b)a d)b(cdr b))(setq d(cons a d)))
    
12.       (setq e(cons(reverse d)e)d(if(> a 128)(list(car b)a)(List a))b(if(> a 128)(cdr b)b))))
    
13.   (mapcar'vl-list->string(reverse(cons(reverse d)e))))

(defun StrType(a / b c d e);;字符串分离全角、符号、字母、数字,已知BUG:连续小数点与数字相连不能精确分离数字和小数点<br />   (setq b(vl-string->list a))<br />   (while b<br />     (setq a(car b)b(cdr b)c(last d))<br />     (if(or(not d)<br />           (and(< 0 a 32)(< 0 c 32));;非打印字符<br />           (or(= 46 a)(= 46 c)(and(< 47 a 58)(< 47 c 58)));数字和小数点<br />           (vl-every'(lambda(x)(vl-some'(lambda(y)(<(car y)x(cadr y)))'((31 48)(57 65)(90 98)(122 129))))(list a c));其它字符包括小数点<br />           (vl-every'(lambda(x)(vl-some'(lambda(y)(<(car y)x(cadr y)))'((64 91)(96 123))))(list a c));;字母<br />           (and(> a 128)(> c 128)));;全角字符<br />       (if(> a 128)(setq d(vl-list*(car b)a d)b(cdr b))(setq d(cons a d)))<br />       (setq e(cons(reverse d)e)d(if(> a 128)(list(car b)a)(List a))b(if(> a 128)(cdr b)b))))<br />   (mapcar'vl-list->string(reverse(cons(reverse d)e))))

;;(StrType"墙12架13管144埋122")->("墙" "12" "架" "13" "管" "144" "埋" "122")

水吉空

llsheng_73 发表于 2017-10-19 15:41
;;(StrType"墙12架13管144埋122")->("墙" "12" "架" "13" "管" "144" "埋" "122")

谢谢73哥，你这个转换的我有了，我要的是（（“墙” "12"）("架 “ ” 13”）("管 “ ” 144”）("埋 “ ” 122”）)，里面也是表，表里有子表。类型与多维表。

水吉空

xinxirong 发表于 2017-10-19 12:53
(defun byIV( str / a )
  (Div_list_by_2 (BYivStrByCEN str))
  )

谢谢大神，完美解决！

llsheng_73

水吉空 发表于 2017-10-19 16:33
谢谢73哥，你这个转换的我有了，我要的是（（“墙” "12"）("架 “ ” 13”）("管 “ ” 144”）("埋 “  ...

(SETQ A(StrType"墙12架13管144埋122"))
("墙" "12" "架" "13" "管" "144" "埋" "122")
_$ (Mapcar'list(vl-remove-if'distof a)(vl-remove-if-not'distof a))
(("墙" "12") ("架" "13") ("管" "144") ("埋" "122"))

(defun divlst(lst n / a b)
    (while lst(setq b nil)
      (repeat(min(length lst)n)(setq b(cons(car lst) b)lst(cdr lst)))
      (setq a(cons b a)))
    (mapcar'reverse(reverse a)))
DIVLST
_$ (divlst(StrType"墙12架13管144埋122")2)
(("墙" "12") ("架" "13") ("管" "144") ("埋" "122"))

springwillow

2. (defun ccc()
   
3.   (setq lst (xxexp "[\\d,\\.]+|[^\\d,\\.]+" "墙12架13管144埋122" ""))
   
4.   (mapcar '(lambda(a b)(list a b)) (reverse(cdr(reverse lst)))(cdr lst))
   
5.   )

(defun ccc()<br />   (setq lst (xxexp "[\\d,\\.]+|[^\\d,\\.]+" "墙12架13管144埋122" ""))<br />   (mapcar '(lambda(a b)(list a b)) (reverse(cdr(reverse lst)))(cdr lst))<br />   )

xxexp请在本站搜索一刀屠文正则表达式，可能还有更简单的办法，暂时未想到

水吉空

llsheng_73 发表于 2017-10-19 17:33
(SETQ A(StrType"墙12架13管144埋122"))
("墙" "12" "架" "13" "管" "144" "埋" "122")
_$ (Mapcar'lis ...

谢谢73哥。。。。。。。。。。。。。。。。。。