急需求助，关于如何用lsp实现以下功能！！

风树

有没有类似实现以下功能的lsp程序？？？？？？？？？？
点选一根多段线或者直线，选择该线的一个端点，然后提示输入一个长度值x，确认后，从该线被选择的端点起，每隔x长度按次序提取坐标（线上，同时该线两个端点的坐标也要提取），然后将提取的坐标按次序保存到txt文件或excle文件中（随便），文件保存格式 ：
序号  x坐标  y坐标

如果没有，请哪位大侠帮忙写个吧，不会lsp啊！！！
有空的请帮帮忙！！！

Gu_xl

1. (defun c:tt (/ EN D PT L1 L FN F D0 I)
   
2.   (if (and
   
3.         (setq en (entsel "\n选择曲线:"))
   
4.         (setq d (getdist "\n输入间距:"))
   
5.       )
   
6.     (progn
   
7.       (setq pt (cadr en)
   
8.             en (car en)
   
9.             pt (vlax-curve-getclosestpointto en pt)
   
10.             l1 (vlax-curve-getDistAtPoint en pt)
    
11.             l (vlax-curve-getDistAtParam en (vlax-curve-getEndParam en))
    
12.             )
    
13.       (setq fn (VL-FILENAME-MKTEMP "" "" ".txt"))
    
14.       (setq f (open fn "w"))
    
15.       (if (< l1 (* 0.5 l))
    
16.         (progn
    
17.           (setq d0 0 i 1)
    
18.           (while (< d0 l)
    
19.             (setq pt (vlax-curve-getPointAtDist en d0))
    
20.             (write-line (strcat (itoa i) " " (rtos (car pt) 2 3) " " (rtos (cadr pt) 2 3)) f)
    
21.             (setq i (1+ i)
    
22.                   d0 (+ d0 d)
    
23.                   )
    
24.             )
    
25.           (setq pt (vlax-curve-getEndPoint en))
    
26.           (write-line (strcat (itoa i) " " (rtos (car pt) 2 3) " " (rtos (cadr pt) 2 3)) f)
    
27.           (close f)
    
28.           )
    
29.         (progn
    
30.           (setq d0 l i 1)
    
31.           (while (> d0 0)
    
32.             (setq pt (vlax-curve-getPointAtDist en d0))
    
33.             (write-line (strcat (itoa i) " " (rtos (car pt) 2 3) " " (rtos (cadr pt) 2 3)) f)
    
34.             (setq i (1+ i)
    
35.                   d0 (- d0 d)
    
36.                   )
    
37.             )
    
38.           (setq pt (vlax-curve-getStartPoint en))
    
39.           (write-line (strcat (itoa i) " " (rtos (car pt) 2 3) " " (rtos (cadr pt) 2 3)) f)
    
40.           (close f)
    
41.           )
    
42.         )
    
43.       (startapp "notepad.exe" fn)
    
44.     )
    
45.   )
    
46.   (princ)
    
47. 
    
48. )

(defun c:tt (/ EN D PT L1 L FN F D0 I)<br />   (if (and<br />         (setq en (entsel "\n选择曲线:"))<br />         (setq d (getdist "\n输入间距:"))<br />       )<br />     (progn<br />       (setq pt (cadr en)<br />             en (car en)<br />             pt (vlax-curve-getclosestpointto en pt)<br />             l1 (vlax-curve-getDistAtPoint en pt)<br />             l (vlax-curve-getDistAtParam en (vlax-curve-getEndParam en))<br />             )<br />       (setq fn (VL-FILENAME-MKTEMP "" "" ".txt"))<br />       (setq f (open fn "w"))<br />       (if (< l1 (* 0.5 l))<br />         (progn<br />           (setq d0 0 i 1)<br />           (while (< d0 l)<br />             (setq pt (vlax-curve-getPointAtDist en d0))<br />             (write-line (strcat (itoa i) " " (rtos (car pt) 2 3) " " (rtos (cadr pt) 2 3)) f)<br />             (setq i (1+ i)<br />                   d0 (+ d0 d)<br />                   )<br />             )<br />           (setq pt (vlax-curve-getEndPoint en))<br />           (write-line (strcat (itoa i) " " (rtos (car pt) 2 3) " " (rtos (cadr pt) 2 3)) f)<br />           (close f)<br />           )<br />         (progn<br />           (setq d0 l i 1)<br />           (while (> d0 0)<br />             (setq pt (vlax-curve-getPointAtDist en d0))<br />             (write-line (strcat (itoa i) " " (rtos (car pt) 2 3) " " (rtos (cadr pt) 2 3)) f)<br />             (setq i (1+ i)<br />                   d0 (- d0 d)<br />                   )<br />             )<br />           (setq pt (vlax-curve-getStartPoint en))<br />           (write-line (strcat (itoa i) " " (rtos (car pt) 2 3) " " (rtos (cadr pt) 2 3)) f)<br />           (close f)<br />           )<br />         )<br />       (startapp "notepad.exe" fn)<br />     )<br />   )<br />   (princ)<br /> <br /> )

chenbh2

Gu_xl 发表于 2015-4-9 14:37

G版出手难题迎刃而解!

风树

Gu_xl 发表于 2015-4-9 14:37

谢谢，g版啊