明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
查看: 3771|回复: 12

[函数] [求助]用简单方法对表进行分类

  [复制链接]
发表于 2009-10-5 22:43:00 | 显示全部楼层 |阅读模式
  1. (setq a '(( "0.500" "2")( "0.500" "1")( "0.500" "1") ( "0.500" "5") ( "0.500" "4")))
  2. ;已知A有N组同样的表或不一样的表
  3. ;怎么把上面的表分成以下
  4. A1=(( "0.500" "1")( "0.500" "1"))
  5. A2=(( "0.500" "2"))
  6. A3=(( "0.500" "4"))
  7. A4=(( "0.500" "5"))
  8. ;如果有第六组继续循环A5 A6注意里面的数字进行排序
发表于 2009-10-6 07:34:00 | 显示全部楼层
有点繁琐的写法,好像有点错误,有时间再帮你调试一下。楼主可以自己修改修改。。。
  1. (setq a '(( "0.500" "2")( "0.500" "1")( "0.500" "1") ( "0.500" "5") ( "0.500" "4")))
  2. (setq i 0 c (nth i a))
  3. (repeat (length a)
  4.   (setq i (1+ i) c1 (nth i a))
  5.   (if (equal c c1)
  6.   (write-line (strcat "A" (itoa i) "=" (vl-princ-to-string (cons c (list c1)))))
  7.   (write-line (strcat "A" (itoa i) "=" (vl-princ-to-string c)))
  8.   )
  9.   (setq c c1)
  10. )
 楼主| 发表于 2009-10-6 11:22:00 | 显示全部楼层

这样不行的

发表于 2009-10-6 16:38:00 | 显示全部楼层
  1. (defun spit-lst (lst / ls)
  2.   (vl-catch-all-apply
  3.     '(lambda (/ nl l n)
  4.        (setq nl (vl-sort lst
  5.     '(lambda (a1 a2)
  6.        (< (distof (cadr a1)) (distof (cadr a2)))
  7.      )
  8.   )
  9.        )
  10.        (foreach x nl
  11.   (if (setq l (eval (read (setq n (strcat "EA_" (cadr x))))))
  12.     (set (read (strcat "EA_" (cadr x))) (cons x l))
  13.     (set (read (strcat "EA_" (cadr x))) (list x))
  14.   )
  15.   (if (not (vl-position n ll))
  16.     (setq ll (cons n ll))
  17.   )
  18.        )
  19.        (setq
  20.   ls (reverse (mapcar 'eval (mapcar 'read (vl-remove nil ll))))
  21.        )
  22.        (foreach x (vl-remove nil ll) (set (read x) nil))
  23.      )
  24.   )
  25.   ls
  26. )
 楼主| 发表于 2009-10-6 23:38:00 | 显示全部楼层
感觉不够简单
发表于 2009-10-7 12:16:00 | 显示全部楼层

看來樓主有更簡潔的,可拿出看看

to:eachy兄====為甚麼要用set??有其他用途嗎?

(set (read (strcat "EA_" (cadr x)))

 楼主| 发表于 2009-10-7 13:43:00 | 显示全部楼层
  1. (defun Class-list (&list Coding_str / n off *set_sym)
  2.   (foreach X (vl-sort &list'(lambda (e1 e2)(<(cadr e1)(cadr e2)))) ;排序
  3.     (setq n  1 off  t);辅助
  4.     (while off
  5.       (setq *set_sym (read(strcat Coding_str (vl-prin1-to-string n)))) ;获取编码
  6.       (if(eval *set_sym)
  7.         (if(equal x (car(eval *set_sym)));两个表的对比
  8.           (progn
  9.             (set (read(strcat Coding_str (vl-prin1-to-string n))) (cons x (eval *set_sym)));将相同列表加入编码,并退出循环
  10.             (setq off nil)
  11.           )
  12.         )
  13.         (progn
  14.           (set (read(strcat Coding_str (vl-prin1-to-string n))) (cons x (eval *set_sym)))
  15.           (setq off nil)
  16.         )
  17.       )
  18.       (setq n (1+ n))
  19.     )
  20.   )
  21.   (princ)
  22. )
发表于 2009-10-7 16:41:00 | 显示全部楼层
;|
(setq a '(( "0.500" "2")( "0.500" "1")( "0.500" "1") ( "0.500" "5") ( "0.500" "4")))
(ttt a "b")
检测mapcar '(lambda(x)(print(eval x))) '(b1 b2 b3 b4))
|;
  1. (defun ttt (lst str / b I X);;; by lxx 2009.10
  2.   (setq b (vl-sort lst '(lambda(x y)(<(cadr x)(cadr y))))
  3. i 0)
  4.   (while b
  5.     (setq SYM (read(strcat str (itoa i)))
  6.    x (eval SYM))
  7.     (if (member (car b) x)
  8.       (set SYM (cons (car b)x))
  9.       (set (read(strcat str (itoa (setq i(1+ i))))) (list (car b)))
  10.     )
  11.     (setq b (cdr b))
  12.     )
  13. )
其实不建议用set的方式,返回一个表就很好嘛。set占用内存,而且运行别的程序的时候可能会搞乱套
发表于 2009-10-7 17:00:00 | 显示全部楼层
狂刀出來了!
  1. ;;(SPIT-LST_LAI A)
  2. ;|
  3. (setq A '(("0.500" "2")
  4.    ("0.500" "1")
  5.    ("0.500" "1")
  6.    ("0.500" "5")
  7.    ("0.500" "4")
  8.    ("0.500" "5")
  9.    ("0.500" "7")
  10.    ("0.500" "4")
  11.    ("0.500" "4")
  12.    ("0.500" "6")
  13.    ("0.500" "8")
  14.    ("0.500" "9")
  15.    ("0.500" "10")
  16.    ("0.500" "6")
  17.   )
  18. )
  19. |;
  20. (defun SPIT-LST_LAI (A / L LST X)
  21.   (foreach X (vl-sort A
  22.         '(lambda (A1 A2)
  23.     (> (atof (cadr A1)) (atof (cadr A2)))
  24.          )
  25.       )
  26.     (if (setq L (assoc (cadr X) LST))
  27.       (setq LST (subst (list (car L) (cons X (cadr L))) L LST))
  28.       (setq LST (cons (list (cadr X) (list X)) LST))
  29.     )
  30.   )
  31.   (mapcar '(lambda (X) (cadr X)) LST)
  32. )
发表于 2009-10-8 07:47:00 | 显示全部楼层
发一个返回表的
;|
(setq a '(( "0.500" "2")( "0.500" "1")( "0.500" "1") ( "0.500" "5") ( "0.500" "4")))
(ttt a) >> ((("0.500" "1") ("0.500" "1")) (("0.500" "2")) (("0.500" "4")) (("0.500" "5")))
|;
  1. (defun ttt (a / b c);;; by lxx 2009.10
  2.    (mapcar '(lambda (x)
  3.        (if (member x b)(setq b (cons x b))(setq c (if b (cons b c) c) b (list x)))
  4.        )
  5.     (vl-sort a '(lambda(x y)(<(cadr x)(cadr y)))))
  6.   (reverse (if b (cons b c) c))
  7. )
您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号 )  
©2000-2023 明经通道 版权所有 本站代码,在未取得本站及作者授权的情况下,不得用于商业用途

GMT+8, 2024-11-6 07:22 , Processed in 0.208700 second(s), 26 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

快速回复 返回顶部 返回列表