提取多段线信息到指定的文件

newer

[sell=3]

1. (defun c:XDTB_Pl2file ( / arc bulge fn i nums p1 p2 pl)
   
2.   (prompt "\n提取顶点坐标到指定的文件...")
   
3.   (if (setq pl (car (xdrx_entsel "\n选定一条PolyLine<退出>:" '((0 . "*polyline")))))
   
4.     (progn
   
5.       (if (setq fn (xdrx_system_selectFiles "选取保存的文件名" "" "txt" 1))
   
6.         (progn
   
7.           (if (setq fn (open (car fn) "w"))
   
8.             (progn
   
9.               (setq nums (xdrx_getpropertyvalue pl "numverts")
   
10.                     i 0
    
11.               )
    
12.               (write-line (strcat "面积：" (rtos
    
13.                                                  (xdrx_getpropertyvalue pl "area")
    
14.                                                  2 1
    
15.                                            )
    
16.                           ) fn
    
17.               )
    
18.               (write-line (strcat "长度：" (rtos
    
19.                                                  (xdrx_getpropertyvalue pl "length")
    
20.                                                  2 1
    
21.                                            )
    
22.                           ) fn
    
23.               )
    
24.               (write-line "\n" fn)
    
25.               (repeat nums
    
26.                 (setq p1 (xdrx_getpropertyvalue pl "pointat" i))
    
27.                 (write-line (strcat "顶点" (itoa (+ i 1)) ":  X="
    
28.                                     (rtos (car p1) 2 4) " , Y="
    
29.                                     (rtos (cadr p1) 2 4)
    
30.                             ) fn
    
31.                 )
    
32.                 (setq bulge (xdrx_getpropertyvalue pl "bulgeat" i))
    
33.                 (if (/= bulge 0)
    
34.                   (progn
    
35.                     (setq p2 (xdrx_getpropertyvalue pl "pointat" (+ 1 i)))
    
36.                     (setq arc (xdrx_geom_poly2arc p1 bulge p2))
    
37. 
    
38.                     (write-line (strcat "     圆弧凸度：" (rtos bulge 2 4)
    
39.                                         "  圆心："
    
40.                                         (vl-princ-to-string (nth 1 arc))
    
41.                                         "  半径：" (rtos (nth 2 arc) 2 1)
    
42.                                         "  起始角：" (rtos (nth 3 arc) 2 4)
    
43.                                         "  终止角:" (rtos (nth 4 arc) 2 4)
    
44.                                         (if (car arc)
    
45.                                           "  逆时针"
    
46.                                           "  顺时针"
    
47.                                         )
    
48.                                 ) fn
    
49.                     )
    
50.                   )
    
51.                 )
    
52.                 (setq i (1+ i))
    
53.               )
    
54.               (close fn)
    
55.             )
    
56.           )
    
57.         )
    
58.       )
    
59.     )
    
60.   )
    
61.   (princ)
    
62. )
    
63. 
    

(defun c:XDTB_Pl2file ( / arc bulge fn i nums p1 p2 pl)<br />   (prompt "\n提取顶点坐标到指定的文件...")<br />   (if (setq pl (car (xdrx_entsel "\n选定一条PolyLine<退出>:" '((0 . "*polyline")))))<br />     (progn<br />       (if (setq fn (xdrx_system_selectFiles "选取保存的文件名" "" "txt" 1))<br />         (progn<br />           (if (setq fn (open (car fn) "w"))<br />             (progn<br />               (setq nums (xdrx_getpropertyvalue pl "numverts")<br />                     i 0<br />               )<br />               (write-line (strcat "面积：" (rtos<br />                                                  (xdrx_getpropertyvalue pl "area")<br />                                                  2 1<br />                                            )<br />                           ) fn<br />               )<br />               (write-line (strcat "长度：" (rtos<br />                                                  (xdrx_getpropertyvalue pl "length")<br />                                                  2 1<br />                                            )<br />                           ) fn<br />               )<br />               (write-line "\n" fn)<br />               (repeat nums<br />                 (setq p1 (xdrx_getpropertyvalue pl "pointat" i))<br />                 (write-line (strcat "顶点" (itoa (+ i 1)) ":  X="<br />                                     (rtos (car p1) 2 4) " , Y="<br />                                     (rtos (cadr p1) 2 4)<br />                             ) fn<br />                 )<br />                 (setq bulge (xdrx_getpropertyvalue pl "bulgeat" i))<br />                 (if (/= bulge 0)<br />                   (progn<br />                     (setq p2 (xdrx_getpropertyvalue pl "pointat" (+ 1 i)))<br />                     (setq arc (xdrx_geom_poly2arc p1 bulge p2))<br /> <br />                     (write-line (strcat "     圆弧凸度：" (rtos bulge 2 4)<br />                                         "  圆心："<br />                                         (vl-princ-to-string (nth 1 arc))<br />                                         "  半径：" (rtos (nth 2 arc) 2 1)<br />                                         "  起始角：" (rtos (nth 3 arc) 2 4)<br />                                         "  终止角:" (rtos (nth 4 arc) 2 4)<br />                                         (if (car arc)<br />                                           "  逆时针"<br />                                           "  顺时针"<br />                                         )<br />                                 ) fn<br />                     )<br />                   )<br />                 )<br />                 (setq i (1+ i))<br />               )<br />               (close fn)<br />             )<br />           )<br />         )<br />       )<br />     )<br />   )<br />   (princ)<br /> )<br /> <br />

[/sell]

AxueLJ

学习学习！！！！

天若有情007

不错，学习学习

彩云

谢谢分享，很有用

16719080

很不错，谢谢分享！

中华飘萍

很不错，谢谢分享！