悬赏20个明经币求高手出手：关于字符串修改类的子函数
字符串内容类似于：“墙12架13管144埋122” 转化为：字符串表（（“墙” "12"）("架 “ ” 13”）("管 “ ” 144”）("埋 “ ” 122”）)悬赏20个明经币求关于字符串转为字符串表的子函数，望高手出手！！！！
本帖最后由 Gu_xl 于 2017-10-20 10:18 编辑
(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 于 2017-10-19 14:38 编辑
手机版显示有问题 把表情改为:即可，提资时自动转换为表情了。 (defun StrType(a / b c d e);;字符串分离全角、符号、字母、数字,已知BUG:连续小数点与数字相连不能精确分离数字和小数点
(setq b(vl-string->list a))
(while b
(setq a(car b)b(cdr b)c(last d))
(if(or(not d)
(and(< 0 a 32)(< 0 c 32));;非打印字符
(or(= 46 a)(= 46 c)(and(< 47 a 58)(< 47 c 58)));数字和小数点
(vl-every'(lambda(x)(vl-some'(lambda(y)(<(car y)x(cadr y)))'((31 48)(57 65)(90 98)(122 129))))(list a c));其它字符包括小数点
(vl-every'(lambda(x)(vl-some'(lambda(y)(<(car y)x(cadr y)))'((64 91)(96 123))))(list a c));;字母
(and(> a 128)(> c 128)));;全角字符
(if(> a 128)(setq d(vl-list*(car b)a d)b(cdr b))(setq d(cons a d)))
(setq e(cons(reverse d)e)d(if(> a 128)(list(car b)a)(List a))b(if(> a 128)(cdr b)b))))
(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 17:38 编辑
水吉空 发表于 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 于 2017-10-19 17:44 编辑
(defun ccc()
(setq lst (xxexp "[\\d,\\.]+|[^\\d,\\.]+" "墙12架13管144埋122" ""))
(mapcar '(lambda(a b)(list a b)) (reverse(cdr(reverse lst)))(cdr lst))
)
xxexp请在本站搜索一刀屠文正则表达式，可能还有更简单的办法，暂时未想到 llsheng_73 发表于 2017-10-19 17:33
(SETQ A(StrType"墙12架13管144埋122"))
("墙" "12" "架" "13" "管" "144" "埋" "122")
_$ (Mapcar'lis ...
谢谢73哥。。。。。。。。。。。。。。。。。。
页:
[1]
2