已解决：AB两列数据，A列是类型，B列是数量，如何归类并对每类求和。

dragoon33333

求助：AB两列数据，A列是类型，B列是数量，如何归类并对每类求和。
已经嵌套了5层repeat、6层if了，绕进去了，想求教下大神思路。
见附图：求不同壁厚的管道长度。
壁厚类型不一定就这些，也可能更多，每个壁厚后面都带着长度，最后将每个壁厚对应的长度和求出。
根据本帖跟帖的多位好友的协助，自己重新整理了下思路，已经实现了统计功能。顺延了自己求助前的思路，嵌套比较多。

•   (setq wtb (ssget "w" '(5272.0 533.0 0.0) '(5312.0 85.0 0.0) '((8 . "弯管明细") (0 . "text,mtext") (1 . "~*[~.0-9]*")))) ;选择弯头壁厚明细
•   (setq wtc (ssget "w" '(5312.0 533.0 0.0) '(5352.0 85.0 0.0) '((8 . "弯管明细") (0 . "text,mtext") (1 . "~*[~.0-9]*")))) ;选择弯头长度明细
•   (if (= wtb nil)
•     (princ "无弯头明细")
•     (progn
•       (setq wtbn (sslength wtb))
•       (setq i -1 enb nil)
•       (repeat wtbn
•         (setq i (1+ i))
•         (setq wtbnn (caddr (assoc 10 (entget (ssname wtb i)))))
•         (setq wtba (cdr (assoc 1 (entget (ssname wtb i)))))
•         (setq j -1 slb nil)
•         (repeat wtbn
•           (setq j (1+ j))
•           (setq wtcnn (caddr (assoc 10 (entget (ssname wtc j)))))
•           (setq wtca (atof (cdr (assoc 1 (entget (ssname wtc j))))))
•           (if (= wtbnn wtcnn)
•             (setq slb (list wtba wtca));构造壁厚、长度表
•           )
•         )
•         (setq enb (cons slb enb));构造包含壁厚长度表的表
•       )
•       (setq qhjg 'nil)
•       (foreach zb enb
•         (if (setq cxjg (assoc (car zb) qhjg))
•           (setq qhjg (subst (list (car zb) (+ (cadr cxjg) (cadr zb))) cxjg qhjg))
•           (setq qhjg (cons zb qhjg))
•         )
•       )
•       (setq qhjg (vl-sort qhjg '(lambda(x1 x2)(< (car x1) (car x2)))))
•       ;可以这样(setq qhjg (vl-sort qhjg '))))
•       (setq slbl (length qhjg))
•     )
•   );热煨壁厚数量
•   (setq wy (ssget "_w" '(5132.0 1005.0 0.0) '(5292.0 861.0 0.0) '((0 . "TEXT,MTEXT")))) ;选择弯头用量
•   (if wy
•     (progn
•       (setq o 0)
•       (repeat (sslength wy)
•         (setq wyt (entget (ssname wy o)))
•         (setq o (+ 1 o))
•         (setq rwyg (cdr (assoc 1 wyt))) ;选择的文字内容
•         (if (= rwyg "热煨弯管用管")
•           (progn
•             (setq wzx (caddr (assoc 10 wyt)))
•             (setq wym (ssget "_w" (list 5132.0 wzx 0.0) '(5292.0 861.0 0.0) '((0 . "TEXT,MTEXT")))) ;进一步选择弯头明细
•             (setq wyml (sslength wym))
•             (if (= wyml slbl)
•               (progn
•                 (setq p 0)
•                 (repeat wyml
•                   (setq entn (entget (ssname wym p)))
•                   (setq bhmx (list 10 5338.0 (caddr (assoc 10 entn)) 0.0))
•                   (setq p (+ 1 p))
•                   (setq typeb (cdr (assoc 1 entn))) ;选择的文字内容
•                   (setq typeb-len (strlen typeb)) ;选择的文字内容的长度
•                   (setq q 0)
•                   (repeat slbl
•                     (setq bh (nth q qhjg))
•                     (setq char-blen (strlen (strcat "X" (car bh)))) ;取得要找的文字的长度
•                     (setq q (+ 1 q))
•                     (setq r 1)
•                     (repeat typeb-len
•                       (setq char-bb (substr typeb r char-blen));查找选择的文字内容里是否有要被替换的文字
•                       (if (= char-bb (strcat "X" (car bh)))
•                         (progn
•                           (setq tjsl (ssget "X" (LIST (CONS 0 "*text") bhmx)))
•                           (setq tjsln (entget (ssname tjsl 0)))
•                           (entmod (subst (cons 1 (rtos (cadr bh))) (assoc 1 tjsln) tjsln))
•                         )
•                       )
•                       (setq r (1+ r))
•                     )
•                   )
•                 )
•               )
•               (alert "弯头统计数量与明细不一致！")
•             )
•           )
•         )
•       )
•     )
•   )
  

yshf

试用以下程序:

2. (defun c:flqh()
   
3.   (command "_undo" "be")
   
4. 
   
5.   (defun tqsjzb(Xssa Xn / i n Xtymb)
   
6.        (setq i 0   n (sslength Xssa)  Xtymb ni)
   
7.        (repeat n
   
8.             (setq ent (ssname Xssa i)
   
9.                   dxf (entget ent)
   
10.             )
    
11.             (if (= Xn 0)
    
12.                 (setq Xtymb (cons (list (cdr (assoc 1 dxf)) (cdr (assoc 10 dxf))) Xtymb))
    
13.                 (setq Xtymb (cons (list (cdr (assoc 1 dxf)) (cdr (assoc 10 dxf)) ent) Xtymb))
    
14.             )
    
15.             (setq i (1+ i))
    
16.        )
    
17.       
    
18.        (setq Xtymb (vl-sort Xtymb '(lambda(e1 e2)
    
19.                                           (setq pt1 (cadr e1)
    
20.                                                 pt2 (cadr e2)
    
21.                                           )
    
22.                                           (if (equal (cadr pt1) (cadr pt2) 2.0)
    
23.                                               (< (car pt1) (car pt2))
    
24.                                               (> (cadr pt1) (cadr pt2))
    
25.                                           )
    
26.                                       )
    
27.                       )
    
28.        )
    
29.   )
    
30.   
    
31.   (if (progn
    
32.           (princ "\n请选取要统计的数据:")
    
33.           (setq ssa (ssget '((0 . "*text") (1 . "#*#"))))
    
34.       )
    
35.       (if (progn
    
36.              (princ "\n请选取更新的数据:")
    
37.              (setq ssb (ssget '((0 . "*text") (1 . "#*#壁厚管材,#*#"))))
    
38. 
    
39.          )
    
40.           (progn
    
41.               (setq tymba (tqsjzb ssa 0))
    
42.               (setq tymbb (tqsjzb ssb 1))
    
43.                     
    
44.               (setq sjb nil)
    
45.               (while tymba
    
46.                    (setq sjb (cons (list (car (car tymba)) (car (cadr tymba))) sjb))
    
47.                    (setq tymba (cdr (cdr tymba)))
    
48.               )
    
49.               (setq qhjg 'nil)
    
50.               (foreach zb sjb
    
51.                    (if (setq cxjg (assoc (car zb) qhjg))
    
52.                        (setq qhjg (subst (list (car zb) (+  (cadr cxjg) (read (cadr zb)))) cxjg qhjg))
    
53.                        (setq qhjg (cons (list (car zb) (read (cadr zb))) qhjg))
    
54.                    )
    
55.               )
    
56.               (setq qhjg (vl-sort qhjg '(lambda(x1 x2)(< (car x1) (car x2)))))
    
57.               (setq Newsjb nil)
    
58.               (while tymbb
    
59.                    (setq Newsjb (cons (list (car (car tymbb)) (last (cadr tymbb))) Newsjb))
    
60.                    (setq tymbb (cdr (cdr tymbb)))
    
61.               )
    
62.               (foreach zb qhjg
    
63.                    (If (setq cxjg (assoc (strcat (car zb) "壁厚管材" ) Newsjb))
    
64.                        (progn
    
65.                             (setq ent (last cxjg)
    
66.                                   dxf (entget ent)
    
67.                                   dxf (subst (cons 1 (rtos (cadr zb))) (assoc 1 dxf) dxf)
    
68.                             )
    
69.                             (entmod dxf)
    
70.                        )
    
71.                    )
    
72.               )
    
73.          )
    
74.       )
    
75.   )
    
76. 
    
77.   (command "_undo" "e")
    
78.   (princ)
    
79. )

(defun c:flqh()<br />   (command "_undo" "be")<br /> <br />   (defun tqsjzb(Xssa Xn / i n Xtymb)<br />        (setq i 0   n (sslength Xssa)  Xtymb ni)<br />        (repeat n<br />             (setq ent (ssname Xssa i)<br />                   dxf (entget ent)<br />             )<br />             (if (= Xn 0)<br />                 (setq Xtymb (cons (list (cdr (assoc 1 dxf)) (cdr (assoc 10 dxf))) Xtymb))<br />                 (setq Xtymb (cons (list (cdr (assoc 1 dxf)) (cdr (assoc 10 dxf)) ent) Xtymb))<br />             )<br />             (setq i (1+ i))<br />        )<br />        <br />        (setq Xtymb (vl-sort Xtymb '(lambda(e1 e2)<br />                                           (setq pt1 (cadr e1)<br />                                                 pt2 (cadr e2)<br />                                           )<br />                                           (if (equal (cadr pt1) (cadr pt2) 2.0)<br />                                               (< (car pt1) (car pt2))<br />                                               (> (cadr pt1) (cadr pt2))<br />                                           )<br />                                       )<br />                       )<br />        )<br />   )<br />   <br />   (if (progn<br />           (princ "\n请选取要统计的数据:")<br />           (setq ssa (ssget '((0 . "*text") (1 . "#*#"))))<br />       )<br />       (if (progn<br />              (princ "\n请选取更新的数据:")<br />              (setq ssb (ssget '((0 . "*text") (1 . "#*#壁厚管材,#*#"))))<br /> <br />          )<br />           (progn<br />               (setq tymba (tqsjzb ssa 0))<br />               (setq tymbb (tqsjzb ssb 1))<br />                     <br />               (setq sjb nil)<br />               (while tymba<br />                    (setq sjb (cons (list (car (car tymba)) (car (cadr tymba))) sjb))<br />                    (setq tymba (cdr (cdr tymba)))<br />               )<br />               (setq qhjg 'nil)<br />               (foreach zb sjb<br />                    (if (setq cxjg (assoc (car zb) qhjg))<br />                        (setq qhjg (subst (list (car zb) (+  (cadr cxjg) (read (cadr zb)))) cxjg qhjg))<br />                        (setq qhjg (cons (list (car zb) (read (cadr zb))) qhjg))<br />                    )<br />               )<br />               (setq qhjg (vl-sort qhjg '(lambda(x1 x2)(< (car x1) (car x2)))))<br />               (setq Newsjb nil)<br />               (while tymbb<br />                    (setq Newsjb (cons (list (car (car tymbb)) (last (cadr tymbb))) Newsjb))<br />                    (setq tymbb (cdr (cdr tymbb)))<br />               )<br />               (foreach zb qhjg<br />                    (If (setq cxjg (assoc (strcat (car zb) "壁厚管材" ) Newsjb))<br />                        (progn<br />                             (setq ent (last cxjg)<br />                                   dxf (entget ent)<br />                                   dxf (subst (cons 1 (rtos (cadr zb))) (assoc 1 dxf) dxf)<br />                             )<br />                             (entmod dxf)<br />                        )<br />                    )<br />               )<br />          )<br />       )<br />   )<br /> <br />   (command "_undo" "e")<br />   (princ)<br /> )

437271963

写了一个，在命令行显示数据统计。测试了一下，图纸里面的是【多行文字】，所以程序做了修正。

2. (defun c:tes ( / &k1 &kw1 &ob1 &p1 &p2 &ss1 &ss2 &str1 x1 x5 y1 y5)
   
3. (vl-load-com)
   
4. (princ "\n请选择文字")
   
5. (if (setq &kw1 (ssget '((0 . "TEXT,MTEXT"))))
   
6.   (progn
   
7.    (setq &ss1 '() x5 0.0 y5 nil);建立表
   
8.    (while (setq &k1 (ssname &kw1 0))
   
9.     (setq &kw1 (ssdel &k1 &kw1))
   
10.     (setq &ob1 (vlax-ename->vla-object &k1))
    
11.     (setq &str1 (vla-get-TextString &ob1));提取文字内容
    
12.     (if (numberp (setq &str1 (read &str1)));如果文字是数值
    
13.      (progn
    
14.       (setq &ss2 (s1610021 &ob1) &p1 (car &ss2) &p2 (cadr &ss2))
    
15.       (setq x1 (car &p2) y1 (cadr &p2))
    
16.       (if (> x1 x5) (setq x5 x1) );计算文字宽度
    
17.       (if y5;计算文字高度
    
18.        (if (< y1 y5) (setq y5 y1) )
    
19.        (setq y5 y1)
    
20.       );计算文字高度最小数值
    
21.       (setq &ss1 (cons (list &p1 &str1) &ss1));文字坐标及内容
    
22.      );progn
    
23.     );if
    
24.    );while
    
25.    (if (car &ss1) (s1610022 &ss1 x5 y5) );如果有选择了内容就进入下面运行
    
26.   )
    
27. )
    
28. (princ)
    
29. )
    
30. 
    
31. ;函数功能：计算文字包围框坐标
    
32. (defun s1610021 (&ob1 / pt1 pt2)
    
33. (vla-GetBoundingBox &ob1 'pt1 'pt2)
    
34. (setq pt1 (vlax-safearray->list pt1))
    
35. (setq pt2 (vlax-safearray->list pt2))
    
36. (setq pt2 (mapcar '- pt2 pt1))
    
37. (list pt1 pt2)
    
38. )
    
39. 
    
40. ;函数功能：根据坐标分类
    
41. (defun s1610022 (&ss1 x5 y5)
    
42. (setq &ss2 '() &ss5 '() y5 (* 0.5 y5))
    
43. (while (car &ss1)
    
44.   (setq &ss1 (vl-sort &ss1 '(lambda (x y) (> (cadar x) (cadar y)))));排序
    
45.   (setq y1 (- (cadaar &ss1) y5));取得最大Y值
    
46.   (setq &ss3 (vl-remove-if-not '(lambda (X) (> (cadar x) y1)) &ss1))
    
47.   (setq &ss1 (vl-remove-if '(lambda (X) (> (cadar x) y1)) &ss1));排除已经计算的对象
    
48.   (setq &ss3 (vl-sort &ss3 '(lambda (x y) (< (caar x) (caar y)))));排序
    
49.   (if (> (length &ss3) 1);如果有两个以上对象
    
50.    (progn
    
51.     (setq &ss3 (mapcar 'cadr &ss3))
    
52.     (while (car &ss3)
    
53.      (setq x1 (car &ss3) y1 (cadr &ss3))
    
54.      (if (and x1 y1);如果有两个对象
    
55.       (progn
    
56.        (setq &ss3 (cddr &ss3))
    
57.        (setq &ss2 (cons (list x1 y1) &ss2))
    
58.        (if (car &ss5)
    
59.         (if (null (member x1 &ss5)) (setq &ss5 (append &ss5 (list x1))) )
    
60.         (setq &ss5 (cons x1 &ss5))
    
61.        );记录壁厚数据
    
62.       )
    
63.       (setq &ss3 '())
    
64.      );if;2
    
65.     );while
    
66.    )
    
67.   );if;1
    
68. );while
    
69. (if (car &ss2) (s1610023 &ss2 &ss5));进行数据统计
    
70. )
    
71. 
    
72. ;函数功能：计算数据
    
73. (defun s1610023 (&ss2 &ss5 / &b1 &cd x)
    
74. (while (setq &b1 (car &ss5))
    
75.   (setq &ss5 (cdr &ss5))
    
76.   (setq &cd (rtos (apply '+ (mapcar 'cadr (vl-remove-if-not '(lambda (X) (= (car x) &b1)) &ss2)))));统计数据
    
77.   (princ "\n")
    
78.   (princ (strcat "壁厚" (rtos &b1) "总长度:" &cd))
    
79. );while
    
80. )

(defun c:tes ( / &k1 &kw1 &ob1 &p1 &p2 &ss1 &ss2 &str1 x1 x5 y1 y5)<br /> (vl-load-com)<br /> (princ "\n请选择文字")<br /> (if (setq &kw1 (ssget '((0 . "TEXT,MTEXT"))))<br />   (progn<br />    (setq &ss1 '() x5 0.0 y5 nil);建立表<br />    (while (setq &k1 (ssname &kw1 0))<br />     (setq &kw1 (ssdel &k1 &kw1))<br />     (setq &ob1 (vlax-ename->vla-object &k1))<br />     (setq &str1 (vla-get-TextString &ob1));提取文字内容<br />     (if (numberp (setq &str1 (read &str1)));如果文字是数值<br />      (progn<br />       (setq &ss2 (s1610021 &ob1) &p1 (car &ss2) &p2 (cadr &ss2))<br />       (setq x1 (car &p2) y1 (cadr &p2))<br />       (if (> x1 x5) (setq x5 x1) );计算文字宽度<br />       (if y5;计算文字高度<br />        (if (< y1 y5) (setq y5 y1) )<br />        (setq y5 y1)<br />       );计算文字高度最小数值<br />       (setq &ss1 (cons (list &p1 &str1) &ss1));文字坐标及内容<br />      );progn<br />     );if<br />    );while<br />    (if (car &ss1) (s1610022 &ss1 x5 y5) );如果有选择了内容就进入下面运行<br />   )<br /> )<br /> (princ)<br /> )<br /> <br /> ;函数功能：计算文字包围框坐标<br /> (defun s1610021 (&ob1 / pt1 pt2)<br /> (vla-GetBoundingBox &ob1 'pt1 'pt2)<br /> (setq pt1 (vlax-safearray->list pt1))<br /> (setq pt2 (vlax-safearray->list pt2))<br /> (setq pt2 (mapcar '- pt2 pt1))<br /> (list pt1 pt2)<br /> )<br /> <br /> ;函数功能：根据坐标分类<br /> (defun s1610022 (&ss1 x5 y5)<br /> (setq &ss2 '() &ss5 '() y5 (* 0.5 y5))<br /> (while (car &ss1)<br />   (setq &ss1 (vl-sort &ss1 '(lambda (x y) (> (cadar x) (cadar y)))));排序<br />   (setq y1 (- (cadaar &ss1) y5));取得最大Y值<br />   (setq &ss3 (vl-remove-if-not '(lambda (X) (> (cadar x) y1)) &ss1))<br />   (setq &ss1 (vl-remove-if '(lambda (X) (> (cadar x) y1)) &ss1));排除已经计算的对象<br />   (setq &ss3 (vl-sort &ss3 '(lambda (x y) (< (caar x) (caar y)))));排序<br />   (if (> (length &ss3) 1);如果有两个以上对象<br />    (progn<br />     (setq &ss3 (mapcar 'cadr &ss3))<br />     (while (car &ss3)<br />      (setq x1 (car &ss3) y1 (cadr &ss3))<br />      (if (and x1 y1);如果有两个对象<br />       (progn<br />        (setq &ss3 (cddr &ss3))<br />        (setq &ss2 (cons (list x1 y1) &ss2))<br />        (if (car &ss5)<br />         (if (null (member x1 &ss5)) (setq &ss5 (append &ss5 (list x1))) )<br />         (setq &ss5 (cons x1 &ss5))<br />        );记录壁厚数据<br />       )<br />       (setq &ss3 '())<br />      );if;2<br />     );while<br />    )<br />   );if;1<br /> );while<br /> (if (car &ss2) (s1610023 &ss2 &ss5));进行数据统计<br /> )<br /> <br /> ;函数功能：计算数据<br /> (defun s1610023 (&ss2 &ss5 / &b1 &cd x)<br /> (while (setq &b1 (car &ss5))<br />   (setq &ss5 (cdr &ss5))<br />   (setq &cd (rtos (apply '+ (mapcar 'cadr (vl-remove-if-not '(lambda (X) (= (car x) &b1)) &ss2)))));统计数据<br />   (princ "\n")<br />   (princ (strcat "壁厚" (rtos &b1) "总长度:" &cd))<br /> );while<br /> )

yshf

试用以下程序：

2. (defun c:flqh()
   
3.     (setq sjb '((11 2.84) (4.0 15.22)
   
4.                 (11 6.34) (4.0 5.96)
   
5.                 (11 3.15) (14.2 2.35)
   
6.                 (3.5 18.99) (14.2 2.14)
   
7.                 (4.5 11.56)
   
8.               )
   
9.     )
   
10.     (setq qhjg 'nil)
    
11.     (foreach zb sjb
    
12.          (if (setq cxjg (assoc (car zb) qhjg))
    
13.              (setq qhjg (subst (list (car zb) (+ (cadr cxjg) (cadr zb))) cxjg qhjg))
    
14.              (setq qhjg (cons zb qhjg))
    
15.          )
    
16.     )
    
17.     (setq qhjg (vl-sort qhjg '(lambda(x1 x2)(< (car x1) (car x2)))))
    
18.     (foreach zb qhjg
    
19.         (princ "\n")
    
20.         (princ (car zb))
    
21.         (princ " Σ=")
    
22.         (princ (cadr zb))
    
23.     )
    
24.     (princ)
    
25. )
    

(defun c:flqh()<br />     (setq sjb '((11 2.84) (4.0 15.22)<br />                 (11 6.34) (4.0 5.96)<br />                 (11 3.15) (14.2 2.35)<br />                 (3.5 18.99) (14.2 2.14)<br />                 (4.5 11.56)<br />               )<br />     )<br />     (setq qhjg 'nil)<br />     (foreach zb sjb<br />          (if (setq cxjg (assoc (car zb) qhjg))<br />              (setq qhjg (subst (list (car zb) (+ (cadr cxjg) (cadr zb))) cxjg qhjg))<br />              (setq qhjg (cons zb qhjg))<br />          )<br />     )<br />     (setq qhjg (vl-sort qhjg '(lambda(x1 x2)(< (car x1) (car x2)))))<br />     (foreach zb qhjg<br />         (princ "\n")<br />         (princ (car zb))<br />         (princ " Σ=")<br />         (princ (cadr zb))<br />     )<br />     (princ)<br /> )<br />

命令: FLQH
3.5 Σ=18.99
4.0 Σ=21.18
4.5 Σ=11.56
11 Σ=12.33
14.2 Σ=4.49

dragoon33333

我的思路是repeat第一列选择集，assoc出坐标，然后嵌套repeat第二列，if第二列某图元坐标y值与第一列相同，则求和。

dragoon33333

yshf 发表于 2016-10-2 08:30
试用以下程序：
命令: FLQH
3.5 Σ=18.99

多谢，不过变量sjb您这是手输的，我现在无法解决的就是怎么让相同行的不同列组成表。也就是我根据第一列能求出第二列图元的坐标，怎么根据一个图元的坐标而选中这个图元，这个问题能解决我就问题解决了，现在用repeat函数嵌套蒙了。

boss0931

不怎么会lisp，可以导入excel后用sumif求和

dragoon33333

boss0931 发表于 2016-10-2 09:25
不怎么会lisp，可以导入excel后用sumif求和

导出Excel也是个学问呀，两列导出后怎麼对齐，能对齐了我就不用进入Excel了。

yshf

构造一个只有A列数据图元及B列数据图元的选择集，提取各数据图元的数值及位置点，如果B列数据其在图中的位置点Y坐标与A列的在±2范围内相等增，则是同一行的，如此就可得到同一行的A列数据和B列数据，并加入的sjb中。
(if (equal (cadr A列位置点) (cadr B列位置点) 2.0)
    (progn
         (同一行数据)
         (其中，X坐标小的为A列数据，X坐标大的为B列数据)
    )
    (非同一行数据)
)

boss0931

dragoon33333 发表于 2016-10-2 09:38
导出Excel也是个学问呀，两列导出后怎麼对齐，能对齐了我就不用进入Excel了。

常青藤可以导入导出表格数据，很方便，论坛里应该有的

dragoon33333

yshf 发表于 2016-10-2 09:40
构造一个只有A列数据图元及B列数据图元的选择集，提取各数据图元的数值及位置点，如果B列数据其在图中的位 ...

多谢前辈，这个if我用在了第二层repeat中。第一层是遍历第一列，第二层是遍历第二列，第二层中采用if函数确定与第一列同行，然后返回第二列1组码值。然后再在第一层中对获取的1组码值求和。看来我这个思路是正确的。看来我的问题不是出在这里，可能是嵌套汇总表对应壁厚的时候弄蒙了。