(defun C:SPL (/ sl se sel nn path PLstr i j n
tt1 tt2 x y ssl xl wbs wb shs sh rg
cs vvv nms nm ttt
)
(command "undo" "begin")
(setq sl (ssget))
(setq nn 0)
(repeat (sslength sl)
(setq se (ssname sl nn))
(setq sel (entget se))
(if (= "LWPOLYLINE" (cdr (assoc 0 sel)))
(setq el sel)
)
(setq nn (1+ nn))
)
(setq n (length el))
(setq path (getfiled "指定输出文件" "D:\\" "xlsx" 1))
(if (= path nil)
(progn (setq path (getfiled "指定输出文件" "D:\\" "xlsx" 1))
)
(progn
(vl-load-com)
(setq xl (vlax-get-or-create-object "Excel.Application"))
(vla-put-visible xl 0)
(setq wbs
(vlax-invoke-method (vlax-get-property xl 'WorkBooks) 'Add)
)
(setq shs (vlax-get-property wbs "Sheets"))
(setq sh (vlax-get-property shs "Item" "Sheet1"))
(setq ssl (vlax-get-property sh "cells"))
(setq i 0)
(setq tt1 0)
(while (<= i (- n 1))
(if (= 10 (car (nth i el)))
(progn
(setq tt2 (+ tt1 1))
(setq plstr (nth i el))
(setq x (cadr plstr))
(setq y (caddr plstr))
(setq tt1 tt2)
(vlax-put-property
ssl
"item"
tt2
1
(vl-princ-to-string "X=")
)
(vlax-put-property
ssl
"item"
tt2
2
(vl-princ-to-string x)
)
(vlax-put-property
ssl
"item"
tt2
3
(vl-princ-to-string "Y=")
)
(vlax-put-property ssl "item" tt2 4 (vl-princ-to-string y))
(setq i (+ i 1))
)
(setq i (+ i 1))
)
)
(vlax-invoke-method
(vlax-get-property xl "ActiveWorkbook")
"SaveAs"
path
msxl-xlNormal
""
""
:vlax-False
:vlax-False
nil
)
(vlax-invoke-method xl "Quit") ;退出excel对象
(vlax-release-object xl) ;释放excel对象
)
)
)