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

newer · 发表于 2016-5-7 23:19:26

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

[sell=3]

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

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

[/sell]

AxueLJ · 发表于 2016-5-15 06:55:18

学习学习！！！！

天若有情007 · 发表于 2016-9-26 23:53:50

不错，学习学习

彩云 · 发表于 2016-10-3 23:35:14

谢谢分享，很有用

16719080 · 发表于 2016-12-11 21:14:16

很不错，谢谢分享！

中华飘萍 · 发表于 2019-6-8 19:33:29

很不错，谢谢分享！

账号		自动登录	找回密码
密码			立即注册

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

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。