Topic: Make strange string in to a list?

[jeff101217]

hi! everybody,i have a question as follow,need your help

i use autolisp created these strings by reading a text data as follow;

"*jsyq_g_list*G1*G2*G3*G4*G5*"
"*jsyq_p_list*P1*P2*P3*P4*P5*P6*"
"*jsyq_e_list*E1*E2*E3*E4*E5*E6*E7*"
"*jsyq_m_list*M1*M2*M3*M4*M5*M6*M7*M8*"
"*jsyq_h_list*H1*H2*H3*H4*H5*H6*H7*H8*H9*"
"*jsyq_b_list*B1*B2*B3*B4*B5*B6*B7*B8*B9*B10*"

i want change these strings in to string lists as follow

("jsyq_g_list""G1""G2""G3""G4""G5")
("jsyq_p_list""P1""P2""P3""P4""P5""P6")
("jsyq_e_list""E1""E2""E3""E4""E5""E6""E7")
("jsyq_m_list""M1""M2""M3""M4""M5""M6""M7""M8")
("jsyq_h_list""H1""H2""H3""H4""H5""H6""H7""H8""H9")
("jsyq_b_list""B1""B2""B3""B4""B5""B6""B7""B8""B9""B10")

i though this problem for a few days ,can't get the ansewer,
is there any easy ways to solve this?

thanks!

[MP]

What was the original question posed by your teacher?

[jeff101217]

What was the original question posed by your teacher?

not my teacher's question , i want have a program which can read some items with some rules in the textbook,and put these items in to a dcl list box;

[MP]

Show us what have you developed so far.

[jeff101217]

Show us what have you developed so far.

my program ,

