表的比较，以及测绘专业标高的问题
本帖最后由 荒野孤行 于 2015-4-16 23:14 编辑请见图片，表比较的如何用foreach、mapcar写出lisp程序？求指点，谢谢！
技术不高，代码冗杂，原理应该是这样
(apply
(function(lambda (a b)
(if
(and
(equal (list(car(cadr(car a)))(cadr (cadr(car a )) ))
(list(car(car b))(cadr (car b )) ))
(equal (list(car(cadr(cadr a)))(cadr (cadr(cadr a )) ))
(list(car(cadr b))(cadr (cadr b ) )))
(equal (list(car(cadr(caddr a)))(cadr (cadr(caddr a ))) )
(list(car(caddr b))(cadr (caddr b )) ))
)
(setq c
(list
(list (car(car a)) (car(cadr (car a)))(cadr (cadr(car a))) (caddr (car b)))
(list (car(cadr a)) (car(cadr (cadr a)))(cadr (cadr(cadr a))) (caddr (cadr b)))
(list (car(caddr a)) (car(cadr (caddr a)))(cadr (cadr(caddr a))) (caddr (caddr b)))
)
)
)))
(list
(list
(list 1 '( 1 2 3))
(list 2 '(4 5 6 ))
(list 3 '(7 8 9)))
(list
'( 1 2 3.5)
'(4 5 6.2)
'(7 8 9.8)
'(9 10 9.5)
'(11 12 19.8)))
)
返回结果 ((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)) 本帖最后由 菜卷鱼 于 2015-4-15 10:42 编辑
稍微精简点的
(setq list1(list '(1 (1 2 3))'(2 (4 5 6 )) '(3(7 8 9))))
(setq list2(list '(1 2 3.5) '(4 5 6.2)'(7 8 9.8)'(9 10 9.5)'(11 12 19.8)))
(if
(equal
(reverse
(mapcar '(lambda(x) (cdr(reverse (cadr x)))) list1))
(cdr(cdr
(reverse
(mapcar '(lambda(x) (cdr(reversex))) list2))))
)
(mapcar '(lambda(x) (reverse x))
(mapcar 'cons
(mapcar '(lambda(x) (car (reverse x))) list2)
(mapcar '(lambda(x) (cdr(reverse(cons (car x) (cadr x))))) list1)
)))
菜卷鱼 发表于 2015-4-15 10:14 static/image/common/back.gif
稍微精简点的
抱歉，遇见了新的问题，望解答。
附件程序是关于测绘方面导出标高的问题，程序需求及执行步骤为：
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 static/image/common/back.gif
抱歉，遇见了新的问题，望解答。
附件程序是关于测绘方面导出标高的问题，程序需求及执行步骤为：
1、由 ...
程序不是通用的，只限于 list2比list1 多两个元素，所以程序里有 (cdr (cdr ......)) 荒野孤行 发表于 2015-4-16 23:12 static/image/common/back.gif
抱歉，遇见了新的问题，望解答。
附件程序是关于测绘方面导出标高的问题，程序需求及执行步骤为：
1、由 ...
;;;*****导出多段线顶点坐标 程序开始*****
(defun c:t1 (/ entnam dwg)
(setvar "cmdecho" 0)
(princ "\n★功能：导出多段线顶点坐标至文本文件.\n")
(setq nam (rtos (* (getvar "cdate") 1E8)))
(setq ffn (getfiled "指定文件存储路径及文件名" nam "dat" 1))
(setq ff (open ffn "w"))
(close ff)
(princ "\n选取要导出标高的多段线：")
(setq ss (ssget '((0 . "POLYLINE,LWPOLYLINE"))))
(princ "\n选取要导出标高的多段线顶点处的块参照：")
(setq ss_block (ssget '((0 . "INSERT") (2 . "GC200"))))
(setqm 0
i 0
list_block
nil
)
(setvar "pdmode" 35)
(vl-load-com)
(repeat (sslength ss_block)
(setq ent_block(ssname ss_block m)
data_block (entget ent_block)
pt_block (cdr (assoc 10 data_block))
list_block (cons pt_block list_block)
)
(setq m (1+ m))
)
(setq ff (open ffn "a"))
(princ "Y坐标 X坐标 Z坐标\n" ff)
(close ff)
(repeat (sslength ss)
(setq entnam(ssname ss i)
obj (vlax-ename->vla-object entnam)
pt_list nil
list_ok nil
)
(setq j -1)
(while (setq pp (vlax-curve-getpointatparam obj (setq j (1+ j))))
(setq pt_list (cons (list (+ j 1) pp) pt_list))
)
(if (= nil (vl-position "nil"
(mapcar '(lambda(a b) (equal a b 0.01))
(mapcar '(lambda(x) (cdr(reverse (cadr x)))) pt_list)
(mapcar '(lambda(x) (cdr(reversex))) list_block))))
(setq list_ok
(mapcar '(lambda(x) (reverse x))
(mapcar 'cons
(mapcar '(lambda(x) (car (reverse x))) list_block)
(mapcar '(lambda(x) (cdr(reverse(cons (car x) (cadr x))))) pt_list)
))))
(setq ff (open ffn "a"))
(mapcar '(lambda (x)
(princ (strcat (itoa (car x))
" "
(rtos (cadr x) 2 4)
" "
(rtos (caddr x) 2 4)
" "
(rtos (last x) 2 4)
)
ff
)
)
list_ok
)
(setq i (1+ i))
(princ (strcat "↑第 " (itoa i) " 条多段线对应的顶点导出完毕。\n")
ff
)
(princ "\n" ff)
(close ff)
)
(princ (strcat "\n文件已保存至：" ffn))
(princ)
)
;;;*****导出多段线顶点坐标 程序结束*****
菜卷鱼 发表于 2015-4-17 14:05 static/image/common/back.gif
程序不是通用的，只限于 list2比list1 多两个元素，所以程序里有 (cdr (cdr ......))
那个我看到了，貌似我已经改了的吧。。。 本帖最后由 荒野孤行 于 2015-4-17 23:50 编辑
菜卷鱼 发表于 2015-4-17 14:19 static/image/common/back.gif
非常感谢！可以了。
另：重新修改了下，把list_ok表reverse了下，加了\n，对应转出数据有了对应的描述。;;;*****导出多段线顶点坐标 程序开始*****
(defun c:t1 (/ entnam dwg)
(setvar "cmdecho" 0)
(princ "\n★功能：导出多段线顶点坐标至文本文件.\n")
(setq nam (rtos (* (getvar "cdate") 1E8)))
(setq ffn (getfiled "指定文件存储路径及文件名" nam "dat" 1))
(setq ff (open ffn "w"))
(close ff)
(princ "\n选取要导出标高的多段线：")
(setq ss (ssget '((0 . "POLYLINE,LWPOLYLINE"))))
(princ "\n选取要导出标高的多段线顶点处的块参照：")
(setq ss_block (ssget '((0 . "INSERT") (2 . "GC200"))))
(setqm 0
i 0
list_block
nil
)
(setvar "pdmode" 35)
(vl-load-com)
(repeat (sslength ss_block)
(setq ent_block(ssname ss_block m)
data_block (entget ent_block)
pt_block (cdr (assoc 10 data_block))
list_block (cons pt_block list_block)
)
(setq m (1+ m))
)
(setq ff (open ffn "a"))
(princ "顶点坐标的序号 X坐标 Y坐标 Z坐标\n" ff)
(close ff)
(repeat (sslength ss)
(setq entnam(ssname ss i)
obj (vlax-ename->vla-object entnam)
pt_list nil
list_ok nil
)
(setq j -1)
(while (setq pp (vlax-curve-getpointatparam obj (setq j (1+ j))))
(setq pt_list (cons (list (+ j 1) pp) pt_list))
)
(if
(=
nil
(vl-position
"nil"
(mapcar '(lambda (a b) (equal a b 0.01))
(mapcar '(lambda (x) (cdr (reverse (cadr x)))) pt_list)
(mapcar '(lambda (x) (cdr (reverse x))) list_block)
)
)
)
(setq list_ok
(reverse
(mapcar
'(lambda (x) (reverse x))
(mapcar
'cons
(mapcar '(lambda (x) (car (reverse x))) list_block)
(mapcar
'(lambda (x) (cdr (reverse (cons (car x) (cadr x)))))
pt_list
)
)
)
)
)
)
(setq ff (open ffn "a"))
(mapcar '(lambda (x)
(princ (strcat (itoa (car x))
","
(rtos (cadr x) 2 4)
","
(rtos (caddr x) 2 4)
","
(rtos (last x) 2 4)
"\n"
)
ff
)
)
list_ok
)
(setq i (1+ i))
(princ (strcat "↑第 " (itoa i) " 条多段线对应的顶点导出完毕。\n")
ff
)
(princ "\n" ff)
(close ff)
)
(princ (strcat "\n文件已保存至：" ffn))
(princ)
)
;;;*****导出多段线顶点坐标 程序结束***** 试了一下：1、x、y坐标跟你输出表格里面的相反。2、高程数据跟线方向恰好相反。
页:
[1]