马上注册,结交更多好友,享用更多功能,让你轻松玩转社区。
您需要 登录 才可以下载或查看,没有帐号?立即注册
x
[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)
- )
[/sell] |