字符串列表->数字列表

netbee · 发表于 2004-4-22 22:33:16

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

最近见有几位网友在求，在此帖给大家。
由于水平有限，有个问题没有解决，就是在字符串列表尾部必须加入一个空串，返回的数字列表中最后一个返回也是0.0。
这个多余的数据请版主及各位网友改正回帖吧。

;;-----------------
;;字符串表转换至数字表函数
(DEFUN Do_resolve (l / l1 n i x s)
(FOREACH x (REVERSE l)
;;; (IF (/=
(SETQ s (ATOF x))
;;; 0.0)
;;; (progn
(IF (SETQ N (VL-STRING-POSITION (ASCII "*") x))
(SETQ I (ATOI (SUBSTR x (+ 2 n))))
(SETQ I 1)
) ;_ 结束if
(REPEAT i (SETQ l1 (CONS S l1)))
;;; )
;;; ) ;_ 结束if
) ;_ 结束foreach
l1
) ;_ 结束defun
;;-------------------------

调用形式：

(setq test(list "2500*1" 3000*2" "4500*1" ""))
(setq l(Do_resolve test))
;;l=(2500 3000 3000 4500 0.0)

注：由于是为了轴线绘制而编制的，所以每一组字符串都要表示为间距乖以个数的形式。且为了编程的方便，在字符串列表的最后要加一个空串，然后生成的数字表最后为0.0，应在使用中删除。
--------------------
其实只要你分析过上面的程序就可以修改它的，你可以让个数在前面，而间距在后面，或直接就不要个数了!

陌生人 · 发表于 2004-4-22 23:27:36

字符串列表尾部必须加入一个空串。
为什么？标志位么？

(DEFUN Do_resolve (l / l1 n i x s)
(FOREACH x (REVERSE l)
(SETQ s (ATOF x))
(IF (SETQ N (VL-STRING-POSITION (ASCII "*") x))
(SETQ I (ATOI (SUBSTR x (+ 2 n))))
(SETQ I 1)
) ;_ 结束if
(if n (REPEAT i (SETQ l1 (CONS S l1)))) ;or (if (/= s 0)...)
) ;_ 结束foreach
l1
) ;_ 结束defun
(setq test(list "2500*1" "3000*2" "4500*1" ""))
(setq l(Do_resolve test))
;;l=(2500 3000 3000 4500);是这个意思么？

netbee · 发表于 2004-4-23 08:23:01

我的意思就是这样。

aeo · 发表于 2004-4-24 19:06:11

"1200 2*3400 1800 7*3400 400"
目标-->'((1200)(2 3400)(1800)(7 3400)(400))
首先对空格分
再对*分.

[php]
(defun cut(str char / a new return)
(setq str (vl-string->list str))
(while str
   (setq a(car str)
         str(cdr str)
   )
   (if(=(ascii char)a)
      (if new(setq return(cons (reverse new)return) new nil))
      (setq new(cons a new ))
))
(if new(setq return(cons (reverse new)return)))
(mapcar ' vl-list->string(reverse return))
)
[/php]
[php]
test:
命令: (cut "1200 2*3400 1800 7*3400 3600" " ")
("1200" "2*3400" "1800" "7*3400" "3600")

命令: (cut "1200 2*3400 1800 7*3400 3600" "*")
("1200 2" "3400 1800 7" "3400 3600")
[/php]

[php]
;;;画轴线中的运用:
(defun c:test( / dis len no p p1 p2 str x y)
  (setq str "1200 2*3400 1800 7*3400 3600"
      len 0)
  (setq str (mapcar '(lambda(x)(cut x "*"))(cut str " ") ))

  (setq str (mapcar '(lambda (x) (mapcar 'atoi x))str))    ;;这就是要的.

  (setq len(apply '+(mapcar '(lambda(x / y)
            (if(setq y(cadr x))(*(car x)y)(car x)))str))) ;;总长度
  (setq p1(getpoint "\nBase:")
      p2 (polar p1(/ pi 2 )len) )
  (command "line" p1 p2 "")
  (mapcar
'(lambda(p)
   (if(setq dis(cadr p))(setq no (car p))(setq no 1 dis(car p)));重复次数，偏移距离
   (repeat no                   ;画出来
         (setq p1(polar p1 0 dis)
               p2(polar p2 0 dis)
         )
      (command "line" p1 p2 "")
   )
   ) str
  )
)
[/php]

aeo · 发表于 2004-4-24 20:25:30

r14:
(defun vl-string->list (str / no li)
(setq no 0)
(repeat(strlen str)(setq li(cons (ascii(substr str(setq no(1+ no))1))li )))
(reverse li)
)

陌生人 · 发表于 2004-4-24 21:54:54

[php]
(defun axstr->l (str / str2)
  (setq str (strcat "(" str ")"))
  (while (/= str (setq str2 (vl-string-subst ")(" " " str)))(setq str str2))
  (while (/= str (setq str2 (vl-string-subst " " "*" str)))(setq str str2))
  (apply 'append (mapcar '(lambda (x) (if x (list x) nil)) (read (strcat "(" str ")"))));;处理多个空格的情况.
)
;|测试:
(setq str "1200 3400*2 1800 3400*3 400")
(setq lst (axstr->l str)) ->((1200) (3400 2) (1800) (3400 3) (400))
|;

