[LISP函数-字串]：字串列表解析为1个具分隔符的字串

eachy

2. 
   
3. ;;;将一个字符串列表解析为1个具有分隔符的字符串
   
4. ;;;==================================================================
   
5. ;;; (xd-strunparse lst delimiter)
   
6. ;;;             将一个字符串列表解析为1个具有分隔符的字符串
   
7. ;;;------------------------------------------------------------------
   
8. ;;; 参数:
   
9. ;;;             str                     要连接的列表
   
10. ;;;             delimiter       使用的分隔符
    
11. ;;;------------------------------------------------------------------
    
12. ;;;     返回:
    
13. ;;;             一个字符串。
    
14. ;;;             示例:
    
15. ;;;             (setq a '("harp" "guiness" "black and tan"))
    
16. ;;;             (xd-strunparse a ",")
    
17. ;;;             返回:
    
18. ;;;             "harp,guiness,black and tan"
    
19. ;;;------------------------------------------------------------------
    
20. (defun xd-string_unparse (lst delimiter / return)
    
21.   (setq return "")
    
22.   (foreach str lst
    
23.     (setq return (strcat return delimiter str))
    
24.   )
    
25.   (substr return 2)
    
26. )
    
27. ;;Author : eachy
    
28. (defun xd-string_join (strlst div /)
    
29.   (vl-string-trim
    
30.     div
    
31.     (apply 'strcat (mapcar '(lambda (x) (strcat x div)) strlst))
    
32.   )
    
33. )
    
34. ;;应用示例
    
35. (while (setq e0 (entsel "\n拾取删除图块<退出>: "))
    
36.   (if (and (setq el (entget (car e0)))
    
37.            (= (cdr (assoc 0 el)) "INSERT")
    
38.            (setq bn (cdr (setq b (assoc 2 el))))
    
39.            (not (member bn bln))
    
40.       )
    
41.     (progn
    
42.       (setq bln (cons bn bln))
    
43.       (redraw (car e0) 3)
    
44.       (xd-clearcset)
    
45.       (setq ss (ssget "X" (list '(0 . "INSERT") b)))
    
46.       (vla-highlight (xd-activesset) :vlax-true)
    
47.       (prompt (strcat "\n选中了""
    
48.                       (setq sbln (String_Join
    
49.                                    (reverse bln)
    
50.                                    ","
    
51.                                  )
    
52.                       )
    
53.                       ""块!"
    
54.               )
    
55.       )
    
56.     )
    
57.     (princ "\n选择非图块, 重新选择!")
    
58.   )
    
59. )

<br /> ;;;将一个字符串列表解析为1个具有分隔符的字符串<br /> ;;;==================================================================<br /> ;;; (xd-strunparse lst delimiter)<br /> ;;;             将一个字符串列表解析为1个具有分隔符的字符串<br /> ;;;------------------------------------------------------------------<br /> ;;; 参数:<br /> ;;;             str                     要连接的列表<br /> ;;;             delimiter       使用的分隔符<br /> ;;;------------------------------------------------------------------<br /> ;;;     返回:<br /> ;;;             一个字符串。<br /> ;;;             示例:<br /> ;;;             (setq a '("harp" "guiness" "black and tan"))<br /> ;;;             (xd-strunparse a ",")<br /> ;;;             返回:<br /> ;;;             "harp,guiness,black and tan"<br /> ;;;------------------------------------------------------------------<br /> (defun xd-string_unparse (lst delimiter / return)<br />   (setq return "")<br />   (foreach str lst<br />     (setq return (strcat return delimiter str))<br />   )<br />   (substr return 2)<br /> )<br /> ;;Author : eachy<br /> (defun xd-string_join (strlst div /)<br />   (vl-string-trim<br />     div<br />     (apply 'strcat (mapcar '(lambda (x) (strcat x div)) strlst))<br />   )<br /> )<br /> ;;应用示例<br /> (while (setq e0 (entsel "\n拾取删除图块<退出>: "))<br />   (if (and (setq el (entget (car e0)))<br />            (= (cdr (assoc 0 el)) "INSERT")<br />            (setq bn (cdr (setq b (assoc 2 el))))<br />            (not (member bn bln))<br />       )<br />     (progn<br />       (setq bln (cons bn bln))<br />       (redraw (car e0) 3)<br />       (xd-clearcset)<br />       (setq ss (ssget "X" (list '(0 . "INSERT") b)))<br />       (vla-highlight (xd-activesset) :vlax-true)<br />       (prompt (strcat "\n选中了""<br />                       (setq sbln (String_Join<br />                                    (reverse bln)<br />                                    ","<br />                                  )<br />                       )<br />                       ""块!"<br />               )<br />       )<br />     )<br />     (princ "\n选择非图块, 重新选择!")<br />   )<br /> )