[求助]：求一个lisp小程序？——继续求，希望在坐标轴改变后依然可以读出？

xzsnoopy

我想在CAD里提取某条线段的坐标值，导入到excel里，请教各位大侠？
仅要X和Y坐标即可，中间用逗号隔开～·············

fengjianwei

;;  结果文件在C盘下
(defun c:getpl ( )
(setq obj (car (entsel "\n请选择多义线对象：")))
(foreach en (entget obj)
(if (= 10 (car en))(setq nlist (cons (cdr en) nlist)))
)
(setq nlist (reverse nlist))
(setq bc (length nlist))
(setq fname "C://pl_point.txt")
(setq fw (open fname "w"))
(princ "\n坐标;X,Y,Z" fw)
(setq mn 1)
(repeat bc
(setq pt (car nlist))
(setq nlist (cdr nlist))
(setq x (car pt))
(setq y (cadr pt))
(if (= (length pt) 2)
(setq z (cdr (assoc 38 (entget obj))))
(setq z (caddr pt))
) ; end if
(princ (strcat "\nN" (itoa mn) ": " (rtos x) "," (rtos y) "," (rtos z)) )
(princ (strcat "\n" (rtos x) "," (rtos y) "," (rtos z)) fw)
(setq mn (+ mn 1))
)
(close fw)
(setvar "osmode" 35)
)

xzsnoopy

谢谢楼上的，先试试行不行～···········

对原始坐标轴是可以的，但是如果坐标系被改变了，或是移动了坐标系，就不行了，读出的还是原始坐标轴时的坐标，能再帮我改进一下吗？

netbee

2. 
   
3. (defun c:getpl ()
   
4.   (setq obj (car (entsel "\n请选择多义线对象：")))
   
5.   (foreach en (entget obj)
   
6.     (if        (= 10 (car en))
   
7.       (setq nlist (cons (trans(cdr en)0 1) nlist)) [color=red];_添加trans转换坐标系[/color]
   
8.     ) ;_ 结束if
   
9.   ) ;_ 结束foreach
   
10.   (setq nlist (reverse nlist))
    
11.   (setq bc (length nlist))
    
12.   (setq fname "C://pl_point.txt")
    
13.   (setq fw (open fname "w"))
    
14.   (princ "\n坐标;X,Y,Z" fw)
    
15.   (setq mn 1)
    
16.   (repeat bc
    
17.     (setq pt (car nlist))
    
18.     (setq nlist (cdr nlist))
    
19.     (setq x (car pt))
    
20.     (setq y (cadr pt))
    
21.     (if        (= (length pt) 2)
    
22.       (setq z (cdr (assoc 38 (entget obj))))
    
23.       (setq z (caddr pt))
    
24.     )                                        ; end if
    
25.     (princ (strcat "\nN"
    
26.                    (itoa mn)
    
27.                    ": "
    
28.                    (rtos x)
    
29.                    ","
    
30.                    (rtos y)
    
31.                    ","
    
32.                    (rtos z)
    
33.            ) ;_ 结束strcat
    
34.     ) ;_ 结束princ
    
35.     (princ (strcat "\n" (rtos x) "," (rtos y) "," (rtos z)) fw)
    
36.     (setq mn (+ mn 1))
    
37.   ) ;_ 结束repeat
    
38.   (close fw)
    
39.   (setvar "osmode" 35)
    
40. ) ;_ 结束defun
    

<br /> (defun c:getpl ()<br />   (setq obj (car (entsel "\n请选择多义线对象：")))<br />   (foreach en (entget obj)<br />     (if        (= 10 (car en))<br />       (setq nlist (cons (trans(cdr en)0 1) nlist)) [color=red];_添加trans转换坐标系[/color]<br />     ) ;_ 结束if<br />   ) ;_ 结束foreach<br />   (setq nlist (reverse nlist))<br />   (setq bc (length nlist))<br />   (setq fname "C://pl_point.txt")<br />   (setq fw (open fname "w"))<br />   (princ "\n坐标;X,Y,Z" fw)<br />   (setq mn 1)<br />   (repeat bc<br />     (setq pt (car nlist))<br />     (setq nlist (cdr nlist))<br />     (setq x (car pt))<br />     (setq y (cadr pt))<br />     (if        (= (length pt) 2)<br />       (setq z (cdr (assoc 38 (entget obj))))<br />       (setq z (caddr pt))<br />     )                                        ; end if <br />     (princ (strcat "\nN"<br />                    (itoa mn)<br />                    ": "<br />                    (rtos x)<br />                    ","<br />                    (rtos y)<br />                    ","<br />                    (rtos z)<br />            ) ;_ 结束strcat<br />     ) ;_ 结束princ<br />     (princ (strcat "\n" (rtos x) "," (rtos y) "," (rtos z)) fw)<br />     (setq mn (+ mn 1))<br />   ) ;_ 结束repeat<br />   (close fw)<br />   (setvar "osmode" 35)<br /> ) ;_ 结束defun<br />

xzsnoopy

楼上的版主，还是不行啊～·········坐标还是不一致啊～··············

netbee

(trans(cdr en)0 1)

xzsnoopy

再问一下，如果有多条多段线，想把它们读到一个文本文件中，把Z值（即二维多段线的标高值）放在第一行，下面的行分别为该多段线的XY值，如此循环，读出所有选定的多段线，如何实现？
文件名和路径能不能自己输入啊？可以保存为sml文件吗？