拾取圆心点坐标，然后自动输出到excel中

szx025

在CAD中拾取圆心点坐标，然后自动输出到excel中，这个有高手写一个吗

fangmin723

兄弟，这么直接，直接让人帮你写，而不是在寻求帮助，但是想法不错，得有人愿意写

szx025

哈哈，我感觉难道不大，高手顺手就能写好

20060510412

这应该是想统计桩位坐标吧

fan_zh

钻石会员提这问题，不应该啊

szx025

;;;多段线顶点坐标导出到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 1  ent (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)
)
郎大师出品

yoyoho

谢谢! szx025 分享郎大师的程序!!!!!

ssyfeng

试试这个：

2. (defun c:tt (/ *error* en en-lst fil n path pt-lst ss ssn)
   
3.   (defun *error* ( msg )
   
4.     (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
   
5.       (progn (princ (strcat "\n错误：" msg)) (close fil))
   
6.     )
   
7.     (princ)
   
8.   )
   
9.   (setq ss (ssget '((0 . "CIRCLE")))
   
10.     ssn (sslength ss)
    
11.     n 0
    
12.   )
    
13.   (while (setq en (ssname ss (setq ssn (1- ssn))))
    
14.     (setq en-lst (cons en en-lst))
    
15.   )
    
16.   (mapcar '(lambda (x) (progn (setq pt (cdr (assoc 10 (entget x))))
    
17.                               (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))))))
    
18.                        )
    
19.            )
    
20.     en-lst
    
21.   )
    
22.   (setq pt-lst (cons '("序号\tX\tY") pt-lst))
    
23.   (setq path (getfiled "指定输出文件路径" "" "xls" 1)
    
24.     fil (open path "w")
    
25.   )
    
26.   (mapcar '(lambda (x) (write-line (car x) fil)) pt-lst)
    
27.   (close fil)
    
28.   (vlax-invoke (vlax-create-object "Shell.Application")  'open  path)
    
29.   (princ)
    
30. )

(defun c:tt (/ *error* en en-lst fil n path pt-lst ss ssn)<br />   (defun *error* ( msg )<br />     (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))<br />       (progn (princ (strcat "\n错误：" msg)) (close fil))<br />     )<br />     (princ)<br />   )<br />   (setq ss (ssget '((0 . "CIRCLE")))<br />     ssn (sslength ss)<br />     n 0<br />   )<br />   (while (setq en (ssname ss (setq ssn (1- ssn))))<br />     (setq en-lst (cons en en-lst))<br />   )<br />   (mapcar '(lambda (x) (progn (setq pt (cdr (assoc 10 (entget x))))<br />                               (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))))))<br />                        )<br />            )<br />     en-lst<br />   )<br />   (setq pt-lst (cons '("序号\tX\tY") pt-lst))<br />   (setq path (getfiled "指定输出文件路径" "" "xls" 1)<br />     fil (open path "w")<br />   )<br />   (mapcar '(lambda (x) (write-line (car x) fil)) pt-lst)<br />   (close fil)<br />   (vlax-invoke (vlax-create-object "Shell.Application")  'open  path)<br />   (princ)<br /> )