(defun jsyq_read_basic_data()
  (setq jsyq_read_data_circle_check 0)
  (setq jsyq_read_data_text (open "c:\\lisp\\Datas\\jsyq_datas.txt" "r"))
  (setq jsyq_data_list '() jsyq_read_str 0)
  (while (= jsyq_read_data_circle_check 0)
    (if (/= jsyq_read_str nil)
      (progn
   (setq jsyq_read_str (read-line jsyq_read_data_text))
   (setq jsyq_data_list (cons jsyq_read_str jsyq_data_list))
   )
   (setq jsyq_read_data_circle_check 1)
      )
    )
  (setq jsyq_data_list (cdr jsyq_data_list))
  (setq jsyq_data_basic_g_list (cadr (cddddr jsyq_data_list)))
  (setq jsyq_data_basic_p_list (car (cddddr jsyq_data_list)))
  (setq jsyq_data_basic_e_list (car (cdddr jsyq_data_list)))
  (setq jsyq_data_basic_m_list (car (cddr jsyq_data_list)))
  (setq jsyq_data_basic_h_list (car (cdr jsyq_data_list)))
  (setq jsyq_data_basic_b_list (car jsyq_data_list))
  
  )

the items in the textbook

*jsyq_g_list*G1*G2*G3*G4*G5*
*jsyq_p_list*P1*P2*P3*P4*P5*P6*
*jsyq_e_list*E1*E2*E3*E4*E5*E6*E7*
*jsyq_m_list*M1*M2*M3*M4*M5*M6*M7*M8*
*jsyq_h_list*H1*H2*H3*H4*H5*H6*H7*H8*H9*
*jsyq_b_list*B1*B2*B3*B4*B5*B6*B7*B8*B9*B10*

[VovKa]

Code: [Select]

(defun vk_StringSubstPat (NewPattern Pattern String / Pos NewPatternLen)
  (setq NewPatternLen (strlen NewPattern))
  (while (setq Pos (vl-string-search Pattern String Pos))
    (setq String (vl-string-subst NewPattern Pattern String Pos))
    (setq Pos (+ Pos NewPatternLen))
  )
  String
)
(mapcar
  (function
    (lambda (s)
      (read (strcat "(\"" (vk_StringSubstPat "\"\"" "*" (vl-string-trim "*" s)) "\")")
      )
    )
  )
  (list "*jsyq_g_list*G1*G2*G3*G4*G5*"
"*jsyq_p_list*P1*P2*P3*P4*P5*P6*"
"*jsyq_e_list*E1*E2*E3*E4*E5*E6*E7*"
"*jsyq_m_list*M1*M2*M3*M4*M5*M6*M7*M8*"
"*jsyq_h_list*H1*H2*H3*H4*H5*H6*H7*H8*H9*"
"*jsyq_b_list*B1*B2*B3*B4*B5*B6*B7*B8*B9*B10*"
  )
)


[jeff101217]

Code: [Select]

(defun vk_StringSubstPat (NewPattern Pattern String / Pos NewPatternLen)
  (setq NewPatternLen (strlen NewPattern))
  (while (setq Pos (vl-string-search Pattern String Pos))
    (setq String (vl-string-subst NewPattern Pattern String Pos))
    (setq Pos (+ Pos NewPatternLen))
  )
  String
)
(mapcar
  (function
    (lambda (s)
      (read (strcat "(\"" (vk_StringSubstPat "\"\"" "*" (vl-string-trim "*" s)) "\")")
      )
    )
  )
  (list "*jsyq_g_list*G1*G2*G3*G4*G5*"
"*jsyq_p_list*P1*P2*P3*P4*P5*P6*"
"*jsyq_e_list*E1*E2*E3*E4*E5*E6*E7*"
"*jsyq_m_list*M1*M2*M3*M4*M5*M6*M7*M8*"
"*jsyq_h_list*H1*H2*H3*H4*H5*H6*H7*H8*H9*"
"*jsyq_b_list*B1*B2*B3*B4*B5*B6*B7*B8*B9*B10*"
  )
)


thanks a lot~

[Lee Mac]

Another 

Code: [Select]

(defun StringStrip (str)
  ;; Lee Mac  ~  01.04.10

  (defun StringParser (str del)
    (if (setq pos (vl-string-search del str))
      (cons (substr str 1 pos)
            (StringParser (substr str (+ pos 1 (strlen del))) del))
      (list str)))

  (StringParser (vl-string-trim "*" str) "*"))


Code: [Select]

(StringStrip "*jsyq_g_list*G1*G2*G3*G4*G5*")
==> ("jsyq_g_list" "G1" "G2" "G3" "G4" "G5")


[alanjt]

I want to play...

Code: [Select]

;;; Convert string to list, based on separator
;;; #Str - String to convert
;;; #Sep - Separator to break string into items
;;; Ex. - (AT:Str2Lst "1,2,3" ",") -> '("1" "2" "3")
;;; Alan J. Thompson, 11.11.09 / 04.01.10
(defun AT:Str2Lst (#Str #Sep / #Inc #List #Str)
  (while (setq #Inc (vl-string-search #Sep #Str))
    (setq #List (cons (substr #Str 1 #Inc) #List))
    (setq #Str (substr #Str (+ 2 #Inc)))
  ) ;_ while
  (vl-remove "" (reverse (cons #Str #List)))
) ;_ defun
Result:

Code: [Select]

(at:str2lst "*jsyq_g_list*G1*G2*G3*G4*G5*" "*")
("jsyq_g_list" "G1" "G2" "G3" "G4" "G5")

Updated last line of code.

[CAB]

Code: [Select]

  ;;++++++++++++++++++
  ;;  parser by CAB 
  ;;++++++++++++++++++
  (defun sparser (str delim / ptr lst)
    (while (setq ptr (vl-string-search delim str))
      (setq lst (cons (substr str 1 ptr) lst))
      (setq str (substr str (+ ptr 2)))
    )
    (reverse (cons str lst))
  )

[alanjt]

LoL
Alan, we basically have the same thing.
However, I'm not sure why I appended mine instead of using cons. :ugly:

[CAB]

I was looking for the original thread on this subject but could not find it but did find these:

http://www.theswamp.org/index.php?topic=12985.0
http://www.theswamp.org/index.php?topic=19527.0

[alanjt]

The Counterpart: (Can't believe I never wrote one of these.)

Code: [Select]

;;; Convert List to String
;;; L - List to process
;;; S - Separator
;;; Ex. (AT:Lst2Str '("A" "B" "C") ",") -> "A,B,C"
;;; Alan J. Thompson, 04.01.10
(defun AT:Lst2Str (L S)
  (if (cdr L)
    (strcat (vl-princ-to-string (car L)) S (AT:Lst2Str (cdr L) S))
    (vl-princ-to-string (car L))
  ) ;_ if
) ;_ defun


[T.Willey]

Here is another way Alan.

Code: [Select]

(apply 'strcat (mapcar (function (lambda ( a ) (strcat a ","))) '("a" "b" "c")))

Granted you convert yours to a string, but that is easy enough also.

[alanjt]

Here is another way Alan.

Code: [Select]

(apply 'strcat (mapcar (function (lambda ( a ) (strcat a ","))) '("a" "b" "c")))

Granted you convert yours to a string, but that is easy enough also.

I've used something similar to that before when creating an ssget layer filter. Problem is, you end up with a trailing ",".

[T.Willey]

Thought that might be a concern.  Oh well.  But in the interest of cat skinning.

Code: [Select]

((lambda ( s ) (substr s 1 (1- (strlen s))))(apply 'strcat (mapcar (function (lambda ( a ) (strcat a ","))) '("a" "b" "c"))))


[alanjt]

Thought that might be a concern.  Oh well.  But in the interest of cat skinning.

Code: [Select]

((lambda ( s ) (substr s 1 (1- (strlen s))))(apply 'strcat (mapcar (function (lambda ( a ) (strcat a ","))) '("a" "b" "c"))))


Nice.

[VovKa]

Code: [Select]

(substr (apply 'strcat (mapcar (function (lambda ( a ) (strcat "," a))) '("a" "b" "c"))) 2)

[CAB]

Code: [Select]

(mapcar (function (lambda(x) (setq str (cond (str (strcat str "," x))(x))))) strlist)

[alanjt]

Well now I fell dumb. LoL

[ElpanovEvgeniy]

Code: [Select]

(apply 'strcat (mapcar 'strcat '("a" "b" "c") '("," "," "")))

[Lee Mac]

Code: [Select]

(defun Str-Make (lst del / str x)
  (setq str  (car lst))
  (foreach x (cdr lst) (setq str (strcat str del x)))
str)


Code: [Select]

(defun Str-Make (lst del / str)
  (setq str (car lst))
  (while (setq lst (cdr lst)) (setq str (strcat str del (car lst))))
str)


[alanjt]

Code: [Select]

(defun Str-Make (lst del / str x)
    (setq str  (car lst))
    (foreach x (cdr lst) (setq str (strcat str del x)))
  str)


Code: [Select]

(defun Str-Make (lst del / str)
  (setq str (car lst))
  (while (setq lst (cdr lst)) (setq str (strcat str del (car lst))))
  str)


Very cool Lee! And to think, I was pretty happy with my recursive one.

[Lee Mac]

Very cool Lee! And to think, I was pretty happy with my recursive one.

Thanks Alan, just adding to the mix 

[CAB]

Just wrapped

Code: [Select]

(defun Str-Make (lst del / str)
  (mapcar (function (lambda(s) (setq str (if str (strcat str del s) s)))) lst)
  str
)

Code: [Select]

(defun Str-Make (lst del / str f)
  (apply 'strcat (mapcar (function (lambda (s) (setq f (if f (strcat del s) s)))) lst))
)

[KewlToyZ]

 

[alanjt]

That's just Silly.

[CAB]

Looks like someone working on "String Theory"

[jeff101217]

Another  

Code: [Select]

(defun StringStrip (str)
  ;; Lee Mac  ~  01.04.10

  (defun StringParser (str del)
    (if (setq pos (vl-string-search del str))
      (cons (substr str 1 pos)
            (StringParser (substr str (+ pos 1 (strlen del))) del))
      (list str)))

  (StringParser (vl-string-trim "*" str) "*"))


Code: [Select]

(StringStrip "*jsyq_g_list*G1*G2*G3*G4*G5*")
==> ("jsyq_g_list" "G1" "G2" "G3" "G4" "G5")


  great!

[jeff101217]

thanks a lot every one , i think this problem is solved;and  i got some new thought .

[Lee Mac]

You're welcome Jeff

You've now got plenty of examples to learn from 

[qjchen]

Hi thanks for all your contribution~

Because I often need to deal with txt data, so the delim is not only one char, but maybe like " \t\n,;"

(" \t\n,;" means " " "\t" "n" "," ";"  can all be delims)

so, for a delim represent more than one char, I write such code, I hope you can shorten it

Code: [Select]

;;;by qjchen@gmail.com
(defun q:str:delim(str delim / l1 l2)
  (setq str (vl-string->list str) delim (vl-string->list delim))
  (while str
    (if (not (member (car str) delim))
             (setq l1 (cons (car str) l1))
             (if l1 (setq l2 (cons (vl-list->string (reverse l1)) l2) l1 nil))
    )
    (setq str (cdr str))
  )
  (if l1 (setq l2 (cons (vl-list->string (reverse l1)) l2)))
  (reverse l2)
)

(q:str:delim "a,bb c\tdd\ne" " ,\t\n")
(q:str:delim "a,bb c\tdd\ne" " ,\t\n")=> ("a" "bb" "c" "dd" "e")

before I wrote this my own code, I always use the following std-lib function, it can be used in Autocad R14

Code: [Select]

(defun STD-STRING->LIST (s / lst)
  (if (= (type s) 'STR)
    (while (/= s "")
      (setq lst (cons (ascii (substr s 1 1)) lst) s (substr s 2))
    )
  )
  (reverse lst)
)
(defun STD-STRTOK (s delims / len s1 i c lst)
  (setq delims (std-string->list delims)
len (strlen s) s1 "" i (1+ len)
  )
  (while (> (setq i (1- i)) 0)
    (setq c (substr s i 1))
    (if (member (ascii c) delims)
      (if (/= s1 "") (setq lst (cons s1 lst) s1 ""))
      (setq s1 (strcat c s1))
    )
  )
  (if (/= s1 "") (cons s1 lst) lst)
)


(STD-STRTOK "a,bb c\tdd\ne" " ,\t\n")


[CAB]

Maybe this?

http://www.theswamp.org/index.php?topic=22034.msg265916#msg265916

[JohnK]

>  ... std-lib ...
Reini Urban's or Vladimir Nesterovsky's lib(s) is a very good resource to learn from.

[qjchen]

Maybe this?

http://www.theswamp.org/index.php?topic=22034.msg265916#msg265916

Alan, it seems not the all the same as this post.

in my code, the delim need not to be multi continuous char, but like a list of delim,

" \t\n,;" means " " "\t" "\n" "," ";"  can all be delim separately, need not to be adjacent.

sorry for my poor English, I am not sure can you understand my meaning.

To Seven: I also learn a lot from Reini Urban's STD-LIB function.

[hermanm]

Code: [Select]

;;;-------------------strtok------------
;;;creates a list of tokens from a delimited string
;;;delim must be one distinct character, but may be repeated
;;;-----------------------------------------
(defun strtok (str delim / out pos)
  (setq delim (ascii delim))
  (while (setq pos (vl-string-position delim str))
    (if (> pos 0);not just adjacent delimiters
      (setq out (cons (substr str 1 pos) out))
    )
    (setq str (substr str (+ 2 pos)))
  )
  (if (> (strlen str) 0);not a trailing delimiter
    (reverse (cons str out))
    (reverse out)
  )
);strtok


Code: [Select]

Command: (strtok "*jsyq_p_list*P1*P2*P3*P4*P5*P6*" "*")
("jsyq_p_list" "P1" "P2" "P3" "P4" "P5" "P6")


[Lee Mac]

Perhaps:

Code: [Select]

(defun LM:StringParser ( str del )
  ;; © Lee Mac  ~  14.06.10
  (if (setq pos (vl-string-search del str))
    (vl-remove ""
      (cons (substr str 1 pos)
        (LM:StringParser
          (substr str (+ pos 1 (strlen del))) del
        )
      )
    )
    (list str)
  )
)


[efernal]

I use this...

Code - Auto/Visual Lisp: [Select]

1. (DEFUN ef_destrincha (string chars / cn id sn lista saida)
2.   (SETQ sn    (STRLEN string)
3.         cn    1
4.         saida ""
5.         lista nil
6.   )
7.   (REPEAT sn
8.     (SETQ id   (CAR chars)
9.           char (SUBSTR string cn 1)
10.     )
11.     (IF (/= char id)
12.       (SETQ saida (STRCAT saida char)
13.             cn    (1+ cn)
14.       )
15.       (SETQ string (SUBSTR string (1+ cn))
16.             lista  (APPEND lista (LIST saida))
17.             saida  ""
18.             cn     1
19.             chars  (IF chars
20.                      (CDR chars)
21.                      nil
22.                    )
23.       )
24.     )
25.   )
26.   (IF (AND string (> (STRLEN string) 0))
27.     (SETQ lista (APPEND lista (LIST string)))
28.   )
29.   lista
30. )
31.  
32. (ef_destrincha
33.   "Vamos:ver o que|podemos fazer com[esta rotina de \"ef_destrincha\"]baseada em listas"
34.   '(":" "|" "[" "]")
35. )
36. (ef_destrincha
37.   "Let's see:what we can do|with this[\"ef_destrincha\" routine]based on lists"
38.   '(":" "|" "[" "]")
39. )
40. ;;      returns
41. ("Vamos" "ver o que" "podemos fazer com" "esta rotina de \"ef_destrincha\"" "baseada em listas")
42. ("Let's see" "what we can do" "with this" "\"ef_destrincha\" routine" "based on lists")
43.