[求助]：pl线中点的坐标获得问题？

gxynd

经常要把多义线的坐标获得到要转为其他格式，但是cad中用list命令只能获得特定格式的坐标方式，要经过多次转化后才能成为自己想要的格式(一般在word或excel中转化)，能不能编写一个程序，改变坐标格式，然后直接复制使用呢？
还有当点较多时，系统老是提示按enter键继续，能不能拿掉，这样比较方便一点，忘兄台指点一二，编个例子让小弟也学学(最好中间能用一个空格符分开，小弟经常要用到)

xyp1964

看看这个:
http://www.xdcad.net/forum/showthread.php?s=&threadid=325268
test010：多义线顶点坐标 ★

david96007

2. 
   
3. (defun c:zbxwj ()
   
4.   (setvar "cmdecho" 0)
   
5.   (setq ffn (getfiled "\n 保存的坐标文件" "czg write" "txt" 1))
   
6.   (setq ff (open ffn "w"))
   
7.   (close ff)
   
8.   (princ "\n 选择多段线")
   
9.   (setq ss (ssget))
   
10.   (setq i 0)
    
11.   (repeat (sslength ss)
    
12.     (setq ssn (ssname ss i))
    
13.     (setq ssdata (entget ssn))
    
14.     (setq sstype (cdr (assoc 0 ssdata)))
    
15.     (if        (= sstype "LWPOLYLINE")
    
16.       (progn
    
17.         (setq n 0)
    
18.         (repeat        (length ssdata)
    
19.           (setq pp (nth n ssdata))
    
20.           (setq key (car pp))
    
21.           (if (= key 10)
    
22.             (progn
    
23.               (setq x (cadr pp))
    
24.               (setq y (caddr pp))
    
25.               (setq ff (open ffn "a"))
    
26.               (princ x ff)
    
27.               (princ "\t" ff)
    
28.               (princ y ff)
    
29.               (princ "\n" ff)
    
30.               (close ff)
    
31.             ) ;_ end of progn
    
32.           ) ;_ end of if
    
33.           (setq n (1+ n))
    
34.         ) ;_ end of repeat
    
35.       ) ;_ end of progn
    
36.     ) ;_ end of if
    
37.     (setq ff (open ffn "a"))
    
38.     (princ "\n" ff)
    
39.     (close ff)
    
40. 
    
41.     (setq i (1+ i))
    
42.   ) ;_ end of repeat
    
43. 
    
44.   (setq ff (open ffn "a"))
    
45.   (princ "\n 结束\n" ff)
    
46.   (close ff)
    
47. 
    
48.   (princ (strcat "\n 坐标写至=>" ffn))
    
49.   (prin1)
    
50. ) ;_ end of defun
    
51. 
    
52. (prompt "\n ***<>*** 程序设计作者：ZG*CHEN")
    
53. (prompt "\n 多段线坐标写入指定文件 命令: zbxwj")
    
54. (prin1)
    

<br /> (defun c:zbxwj ()<br />   (setvar "cmdecho" 0)<br />   (setq ffn (getfiled "\n 保存的坐标文件" "czg write" "txt" 1))<br />   (setq ff (open ffn "w"))<br />   (close ff)<br />   (princ "\n 选择多段线")<br />   (setq ss (ssget))<br />   (setq i 0)<br />   (repeat (sslength ss)<br />     (setq ssn (ssname ss i))<br />     (setq ssdata (entget ssn))<br />     (setq sstype (cdr (assoc 0 ssdata)))<br />     (if        (= sstype "LWPOLYLINE")<br />       (progn<br />         (setq n 0)<br />         (repeat        (length ssdata)<br />           (setq pp (nth n ssdata))<br />           (setq key (car pp))<br />           (if (= key 10)<br />             (progn<br />               (setq x (cadr pp))<br />               (setq y (caddr pp))<br />               (setq ff (open ffn "a"))<br />               (princ x ff)<br />               (princ "\t" ff)<br />               (princ y ff)<br />               (princ "\n" ff)<br />               (close ff)<br />             ) ;_ end of progn<br />           ) ;_ end of if<br />           (setq n (1+ n))<br />         ) ;_ end of repeat<br />       ) ;_ end of progn<br />     ) ;_ end of if<br />     (setq ff (open ffn "a"))<br />     (princ "\n" ff)<br />     (close ff)<br /> <br />     (setq i (1+ i))<br />   ) ;_ end of repeat<br /> <br />   (setq ff (open ffn "a"))<br />   (princ "\n 结束\n" ff)<br />   (close ff)<br /> <br />   (princ (strcat "\n 坐标写至=>" ffn))<br />   (prin1)<br /> ) ;_ end of defun<br /> <br /> (prompt "\n ***<>*** 程序设计作者：ZG*CHEN")<br /> (prompt "\n 多段线坐标写入指定文件 命令: zbxwj")<br /> (prin1)<br />

