南方CASS点号提取展点号坐标

happy336

原帖“根据南方CASS点号提取展点号坐标”中code代码另存为lsp文件，执行命令显示为字符串有缺陷。在此向大家请教有更好的方法谢谢分享
原code代码如下：

2. 
   
3. 
   
4. (defun c:tt( / f ss lst ss m n e a ee b ptlst1  xx  bb)
   
5.   (setq f(open(getfiled "打开(或建立)数据文件" "C:" "dat" 1)"w"))
   
6.   (setq ss(ssget"X"'((8 . "ZDH")(0 . "POINT,INSERT")(-3 ("NAME,CODE")))))
   
7.   (setq lst '())
   
8.   (setq bb "NAME,CODE, Y坐标,X坐标,高程\n")
   
9.   (if ss
   
10.     (progn(setq m 0
    
11.     n(sslength ss))
    
12.       (while(< m n)
    
13.   (setq e(entget(ssname ss m)'("*"))m(1+ m))
    
14.   (if (setq a(cdr(assoc -3 e)))
    
15.     (setq eE(cdr(assoc 10 e))
    
16.                 b (LIST  (atof (cdr (car  (cdr (nth 0 a)))))   (read (cdr (car  (cdr (nth 1 a)))))  (CAR EE)  (CADR EE) (CADDR EE))
    
17.    
    
18.        )
    
19.     )  (SETQ LST (APPEND LST (LIST B)))
    
20.   );;;;;;;;;;;;;;;;;;;;;;
    
21.       
    
22. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    
23. (setq ptlst (vl-sort LST
    
24.                    ;以下根据点号对表排序
    
25.    '(lambda (e1 e2)
    
26.             (<= (car e1) (car e2) )
    
27.          )   )    )
    
28. ;;;;;;;;;;;;;;;;;-----------------------------------
    
29. (foreach xx ptlst
    
30. 
    
31. (setq bb(strcat bb(vl-princ-to-string  (nth 0 xx))","(vl-princ-to-string  (nth 1 xx))","(rtos (nth 2 xx) 2 3)"," (rtos (nth 3 xx) 2 3)","(rtos (nth 4 xx) 2 3)"\n"))
    
32.   
    
33.   )
    
34.       
    
35. 
    
36.       ))
    
37.     (write-line bb f)
    
38.     (close f)
    
39.   )
    
40. 
    

<br /> <br /> (defun c:tt( / f ss lst ss m n e a ee b ptlst1  xx  bb)<br />   (setq f(open(getfiled "打开(或建立)数据文件" "C:" "dat" 1)"w"))<br />   (setq ss(ssget"X"'((8 . "ZDH")(0 . "POINT,INSERT")(-3 ("NAME,CODE")))))<br />   (setq lst '())<br />   (setq bb "NAME,CODE, Y坐标,X坐标,高程\n")<br />   (if ss<br />     (progn(setq m 0<br />     n(sslength ss))<br />       (while(< m n)<br />   (setq e(entget(ssname ss m)'("*"))m(1+ m))<br />   (if (setq a(cdr(assoc -3 e)))<br />     (setq eE(cdr(assoc 10 e))<br />                 b (LIST  (atof (cdr (car  (cdr (nth 0 a)))))   (read (cdr (car  (cdr (nth 1 a)))))  (CAR EE)  (CADR EE) (CADDR EE))<br />     <br />        )<br />     )  (SETQ LST (APPEND LST (LIST B)))<br />   );;;;;;;;;;;;;;;;;;;;;;<br />       <br /> ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;<br /> (setq ptlst (vl-sort LST<br />                    ;以下根据点号对表排序<br />    '(lambda (e1 e2)<br />             (<= (car e1) (car e2) )<br />          )   )    )<br /> ;;;;;;;;;;;;;;;;;-----------------------------------<br /> (foreach xx ptlst<br /> <br /> (setq bb(strcat bb(vl-princ-to-string  (nth 0 xx))","(vl-princ-to-string  (nth 1 xx))","(rtos (nth 2 xx) 2 3)"," (rtos (nth 3 xx) 2 3)","(rtos (nth 4 xx) 2 3)"\n"))<br />   <br />   )<br />       <br /> <br />       ))<br />     (write-line bb f)<br />     (close f)<br />   )<br /> <br />