- 积分
- 24405
- 明经币
- 个
- 注册时间
- 2011-7-5
- 在线时间
- 小时
- 威望
-
- 金钱
- 个
- 贡献
-
- 激情
-
|
源码来自于网络,版权归原作者所有。
输出后的Excel文件在d盘根目录下的Point.csv
源码如下:
(defun c:tes ( / &a0 &dis1 &k1 &kw1 &ss1 &ss2)
(if (null vlax-dump-object) (vl-load-com) )
(princ "\n请选择曲线")
(setq &ss1 '("LINE" "LWPOLYLINE" "CIRCLE" "ARC" "HELIX" "ELLIPSE" "SPLINE" "POLYLINE"))
(if (setq &kw1 (ssget '((0 . "LINE,LWPOLYLINE,CIRCLE,ARC,HELIX,ELLIPSE,SPLINE,POLYLINE"))))
(progn
(setq &ss2 '())
(while (setq &k1 (ssname &kw1 0))
(setq &kw1 (ssdel &k1 &kw1) &a0 (cdr (assoc 0 (entget &k1))))
(setq &dis1 (vlax-curve-getDistAtParam &k1 (vlax-curve-getEndParam &k1)))
(setq &ss2 (cons (cons &a0 &dis1) &ss2))
);while
(s1606021 &ss1 &ss2)
)
)
(princ)
)
(defun s1606021 (&ss1 &ss2 / &a0 &dis1 &ss1 &ss2 &ss3 ff x y);写入长度到表格
(setq ff (open "D://Point.csv" "w"));D盘表格Point
(while (setq &a0 (car &ss1))
(setq &ss1 (cdr &ss1))
(if (setq &ss3 (mapcar 'cdr (vl-remove-if-not '(lambda (X) (= &a0 (car x))) &ss2)))
(progn
(setq &ss3 (vl-sort &ss3 '(lambda (x y) (< x y))));长度从小到大
(while (setq &dis1 (car &ss3))
(setq &ss3 (cdr &ss3))
(write-line (strcat &a0 "," (rtos &dis1)) ff)
);while
(write-line "" ff)
)
);if
);while
(close ff)
)
|
|