拾取圆心点坐标，然后自动输出到excel中
在CAD中拾取圆心点坐标，然后自动输出到excel中，这个有高手写一个吗兄弟，这么直接，直接让人帮你写，而不是在寻求帮助，但是想法不错，得有人愿意写 哈哈，我感觉难道不大，高手顺手就能写好 这应该是想统计桩位坐标吧 钻石会员提这问题，不应该啊 ;;;多段线顶点坐标导出到EXCEL
;;; by:langjs
(defun c:aa ( / ent file filex i j p ss)
(setq ss (ssget '((0 . "LWPOLYLINE")))i 0
filex (getfiled "指定输出文件路径" "" "xls" 1) file (open filex "w"))
(repeat (sslength ss)
(setq j 1ent (entget (ssname ss i))p (cdr (assoc 10 ent)))
(write-line (strcat "Line" (itoa (1+ i))) file)
(write-line "oint\tX\tY\tZ" file)
(entmake (list '(0 . "TEXT") (cons 1 (strcat "Line" (itoa (1+ i)))) (cons 10 (list (car p) (+ (cadr p) 50))) (cons 40 30)))
(while (setq p (assoc 10 ent))
(setq ent (cdr (member p ent)) p (cdr p))
(entmake (list '(0 . "TEXT") (cons 1 (itoa j)) (cons 10 (list (+ (car p) 10) (+ (cadr p) 10))) (cons 40 30)))
(write-line (strcat (itoa j) "\t" (rtos (car p) 2 4) "\t" (rtos (cadr p) 2 4) "\t"
(if (caddr p) (rtos (caddr p) 2 4)"0.0")) file )
(setq j (1+ j))
)
(setq i (1+ i))
)
(close file)
(command "start" filex)
(princ)
)
郎大师出品 谢谢! szx025 分享郎大师的程序!!!!! 试试这个：
(defun c:tt (/ *error* en en-lst fil n path pt-lst ss ssn)
(defun *error* ( msg )
(if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
(progn (princ (strcat "\n错误：" msg)) (close fil))
)
(princ)
)
(setq ss (ssget '((0 . "CIRCLE")))
ssn (sslength ss)
n 0
)
(while (setq en (ssname ss (setq ssn (1- ssn))))
(setq en-lst (cons en en-lst))
)
(mapcar '(lambda (x) (progn (setq pt (cdr (assoc 10 (entget x))))
(setq pt-lst (append pt-lst (list (list (strcat (itoa (setq n (1+ n))) "\t" (rtos (car pt) 2 3) "\t" (rtos (cadr pt) 2 3))))))
)
)
en-lst
)
(setq pt-lst (cons '("序号\tX\tY") pt-lst))
(setq path (getfiled "指定输出文件路径" "" "xls" 1)
fil (open path "w")
)
(mapcar '(lambda (x) (write-line (car x) fil)) pt-lst)
(close fil)
(vlax-invoke (vlax-create-object "Shell.Application")'openpath)
(princ)
)
页:
[1]