表的比较，以及测绘专业标高的问题

荒野孤行

请见图片，表比较的如何用foreach、mapcar写出lisp程序？求指点，谢谢！

菜卷鱼

技术不高，代码冗杂，原理应该是这样

1. (apply
   
2. (function(lambda (a b)
   
3. (if
   
4. (and
   
5. (equal (list(car(cadr(car a)))(cadr (cadr(car a )) ))
   
6.        (list(car(car b))(cadr (car b )) ))
   
7. (equal (list(car(cadr(cadr a)))(cadr (cadr(cadr a )) ))
   
8.        (list(car(cadr b))(cadr (cadr b ) )))
   
9. (equal (list(car(cadr(caddr a)))(cadr (cadr(caddr a ))) )
   
10.        (list(car(caddr b))(cadr (caddr b )) ))
    
11. )
    
12. (setq c
    
13. (list
    
14. (list (car(car a)) (car(cadr (car a)))(cadr (cadr(car a))) (caddr (car b)))
    
15. (list (car(cadr a)) (car(cadr (cadr a)))(cadr (cadr(cadr a))) (caddr (cadr b)))
    
16. (list (car(caddr a)) (car(cadr (caddr a)))(cadr (cadr(caddr a))) (caddr (caddr b)))
    
17. )
    
18. )
    
19. )))
    
20. (list
    
21. (list
    
22. (list 1 '( 1 2 3))
    
23. (list 2 '(4 5 6 ))
    
24. (list 3 '(7 8 9)))
    
25. (list
    
26. '( 1 2 3.5)
    
27. '(4 5 6.2)
    
28. '(7 8 9.8)
    
29. '(9 10 9.5)
    
30. '(11 12 19.8)))
    
31. )

(apply <br /> (function(lambda (a b)<br /> (if <br /> (and <br /> (equal (list(car(cadr(car a)))(cadr (cadr(car a )) ))<br />        (list(car(car b))(cadr (car b )) ))<br /> (equal (list(car(cadr(cadr a)))(cadr (cadr(cadr a )) ))<br />        (list(car(cadr b))(cadr (cadr b ) )))<br /> (equal (list(car(cadr(caddr a)))(cadr (cadr(caddr a ))) )<br />        (list(car(caddr b))(cadr (caddr b )) ))<br /> )<br /> (setq c<br /> (list <br /> (list (car(car a)) (car(cadr (car a)))(cadr (cadr(car a))) (caddr (car b)))<br /> (list (car(cadr a)) (car(cadr (cadr a)))(cadr (cadr(cadr a))) (caddr (cadr b)))<br /> (list (car(caddr a)) (car(cadr (caddr a)))(cadr (cadr(caddr a))) (caddr (caddr b)))<br /> )<br /> ) <br /> )))<br /> (list <br /> (list<br /> (list 1 '( 1 2 3))<br /> (list 2 '(4 5 6 ))<br /> (list 3 '(7 8 9)))<br /> (list <br /> '( 1 2 3.5)<br /> '(4 5 6.2)<br /> '(7 8 9.8)<br /> '(9 10 9.5)<br /> '(11 12 19.8)))<br /> )

返回结果 ((1 1 2 3.5) (2 4 5 6.2) (3 7 8 9.8))

菜卷鱼

就是不知道你的两个表长度，确定一个表 是3个元素，第二个表是5个元素就好办了,
直接 （lambda (a b c d e f g h))

菜卷鱼

稍微精简点的

1. (setq list1(list '(1 (1 2 3))'(2 (4 5 6 )) '(3(7 8 9))))
   
2. (setq list2(list '(1 2 3.5) '(4 5 6.2)'(7 8 9.8)'(9 10 9.5)'(11 12 19.8)))
   
3. 
   
4. (if
   
5. (equal
   
6. (reverse
   
7. (mapcar '(lambda(x) (cdr(reverse (cadr x)))) list1))
   
8. (cdr(cdr
   
9. (reverse
   
10. (mapcar '(lambda(x) (cdr(reverse  x))) list2))))
    
11. )
    
12. (mapcar '(lambda(x) (reverse x))
    
13. (mapcar 'cons
    
14. (mapcar '(lambda(x) (car (reverse x))) list2)
    
15. (mapcar '(lambda(x) (cdr(reverse(cons (car x) (cadr x))))) list1)
    
16. )))
    

(setq list1(list '(1 (1 2 3))'(2 (4 5 6 )) '(3(7 8 9))))<br /> (setq list2(list '(1 2 3.5) '(4 5 6.2)'(7 8 9.8)'(9 10 9.5)'(11 12 19.8)))<br /> <br /> (if <br /> (equal<br /> (reverse<br /> (mapcar '(lambda(x) (cdr(reverse (cadr x)))) list1))<br /> (cdr(cdr<br /> (reverse<br /> (mapcar '(lambda(x) (cdr(reverse  x))) list2))))<br /> )<br /> (mapcar '(lambda(x) (reverse x))<br /> (mapcar 'cons <br /> (mapcar '(lambda(x) (car (reverse x))) list2)<br /> (mapcar '(lambda(x) (cdr(reverse(cons (car x) (cadr x))))) list1)<br /> )))<br />

荒野孤行

菜卷鱼 发表于 2015-4-15 10:14
稍微精简点的

抱歉，遇见了新的问题，望解答。
附件程序是关于测绘方面导出标高的问题，程序需求及执行步骤为：
1、由用户选取保存dat文件的位置；
2、选取多段线（测绘描述出来的），并将多段线的顶点序号&对应顶点坐标组成表→即一楼图片中的list1；
3、选取名称为gc200的块参照，将块参照的坐标组成表→即一楼图片中的list2；
4、对比list1与list2中的x，y坐标，如果在误差范围内且相同，那么重新组成表list_ok（可见附件lisp源码）→即一楼图片中的输出结果；
5、读取表list_ok，通过mapcar将每个表元素输出到dat文件（就在这里出问题了，list_ok为什么为nil？）

以上，谢谢！

菜卷鱼

荒野孤行 发表于 2015-4-16 23:12
抱歉，遇见了新的问题，望解答。
附件程序是关于测绘方面导出标高的问题，程序需求及执行步骤为：
1、由 ...

程序不是通用的，只限于 list2比list1 多两个元素，所以程序里有 (cdr (cdr ......))

菜卷鱼

荒野孤行 发表于 2015-4-16 23:12
抱歉，遇见了新的问题，望解答。
附件程序是关于测绘方面导出标高的问题，程序需求及执行步骤为：
1、由 ...

1. ;;;*****导出多段线顶点坐标 程序开始*****
   
2. (defun c:t1 (/ entnam dwg)
   
3.   (setvar "cmdecho" 0)
   
4.   (princ "\n★功能：导出多段线顶点坐标至文本文件.\n")
   
5.   (setq nam (rtos (* (getvar "cdate") 1E8)))
   
6.   (setq ffn (getfiled "指定文件存储路径及文件名" nam "dat" 1))
   
7.   (setq ff (open ffn "w"))
   
8.   (close ff)
   
9.   (princ "\n选取要导出标高的多段线：")
   
10.   (setq ss (ssget '((0 . "POLYLINE,LWPOLYLINE"))))
    
11.   (princ "\n选取要导出标高的多段线顶点处的块参照：")
    
12.   (setq ss_block (ssget '((0 . "INSERT") (2 . "GC200"))))
    
13.   (setq  m 0
    
14.   i 0
    
15.   list_block
    
16.    nil
    
17.   )
    
18.   (setvar "pdmode" 35)
    
19.   (vl-load-com)
    
20.   (repeat (sslength ss_block)
    
21.     (setq ent_block  (ssname ss_block m)
    
22.     data_block (entget ent_block)
    
23.     pt_block   (cdr (assoc 10 data_block))
    
24.     list_block (cons pt_block list_block)
    
25.     )
    
26.     (setq m (1+ m))
    
27.   )
    
28.   (setq ff (open ffn "a"))
    
29.   (princ "Y坐标 X坐标 Z坐标\n" ff)
    
30.   (close ff)
    
31.   (repeat (sslength ss)
    
32.     (setq entnam  (ssname ss i)
    
33.     obj    (vlax-ename->vla-object entnam)
    
34.     pt_list nil
    
35.     list_ok nil
    
36.     )
    
37.     (setq j -1)
    
38.     (while (setq pp (vlax-curve-getpointatparam obj (setq j (1+ j))))
    
39.       (setq pt_list (cons (list (+ j 1) pp) pt_list))
    
40.     )
    
41. 
    
42. 
    
43. (if (= nil (vl-position "nil"
    
44. (mapcar '(lambda(a b) (equal a b 0.01))
    
45. (mapcar '(lambda(x) (cdr(reverse (cadr x)))) pt_list)
    
46. (mapcar '(lambda(x) (cdr(reverse  x))) list_block))))
    
47. (setq list_ok
    
48. (mapcar '(lambda(x) (reverse x))
    
49. (mapcar 'cons
    
50. (mapcar '(lambda(x) (car (reverse x))) list_block)
    
51. (mapcar '(lambda(x) (cdr(reverse(cons (car x) (cadr x))))) pt_list)
    
52. ))))
    
53. 
    
54. 
    
55. 
    
56.     (setq ff (open ffn "a"))
    
57.     (mapcar '(lambda (x)
    
58.          (princ (strcat (itoa (car x))
    
59.             " "
    
60.             (rtos (cadr x) 2 4)
    
61.             " "
    
62.             (rtos (caddr x) 2 4)
    
63.             " "
    
64.             (rtos (last x) 2 4)
    
65.           )
    
66.           ff
    
67.          )
    
68.        )
    
69.       list_ok
    
70.     )
    
71.     (setq i (1+ i))
    
72.     (princ (strcat "↑第 " (itoa i) " 条多段线对应的顶点导出完毕。\n")
    
73.      ff
    
74.     )
    
75.     (princ "\n" ff)
    
76.     (close ff)
    
77.   )
    
78.   (princ (strcat "\n文件已保存至：" ffn))
    
79.   (princ)
    
80. )
    
81. ;;;*****导出多段线顶点坐标 程序结束*****

;;;*****导出多段线顶点坐标 程序开始*****<br /> (defun c:t1 (/ entnam dwg)<br />   (setvar "cmdecho" 0)<br />   (princ "\n★功能：导出多段线顶点坐标至文本文件.\n")<br />   (setq nam (rtos (* (getvar "cdate") 1E8)))<br />   (setq ffn (getfiled "指定文件存储路径及文件名" nam "dat" 1))<br />   (setq ff (open ffn "w"))<br />   (close ff)<br />   (princ "\n选取要导出标高的多段线：")<br />   (setq ss (ssget '((0 . "POLYLINE,LWPOLYLINE"))))<br />   (princ "\n选取要导出标高的多段线顶点处的块参照：")<br />   (setq ss_block (ssget '((0 . "INSERT") (2 . "GC200"))))<br />   (setq  m 0<br />   i 0<br />   list_block<br />    nil<br />   )<br />   (setvar "pdmode" 35)<br />   (vl-load-com)<br />   (repeat (sslength ss_block)<br />     (setq ent_block  (ssname ss_block m)<br />     data_block (entget ent_block)<br />     pt_block   (cdr (assoc 10 data_block))<br />     list_block (cons pt_block list_block)<br />     )<br />     (setq m (1+ m))<br />   )<br />   (setq ff (open ffn "a"))<br />   (princ "Y坐标 X坐标 Z坐标\n" ff)<br />   (close ff)<br />   (repeat (sslength ss)<br />     (setq entnam  (ssname ss i)<br />     obj    (vlax-ename->vla-object entnam)<br />     pt_list nil<br />     list_ok nil<br />     )<br />     (setq j -1)<br />     (while (setq pp (vlax-curve-getpointatparam obj (setq j (1+ j))))<br />       (setq pt_list (cons (list (+ j 1) pp) pt_list))<br />     )<br /> <br /> <br /> (if (= nil (vl-position "nil" <br /> (mapcar '(lambda(a b) (equal a b 0.01))<br /> (mapcar '(lambda(x) (cdr(reverse (cadr x)))) pt_list)<br /> (mapcar '(lambda(x) (cdr(reverse  x))) list_block))))<br /> (setq list_ok<br /> (mapcar '(lambda(x) (reverse x))<br /> (mapcar 'cons <br /> (mapcar '(lambda(x) (car (reverse x))) list_block)<br /> (mapcar '(lambda(x) (cdr(reverse(cons (car x) (cadr x))))) pt_list)<br /> ))))<br /> <br /> <br /> <br />     (setq ff (open ffn "a"))<br />     (mapcar '(lambda (x)<br />          (princ (strcat (itoa (car x))<br />             " "<br />             (rtos (cadr x) 2 4)<br />             " "<br />             (rtos (caddr x) 2 4)<br />             " "<br />             (rtos (last x) 2 4)<br />           )<br />           ff<br />          )<br />        )<br />       list_ok<br />     )<br />     (setq i (1+ i))<br />     (princ (strcat "↑第 " (itoa i) " 条多段线对应的顶点导出完毕。\n")<br />      ff<br />     )<br />     (princ "\n" ff)<br />     (close ff)<br />   )<br />   (princ (strcat "\n文件已保存至：" ffn))<br />   (princ)<br /> )<br /> ;;;*****导出多段线顶点坐标 程序结束*****

荒野孤行

菜卷鱼 发表于 2015-4-17 14:05
程序不是通用的，只限于 list2比list1 多两个元素，所以程序里有 (cdr (cdr ......))

那个我看到了，貌似我已经改了的吧。。。

荒野孤行

菜卷鱼 发表于 2015-4-17 14:19

非常感谢！可以了。
另：重新修改了下，把list_ok表reverse了下，加了\n，对应转出数据有了对应的描述。

2. ;;;*****导出多段线顶点坐标 程序开始*****
   
3. (defun c:t1 (/ entnam dwg)
   
4.   (setvar "cmdecho" 0)
   
5.   (princ "\n★功能：导出多段线顶点坐标至文本文件.\n")
   
6.   (setq nam (rtos (* (getvar "cdate") 1E8)))
   
7.   (setq ffn (getfiled "指定文件存储路径及文件名" nam "dat" 1))
   
8.   (setq ff (open ffn "w"))
   
9.   (close ff)
   
10.   (princ "\n选取要导出标高的多段线：")
    
11.   (setq ss (ssget '((0 . "POLYLINE,LWPOLYLINE"))))
    
12.   (princ "\n选取要导出标高的多段线顶点处的块参照：")
    
13.   (setq ss_block (ssget '((0 . "INSERT") (2 . "GC200"))))
    
14.   (setq  m 0
    
15.   i 0
    
16.   list_block
    
17.    nil
    
18.   )
    
19.   (setvar "pdmode" 35)
    
20.   (vl-load-com)
    
21.   (repeat (sslength ss_block)
    
22.     (setq ent_block  (ssname ss_block m)
    
23.     data_block (entget ent_block)
    
24.     pt_block   (cdr (assoc 10 data_block))
    
25.     list_block (cons pt_block list_block)
    
26.     )
    
27.     (setq m (1+ m))
    
28.   )
    
29.   (setq ff (open ffn "a"))
    
30.   (princ "顶点坐标的序号 X坐标 Y坐标 Z坐标\n" ff)
    
31.   (close ff)
    
32.   (repeat (sslength ss)
    
33.     (setq entnam  (ssname ss i)
    
34.     obj    (vlax-ename->vla-object entnam)
    
35.     pt_list nil
    
36.     list_ok nil
    
37.     )
    
38.     (setq j -1)
    
39.     (while (setq pp (vlax-curve-getpointatparam obj (setq j (1+ j))))
    
40.       (setq pt_list (cons (list (+ j 1) pp) pt_list))
    
41.     )
    
42. 
    
43. 
    
44.     (if
    
45.       (=
    
46.   nil
    
47.   (vl-position
    
48.     "nil"
    
49.     (mapcar '(lambda (a b) (equal a b 0.01))
    
50.       (mapcar '(lambda (x) (cdr (reverse (cadr x)))) pt_list)
    
51.       (mapcar '(lambda (x) (cdr (reverse x))) list_block)
    
52.     )
    
53.   )
    
54.       )
    
55.        (setq list_ok
    
56.         (reverse
    
57.     (mapcar
    
58.       '(lambda (x) (reverse x))
    
59.       (mapcar
    
60.         'cons
    
61.         (mapcar '(lambda (x) (car (reverse x))) list_block)
    
62.         (mapcar
    
63.           '(lambda (x) (cdr (reverse (cons (car x) (cadr x)))))
    
64.           pt_list
    
65.         )
    
66.       )
    
67.     )
    
68.         )
    
69.        )
    
70.     )
    
71.     (setq ff (open ffn "a"))
    
72.     (mapcar '(lambda (x)
    
73.          (princ (strcat (itoa (car x))
    
74.             ","
    
75.             (rtos (cadr x) 2 4)
    
76.             ","
    
77.             (rtos (caddr x) 2 4)
    
78.             ","
    
79.             (rtos (last x) 2 4)
    
80.             "\n"
    
81.           )
    
82.           ff
    
83.          )
    
84.        )
    
85.       list_ok
    
86.     )
    
87.     (setq i (1+ i))
    
88.     (princ (strcat "↑第 " (itoa i) " 条多段线对应的顶点导出完毕。\n")
    
89.      ff
    
90.     )
    
91.     (princ "\n" ff)
    
92.     (close ff)
    
93.   )
    
94.   (princ (strcat "\n文件已保存至：" ffn))
    
95.   (princ)
    
96. )
    
97. ;;;*****导出多段线顶点坐标 程序结束*****

;;;*****导出多段线顶点坐标 程序开始*****<br /> (defun c:t1 (/ entnam dwg)<br />   (setvar "cmdecho" 0)<br />   (princ "\n★功能：导出多段线顶点坐标至文本文件.\n")<br />   (setq nam (rtos (* (getvar "cdate") 1E8)))<br />   (setq ffn (getfiled "指定文件存储路径及文件名" nam "dat" 1))<br />   (setq ff (open ffn "w"))<br />   (close ff)<br />   (princ "\n选取要导出标高的多段线：")<br />   (setq ss (ssget '((0 . "POLYLINE,LWPOLYLINE"))))<br />   (princ "\n选取要导出标高的多段线顶点处的块参照：")<br />   (setq ss_block (ssget '((0 . "INSERT") (2 . "GC200"))))<br />   (setq  m 0<br />   i 0<br />   list_block<br />    nil<br />   )<br />   (setvar "pdmode" 35)<br />   (vl-load-com)<br />   (repeat (sslength ss_block)<br />     (setq ent_block  (ssname ss_block m)<br />     data_block (entget ent_block)<br />     pt_block   (cdr (assoc 10 data_block))<br />     list_block (cons pt_block list_block)<br />     )<br />     (setq m (1+ m))<br />   )<br />   (setq ff (open ffn "a"))<br />   (princ "顶点坐标的序号 X坐标 Y坐标 Z坐标\n" ff)<br />   (close ff)<br />   (repeat (sslength ss)<br />     (setq entnam  (ssname ss i)<br />     obj    (vlax-ename->vla-object entnam)<br />     pt_list nil<br />     list_ok nil<br />     )<br />     (setq j -1)<br />     (while (setq pp (vlax-curve-getpointatparam obj (setq j (1+ j))))<br />       (setq pt_list (cons (list (+ j 1) pp) pt_list))<br />     )<br /> <br /> <br />     (if<br />       (=<br />   nil<br />   (vl-position<br />     "nil"<br />     (mapcar '(lambda (a b) (equal a b 0.01))<br />       (mapcar '(lambda (x) (cdr (reverse (cadr x)))) pt_list)<br />       (mapcar '(lambda (x) (cdr (reverse x))) list_block)<br />     )<br />   )<br />       )<br />        (setq list_ok<br />         (reverse<br />     (mapcar<br />       '(lambda (x) (reverse x))<br />       (mapcar<br />         'cons<br />         (mapcar '(lambda (x) (car (reverse x))) list_block)<br />         (mapcar<br />           '(lambda (x) (cdr (reverse (cons (car x) (cadr x)))))<br />           pt_list<br />         )<br />       )<br />     )<br />         )<br />        )<br />     )<br />     (setq ff (open ffn "a"))<br />     (mapcar '(lambda (x)<br />          (princ (strcat (itoa (car x))<br />             ","<br />             (rtos (cadr x) 2 4)<br />             ","<br />             (rtos (caddr x) 2 4)<br />             ","<br />             (rtos (last x) 2 4)<br />             "\n"<br />           )<br />           ff<br />          )<br />        )<br />       list_ok<br />     )<br />     (setq i (1+ i))<br />     (princ (strcat "↑第 " (itoa i) " 条多段线对应的顶点导出完毕。\n")<br />      ff<br />     )<br />     (princ "\n" ff)<br />     (close ff)<br />   )<br />   (princ (strcat "\n文件已保存至：" ffn))<br />   (princ)<br /> )<br /> ;;;*****导出多段线顶点坐标 程序结束*****

wu112031853

试了一下：1、x、y坐标跟你输出表格里面的相反。2、高程数据跟线方向恰好相反。