表内归类和分拆

皇上快溜

有这样一個表
((B 3)  (A 1)  (B 4) (C 9) (A 6) (B 1)(D 6))
把它拆成下面两个表
其一( ((B 3)(B 4) (B 1)) ((A 1)(A 6)) )
其二((C 9) (D 6))
这种循环结构，想了几天，也个头绪。哪位高人可以帮弄一个，或给点思路。

sniper1111

可以先提取'(A B C D ).然后对这表中的原图逐一判别，将头部详图的表合成一个。

guosheyang

先用vl-symbol-name将符号转字符串   再用vl-remove-if-not  vl-remove-if 函数将不需要的剔除掉  

vitalgg

1. (setq lst '((B 3)  (A 1)  (B 4) (C 9) (A 6) (B 1)(D 6)))
   
2. (setq lst (vl-sort lst '(lambda (x y)(< (vl-symbol-name (car x))(vl-symbol-name(car y))))))
   
3. (setq res (list:group-by lst '(lambda (x y)(= (car x)(car y)))))
   
4. 
   
5. ;; 第一个要求
   
6. (setq res1 (vl-remove-if-not '(lambda (x)(> (length x) 1)) res))
   
7. ;; 第二个要求
   
8. (setq res2 (mapcar 'car (vl-remove-if-not '(lambda (x)(= (length x) 1)) res)))
   
9. 
   

(setq lst '((B 3)  (A 1)  (B 4) (C 9) (A 6) (B 1)(D 6)))<br /> (setq lst (vl-sort lst '(lambda (x y)(< (vl-symbol-name (car x))(vl-symbol-name(car y))))))<br /> (setq res (list:group-by lst '(lambda (x y)(= (car x)(car y)))))<br /> <br /> ;; 第一个要求<br /> (setq res1 (vl-remove-if-not '(lambda (x)(> (length x) 1)) res))<br /> ;; 第二个要求<br /> (setq res2 (mapcar 'car (vl-remove-if-not '(lambda (x)(= (length x) 1)) res)))<br /> <br />

;; 将 res 中长度大于1 的为你的第一个要求，等于1的为你的第二个要求






https://gitee.com/atlisp/atlisp-lib
@lisp 开源函数库，大量函数期待您的开发与维护。众多开发者协同开发与维护，你不再是一个人在战斗。

在CAD中执行
(@:updatelib)
实时更新函数库。

本贴函数 list:group-by 源码注意目录结构 函数组list  函数名 group-by)
https://gitee.com/atlisp/atlisp- ... c/list/group-by.lsp

liuhe

这个A  是变量名  还是变量的值。如果是变量值就很简单，如果是变量名建议换成字符串储存变量名，不然会经常会赋值，对于系统来说A是默认求值