求助，散点坐标提取

shrine2014

1. 
   

复制代码

2. (defun err(msg)
   
3.   (setvar "dimzin" zin)
   
4.   (setq *error* errtmp)
   
5.   (close f)
   
6.   (princ "取消或没有可输出对象...")
   
7. )
   
8. 
   
9. (defun c:OutData( / f filename BlockName ss ent ents ptlnsert ent1 ent2 entlst i)
   
10.   (setq BlockName "HH")
    
11.   (setq zin (getvar "dimzin"))
    
12.   (setvar "dimzin" 1)
    
13.   (setq errtmp *error*)
    
14.   (setq *error* err)
    
15.   (setq filename (setq filename (getfiled "保存输出文件..." "" "TXT" 1)))
    
16.   (if (not filename)(exit))
    
17.   
    
18.   (prompt "选择坐标<直接回车全选>...")
    
19.   (setq ss (ssget (list '(0. "INSERT")(cons 2 BlockName))))
    
20.   (if (not ss)
    
21.     (setq ss (ssget "x" (list '(0. "INSERT")(cons 2 BlockName))))
    
22.   )  
    
23.   (setq f (open filename "w"))
    
24.   (write-line "X\t\t\tY\t\t高程" f)
    
25.   (setq i 0)
    
26.   (repeat (sslength ss)
    
27.     (setq ent (ssname ss i))
    
28.     (setq ents (entget ent))
    
29.     (setq ptlnsert (cdr (assoc 10 ents)))
    
30.     (setq ent1 (entnext ent))
    
31.     (setq ent2 (entnext ent1))
    
32.     (setq entlst (list ent1 ent2))
    
33.     (setq entlst (vl-sort '(lambda(e1 e2)(<(cadr (assoc 10(entget e1)))(cadr (assoc 10 (entget e2)))))))
    
34.     (setq entlst (mapcar '(lambda(e)(cdr (assoc 1(entget e))))entlst))
    
35.     (set i(1+i))
    
36.     (write-line (strcat (rtos(car ptlnsert)2 8) "\t"
    
37.                 (rtos (cadr ptlnsert)2 8) "\t"
    
38.                 (car entlst) "." (cadr entlst)
    
39.                 )f)
    
40.     )
    
41.   (close f)
    
42.   (setvar "dimzin" zin)
    
43.   (setq *error* errtmp)
    
44.   ;(list ptlnsert entlst)
    
45.   (princ)
    
46. )
    
47.   
    
48. (prompt "\nPress OUTDATA to launch the program!")

(defun err(msg)<br />   (setvar "dimzin" zin)<br />   (setq *error* errtmp)<br />   (close f)<br />   (princ "取消或没有可输出对象...")<br /> )<br /> <br /> (defun c:OutData( / f filename BlockName ss ent ents ptlnsert ent1 ent2 entlst i)<br />   (setq BlockName "HH")<br />   (setq zin (getvar "dimzin"))<br />   (setvar "dimzin" 1)<br />   (setq errtmp *error*)<br />   (setq *error* err)<br />   (setq filename (setq filename (getfiled "保存输出文件..." "" "TXT" 1)))<br />   (if (not filename)(exit))<br />   <br />   (prompt "选择坐标<直接回车全选>...")<br />   (setq ss (ssget (list '(0. "INSERT")(cons 2 BlockName))))<br />   (if (not ss)<br />     (setq ss (ssget "x" (list '(0. "INSERT")(cons 2 BlockName))))<br />   )  <br />   (setq f (open filename "w"))<br />   (write-line "X\t\t\tY\t\t高程" f)<br />   (setq i 0)<br />   (repeat (sslength ss)<br />     (setq ent (ssname ss i))<br />     (setq ents (entget ent))<br />     (setq ptlnsert (cdr (assoc 10 ents)))<br />     (setq ent1 (entnext ent))<br />     (setq ent2 (entnext ent1))<br />     (setq entlst (list ent1 ent2))<br />     (setq entlst (vl-sort '(lambda(e1 e2)(<(cadr (assoc 10(entget e1)))(cadr (assoc 10 (entget e2)))))))<br />     (setq entlst (mapcar '(lambda(e)(cdr (assoc 1(entget e))))entlst))<br />     (set i(1+i))<br />     (write-line (strcat (rtos(car ptlnsert)2 8) "\t"<br />                 (rtos (cadr ptlnsert)2 8) "\t"<br />                 (car entlst) "." (cadr entlst)<br />                 )f)<br />     )<br />   (close f)<br />   (setvar "dimzin" zin)<br />   (setq *error* errtmp)<br />   ;(list ptlnsert entlst)<br />   (princ)<br /> )<br />   <br /> (prompt "\nPress OUTDATA to launch the program!")

这是十年前meflying老大给我写的提取AutoCAD散点坐标的代码，原文件找不到了，我是把抄在纸上的重新录入，现在载入出现错误：参数类型错误：streamp nil


我想提取如下文件的xyz三维坐标，xy平面坐标从点的特性中读取，z坐标为附近标注的文本（圆点中虽然也有z坐标，但是大多数情况下是不准的，所以要读取文本作为高程z）