【原创】 最新 圆心坐标输出到Excel、TXT、DAT文件的程序 更新版 【2009年1月6日更

jxphklibin

【原创】 最新 圆心坐标输出到Excel、TXT、DAT文件的程序 更新版 【2009年1月6日更新】[br]

【原创】 最新 圆心坐标输出到Excel、TXT、DAT文件的程序 更新版 【2009年1月6日更新】

Gu_xl

楼主不厚道，就这还收2个币！
我来发个简单的源码！

3. (defun c:tt(/ R kd ss n xyz en fn f)
4.   (setq dimzin (getvar "dimzin"))
5.   (setvar "dimzin" 0)
6.   (initget 7)
7.   (setq R (getreal " \n要输出圆心坐标的圆半径："))
8.   (initget 7 "1 2 3 4 5  ")
9.   (setq kd (getkword "\n[等于半径<1>/小于半径<2>/小于等于半径<3>/大于半径<4>/大于等于半径<5>]<1>:"))
10.   (cond ((or (= kd "1") (= kd ""))
11.   (setq ss (ssget (list '(0 . "circle")(cons 40 R))))
12.   )
13. ((= kd "2")
14.   (setq ss (ssget (list '(0 . "circle")'(-4 . "<")(cons 40 R))))
15.   )
16. ((= kd "3")
17.   (setq ss (ssget (list '(0 . "circle")'(-4 . "<=")(cons 40 R))))
18.   )
19. ((= kd "4")
20.   (setq ss (ssget (list '(0 . "circle")'(-4 . ">")(cons 40 R))))
21.   )
22. ((= kd "5")
23.   (setq ss (ssget (list '(0 . "circle")'(-4 . ">=")(cons 40 R))))
24.   )
25. )
26.   
27.   (if ss
28.     (progn
29.       (setq fn (getfiled "输入保存文件名" "" "csv" 1))
30.       (setq f (open fn "w"))
31.       (WRITE-LINE "序号,X横坐标,Y纵坐标,Z高程,半径" f)
32.       (setq n 0)
33.       (repeat (sslength ss)
34. (setq en (ssname ss n))
35. (setq n (1+ n))
36. (setq xyz (cdr (assoc 10 (entget en)))
37.        R (cdr (assoc 40 (entget en))))
38. (setq zc (strcat (itoa n) "," (rtos (car xyz) 2 3) "," (rtos (cadr xyz) 2 3) "," (rtos (caddr xyz) 2 3) "," (rtos R 2 3)))
39. (WRITE-LINE zc f)
41. )
42.       (close f)
43.       (startapp "notepad" fn)
44.       )
45.     )
46.   (setvar "dimzin" dimzin)
47.   (princ)
48.   )

(defun c:tt(/ R kd ss n xyz en fn f)   (setq dimzin (getvar "dimzin"))   (setvar "dimzin" 0)   (initget 7)   (setq R (getreal " \n要输出圆心坐标的圆半径："))   (initget 7 "1 2 3 4 5  ")   (setq kd (getkword "\n[等于半径<1>/小于半径<2>/小于等于半径<3>/大于半径<4>/大于等于半径<5>]<1>:"))   (cond ((or (= kd "1") (= kd ""))   (setq ss (ssget (list '(0 . "circle")(cons 40 R))))   ) ((= kd "2")   (setq ss (ssget (list '(0 . "circle")'(-4 . "<")(cons 40 R))))   ) ((= kd "3")   (setq ss (ssget (list '(0 . "circle")'(-4 . "<=")(cons 40 R))))   ) ((= kd "4")   (setq ss (ssget (list '(0 . "circle")'(-4 . ">")(cons 40 R))))   ) ((= kd "5")   (setq ss (ssget (list '(0 . "circle")'(-4 . ">=")(cons 40 R))))   ) )      (if ss     (progn       (setq fn (getfiled "输入保存文件名" "" "csv" 1))       (setq f (open fn "w"))       (WRITE-LINE "序号,X横坐标,Y纵坐标,Z高程,半径" f)       (setq n 0)       (repeat (sslength ss) (setq en (ssname ss n)) (setq n (1+ n)) (setq xyz (cdr (assoc 10 (entget en)))        R (cdr (assoc 40 (entget en)))) (setq zc (strcat (itoa n) "," (rtos (car xyz) 2 3) "," (rtos (cadr xyz) 2 3) "," (rtos (caddr xyz) 2 3) "," (rtos R 2 3))) (WRITE-LINE zc f) )       (close f)       (startapp "notepad" fn)       )     )   (setvar "dimzin" dimzin)   (princ)   )

香远益清

择对象:  正在输出到EXCEL，请不要进行其它操作......*** 用户已取消 ***"no
function definition: MSXL-GET-RANGE"

还有个支持函数文件没上传吧？

aichong

正在输出到EXCEL，请不要进行其它操作......
调用(*push-error-using-command*)前无法从 *error* 调用(command)。
建议将(command)调用转换为(command-s)。

cq_qg

怎么没有钱？

kailee

没有钱下载不了

很遗憾！

xxmxxm

下不了

pezyl

我新手学习中但是没钱啊...

yucpp

没有源码，楼主太不厚道了。

CAD83

楼主太不厚道了。

tanwei

没有钱下载不了

anchor52052

想看看，怎奈囊中羞涩

shaojingjing

楼主真的真的太不厚道了