(defun axl->xl (lst / lst2 a)
  (apply 'append
  (mapcar '(lambda (x) (setq a (car x) lst2 nil)
      (if (setq n (cadr x))
         (repeat n (setq lst2 (cons a lst2)))
         (list a)
      )
   ) lst
  ))
)
;|测试:
(setq lst '((1200) (3400 2) (1800) (3400 3) (400)))
(setq lst (axl->xl lst)) －>(1200 3400 3400 1800 3400 3400 3400 400)
|;
[/php][php]
;轴线绘制.for example.
(defun c:test (/ str lst pt1 pt2 perang)
  (vl-cmdf ".undo" "be")
  (setq str "1200 3400*2 1800 3400*3 400"
      lst (axl->xl (axstr->l str))
pt1  (getpoint "\n起点:")
pt2  (getpoint pt1 "\n终点:")
      perang (-  (angle pt1 pt2)(* 0.5 PI)))
  (vl-cmdf ".line" pt1 pt2 "")
  (mapcar '(lambda (x) (vl-cmdf ".line" (setq pt1 (polar pt1 perang x))(setq pt2 (polar pt2 perang x)) ""))lst)
  (vl-cmdf ".undo" "e")
  (princ)
)
[/php]

aeo · 发表于 2004-4-24 23:44:26

axstr->l
只能是正对这个问题的. 如果原string有“()”出现，显然是不能这么写。
写公用的东东没必要为了省一点时间就简单处理一下。毕竟其他地方还要用的.

陌生人 · 发表于 2004-4-25 02:34:01

如果有“（）”出现，调用cut该怎么写？倒想瞧瞧这个通用函数怎么显神通！

字符串里面可能出现的情况很多。就算某些情况通用，范围也是很有限的。
因为考虑到写轴线时候的字符串格式比较通用，因此，的确这段程序是针对性很强的。
如果有“（）”，那还写什么程序？
直接read或者（read （strcat “（” str “）”））就行了

aeo · 发表于 2004-4-25 20:16:50

我写的相当于strtok（不全面）,不管哪种语言，都有它的一个版本.
你可strtok关键字找一下，xdapi里也有.

你当然可以针对问题写一个，但我不会学你。那不累死了.

干脆写完整:
[php]
(defun cut(str char / a new return chrs)
(setq str (vl-string->list str)
         chrs(vl-string->list char)
)
(while str
   (setq a(car str)
         str(cdr str)
   )
   (if(member a chrs)
      (if new(setq return(cons (reverse new)return) new nil))
      (setq new(cons a new ))
))
(if new(setq return(cons (reverse new)return)))
(mapcar ' vl-list->string(reverse return))
)
[/php]
test:
命令: (cut "ab c;er\\we[qw" " ;\\[")
("ab" "c" "er" "we" "qw")

陌生人 · 发表于 2004-4-27 18:50:29

重点是提供另外一种思路，而不是是不是通用函数.
[php]
(defun str2lst (str pat / i str1 lst)
  (setq i 0 str1 "")
  (while (/= "" (setq s (substr str (setq i (+ i 1)) 1)))
(setq str1 (strcat str1 (if (wcmatch s pat) "\"\"" s)))
  )
  (setq lst (read (strcat "(\"" str1 "\")")))
  (apply 'append (mapcar '(lambda(x)(if (= "" x) nil (list x))) lst))
)
[/php]
测试:

(str2lst "wo \洒扫大; 43*21 23]4'1{.43\1a" "~@") -> ("wo" "a")
(str2lst "wo \洒扫大; 43*21 23]4'1{.43\1a" "],[{'* ]") -> ("wo" "洒扫大;" "43" "21" "23" "4" "1" ".43\001a")

aeo · 发表于 2004-4-27 19:11:09

(STR2LST "232s\"\"3(wdfa)tt,we" "s,")
("232" "3(wdfa)tt" "we")

把() 转到 \"\"
,双引号的机会确实很少.

aeo · 发表于 2004-4-27 22:47:36

只有wcmatch才有*,*的格式。
wcmatch是一个很高级的东东，我学vba的时候，一处理到字符就想起它，要写成这样一个东东很不容易呀。到现在也没搞懂vb里怎么处理，是不是要api支持。

lisp处理字符不是强项，所以我会马上转成表。表才是强项呀。(字符就是数组)

cy956 · 发表于 2004-4-27 22:48:00

贴一个以前写的，应该在001时贴过。没用vl函数。

(defun str-sb(str / IN JN STR1 ZCB ZCT ZCW)
;;;数字字串转为数字表 (str-sb "12*2 13")-->(12.0 12.0 13.0)
(setq str(strcat str " ")
in 1 jn 0 zcb '())
(while (/= (setq str1(substr str in 1)) "")
(cond
((= str1 "*")
(setq zct(substr str (- in jn) jn)
in(1+ in)jn 0)
(while(/= " " (substr str in 1))
(setq in (1+ in)jn (1+ jn)))
(setq zcw (substr str (- in jn) jn)
in (1+ in) jn 0)
(repeat (atoi zcw)
(setq zcb(append zcb (list zct)))
))
((= str1 " ")
(setq zct (substr str (- in jn) jn)
in(1+ in)jn 0)
(if (/= zct "")(setq zcb(append zcb (list zct)))))
(t (setq in(1+ in)jn (1+ jn)))
)
)(mapcar 'atof zcb)
)

陌生人 · 发表于 2004-4-29 01:09:33

(str2lst "232s3(wdfa)tt,we" "[()`,]")
->("232s3" "wdfa" "tt" "we")
(STR2LST "232s\"3(wdfa)\"tt,we" "[()],`,")
->("232s" 3 WDFA "tt" "we")

aeo · 发表于 2004-4-29 21:30:43

最初由陌生人发布
[B](str2lst "232s3(wdfa)tt,we" "[()`,]")
->("232s3" "wdfa" "tt" "we")
(STR2LST "232s\"3(wdfa)\"tt,we" "[()],`,")
->("232s" 3 WDFA "tt" "we") [/B]

你把帖子删了，自己也发现不对了?

我给你想了个法子。

下面解决了，其实" 就再注释掉

(defun str2lst (str pat / i str1 lst)
(setq i 0 str1 "" )
(while (/= "" (setq s (substr str (setq i (+ i 1)) 1)))
(setq str1 (strcat str1
(cond((wcmatch s pat)(strcat """"))
((= """ s)"\\"")
(t s)
)))
)
(setq lst (read (strcat "("" str1 "")")))
(apply 'append (mapcar '(lambda(x)(if (= "" x) nil (list x))) lst))
)

命令: (STR2LST "232s\"\"3(wdfa)\"tt,we" "[\")],`,")
("232s" "3(wdfa" "tt" "we")

命令: (STR2LST "232s\"\"3(wdfa)\"tt,we" "[)],`,")
("232s\"\"3(wdfa" "\"tt" "we")

账号		自动登录	找回密码
密码			立即注册

[群策群力] 字符串列表->数字列表

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

相关帖子