qinj9703034

我觉得作为一个程序员，首先要人性化，其次也要为计算机做考虑，有getfile函数是一个好的做法，但好象没有必要open和close在程序中N多次地出现，计算机很快，但我想她们不应该是为了处理大量的无用代码发热。在构造选择集的时候，有时候可能中需要处理一条线段或是某一图层中的多义线，写者却选择了图形所有的多义线！

xyp1964

最初由 qinj9703034 发布
[B]我觉得作为一个程序员，首先要人性化，其次也要为计算机做考虑，有getfile函数是一个好的做法，但好象没有必要open和close在程序中N多次地出现，计算机很快，但我想她们不应该是为了处理大量的无用代码发热。在构造?.. [/B]

楼上：能否给编个不用“open和close”的程序？

f5612140

照4樓說的可稍為簡化
(defun c:zbxwj ()
  (setvar "cmdecho" 0)
  (setq ffn (getfiled "\n 保存的坐標文件" "czg write" "txt" 1))
  (setq ff (open ffn "w"))
  (setq ss (ssget))
  (setq ss (ssget "p" '((0 . "LWPOLYLINE"))))
  (setq i 0)
  (repeat (sslength ss)
    (setq ssn (ssname ss i))
    (setq ssdata (entget ssn))
    (setq n 0)
    (repeat (length ssdata)
      (setq pp (nth n ssdata))
      (setq key (car pp))
      (if (= key 10)
        (progn
          (setq x (cadr pp))
          (setq y (caddr pp))
          (princ x ff)
          (princ "\t" ff)
          (princ y ff)
          (princ "\n" ff)
        ) ;_ end of progn
       ) ;_ end of if
       (setq n (1+ n))
    ) ;_ end of repeat
   
    (setq i (1+ i))
    (princ "\n 結束\n" ff)
  ) ;_ end of repeat

  (close ff)

  (princ (strcat "\n 坐標寫至=>" ffn))
  
) ;_ end of defun

(prompt "\n ***<>*** 程序設計作者：ZG*CHEN")
(prompt "\n 多段線坐標寫入指定文件 命令: zbxwj")
(prin1)

xyp1964

小数点应保留至少3位。
[php];;;坐标写文件
(defun c:zbxwj (/ ffn ff ss i ssn ssdata n pp key x y)
  (setvar "cmdecho" 0)
  (setq        ffn (getfiled "\n保存的坐标文件" "坐标" "txt" 1)
        ff  (open ffn "w")
        ss  (ssget '((0 . "*LINE")))
        i   -1)
  (repeat (sslength ss)
    (setq ssdata (entget (ssname ss (setq i (1+ i)))) n 0)
    (repeat (length ssdata)
      (setq pp        (nth n ssdata) key (car pp))
      (if (= key 10)
        (progn
          (setq tx (strcat (rtos (cadr pp) 2 3) " , " (rtos (caddr pp) 2 3)))
          (write-line tx ff)))
      (setq n (1+ n))))
  (close ff)
  (princ (strcat "\n 坐标写至=>" ffn))
  (princ))
(prompt "\n***<>*** 程序设计作者：ZG*CHEN")
(prompt "\n多段线坐标写入指定文件 命令: zbxwj")[/php]