[求助]求助高手编一个每隔一定距离提取坐标的程序

tianyuan

假如说由很多条pl线，根据pe命令后合成一条线后，如果平均每隔一定的距离，如何提取这条线上的坐标。（比如说每隔10米或者20米30米等等，根据输入的间隔距离而定）。

谢谢！

ZZXXQQ

1、使用MEASURE命令定矩画点；

2、提取这些点，并输出点的坐标。

tianyuan

能不能编一个程序，将这些点的坐标一次性全部输出？

ZZXXQQ

输出格式？从线的什么地方开始输出？包括线条的端点吗？

tianyuan

输出的格式为x=    y=     z=   全部输出到.txt文件中 

坐标起点根据所选由多条小pl线合成一整条pl线的一头做为起点（坐标要包括这该pl线的起点和最后的端点）每隔一定的距离提取坐标值。至于小线条的端点可可忽略不计。

ZZXXQQ

2. (DEFUN C:TEST ()
3. (SETVAR "CMDECHO" 0)
4. (SETQ OLDOS (GETVAR "OSMODE"))
5. (SETVAR "OSMODE" 0)
6. (SETQ LN "LL")
7. (WHILE (NOT (WCMATCH LN "*POLYLINE"))
8.   (SETQ SE (ENTSEL "\nSelect a Polyline :")
9. ENT (ENTGET (CAR SE))
10. LN (CDR (ASSOC 0 ENT)))
11. )
12. (SETQ PT (CADR SE))
13. (IF (SETQ DD (GETDIST "\nEnter Distance for Measure :")) (PROGN
14.   (IF (= LN "LWPOLYLINE")
15.    (SETQ PT1 (CDR (ASSOC 10 ENT))
16.   PT2 (CDR (ASSOC 10 (REVERSE ENT))))
17.   (PROGN
18.    (SETQ SN1 (ENTNEXT (CDR (ASSOC -1 ENT)))
19.          LB (ENTGET SN1)          LM (CDR (ASSOC 0 LB))
20.          PT1 (CDR (ASSOC 10 LB)))
21.    (WHILE (/= LM "SEQEND")
22.     (SETQ SN1 (ENTNEXT (CDR (ASSOC -1 LB)))  LB (ENTGET SN1)
23.           LM (CDR (ASSOC 0 LB))        PT2 (CDR (ASSOC 10 LB)))
24.    )
25.   ))
26.   (IF (> (DISTANCE PT PT1) (DISTANCE PT PT2)) (SETQ PTT PT1 PT1 PT2 PT2 PTT))
27.   (COMMAND "MEASURE" PT DD)
28.   (SETQ SS (SSGET "P")
29. PT0 (CDR (ASSOC 10 (ENTGET (SSNAME SS 0))))
30. SL (SSLENGTH SS) DL (LIST (APPEND PT1 (LIST 0.0))))
31.   (IF (> (DISTANCE PT0 PT1) (DISTANCE PT0 PT2))
32.    (SETQ I (1- SS) N -1)
33.    (SETQ I 0 N 1)
34.   )
35.   (REPEAT (SSLENGTH SS)
36.    (SETQ PTT (CDR (ASSOC 10 (ENTGET (SSNAME SS I))))
37.          I (+ I N)
38.   DL (APPEND DL (LIST PTT)))
39.   )
40.   (SETQ DL (APPEND DL (LIST (APPEND PT2 (LIST 0.0)))))
41.   (SETQ NM (IF NM NM ""))
42.   (IF (SETQ NM (GETFILED "Select file name to write :" NM "txt" 1)) (PROGN
43.    (SETQ FP (OPEN NM "w")
44.   I -1)
45.    (REPEAT (LENGTH DL)
46.     (PRINC (NTH (SETQ I (1+ I)) DL) FP) (PRINC "\n" FP)
47.    )
48.    (CLOSE FP)
49.    (COMMAND "NOTEPAD" NM)
50.   ))
51. ))
52. (SETVAR "OSMODE" OLDOS)
53. (SETVAR "CMDECHO" 1)
54. (PRINC)
55. )

复制代码

lzy9788

看看这个

zhongguola

真是个好东东，楼上的，在那里可以下载？

carrot1983

7楼的程序好漂亮！！

我喜欢！能不能提供个下载地址啊！

carrot1983

根据7楼的，我自己也写一个，附件里有一个lsp和一个xy的块

3. (defun get_pt (ent / elist ptlist)
4.   (setq elist (entget ent))
5.   (foreach n elist
6.     (if (= 10 (car n))
7.       (setq ptlist (cons (cdr n) ptlist))
8.     )
9.   )
10.   ptlist
11. )
13. (defun C:tt (/ osm pt ss ent ptlst ptx pty n npt nptlst)
14.   (setq osm (getvar "osmode"))
15.   (setvar "osmode" 1)
16.   (setq pt (getpoint))
17.   (setvar "osmode" osm)
18.   (setq ss    (ssget pt)
19. ent   (ssname ss 0)
20. ptlst (get_pt ent)
21. ptx   (car pt)
22. pty   (cadr pt)
23.   )
24.   (foreach n ptlst
25.     (setq nptx (rtos (- (car n) ptx) 2 3)
26.    npty (rtos (- (cadr n) pty) 2 3)
27.     )
28.     (command "-insert" "xy" n "1" "1" "0" nptx npty);_这里的块xy是我自己做的。放在搜索路径里面就能使用！
29.   )
30.   (princ)
31. )

(defun get_pt (ent / elist ptlist)   (setq elist (entget ent))   (foreach n elist     (if (= 10 (car n))       (setq ptlist (cons (cdr n) ptlist))     )   )   ptlist ) (defun C:tt (/ osm pt ss ent ptlst ptx pty n npt nptlst)   (setq osm (getvar "osmode"))   (setvar "osmode" 1)   (setq pt (getpoint))   (setvar "osmode" osm)   (setq ss    (ssget pt) ent   (ssname ss 0) ptlst (get_pt ent) ptx   (car pt) pty   (cadr pt)   )   (foreach n ptlst     (setq nptx (rtos (- (car n) ptx) 2 3)    npty (rtos (- (cadr n) pty) 2 3)     )     (command "-insert" "xy" n "1" "1" "0" nptx npty);_这里的块xy是我自己做的。放在搜索路径里面就能使用！   )   (princ) )