求转出圆孔坐标,直径的LISP.好心人请帮帮忙.

yth0407

能转出所选圆孔的坐标,直径成文本文件的LISP,转出格式能如下:

X0.00Y0.00D3.0

X10.50Y10.50D4.0

....................

高手帮帮忙,谢谢.

yth0407

高手帮帮忙啊,小弟先在这谢谢了.

sailorcwx

3. (defun c:cr(/ YH_CIRCLE YH_CPT YH_CR YH_FILEID YH_INDEX YH_SS)
4.   (princ "\n本程序将所选范围内的圆孔坐标及直径标示在C:盘cr.txt文件内")
5.   (setq YH_ss (ssget '((0 . "CIRCLE"))))
6.   (if YH_ss
7.     (progn
8.       (setq YH_index 0
9.      YH_fileid (open "C:\\cr.txt" "W")
10.      )
11.       (repeat (sslength YH_ss)
12. (setq YH_circle (entget (ssname YH_ss YH_index))
13.        YH_cpt (cdr (assoc 10 YH_circle))
14.        YH_cr (cdr (assoc 40 YH_circle))
15.        YH_index (1+ YH_index)
16.        )
17. (write-line (strcat "X" (rtos (car YH_cpt) 2 2) "Y" (rtos (cadr YH_cpt) 2 2) "D" (rtos YH_cr 2 1)) YH_fileid)
18. )
19. (close YH_fileid)
20.       (startapp "notepad" "C:\\cr.txt")
21.       )
22.     (alert "所选区域没有圆")
23.     )
24.   (princ)
25.   )

(defun c:cr(/ YH_CIRCLE YH_CPT YH_CR YH_FILEID YH_INDEX YH_SS)   (princ "\n本程序将所选范围内的圆孔坐标及直径标示在C:盘cr.txt文件内")   (setq YH_ss (ssget '((0 . "CIRCLE"))))   (if YH_ss     (progn       (setq YH_index 0      YH_fileid (open "C:\\cr.txt" "W")      )       (repeat (sslength YH_ss) (setq YH_circle (entget (ssname YH_ss YH_index))        YH_cpt (cdr (assoc 10 YH_circle))        YH_cr (cdr (assoc 40 YH_circle))        YH_index (1+ YH_index)        ) (write-line (strcat "X" (rtos (car YH_cpt) 2 2) "Y" (rtos (cadr YH_cpt) 2 2) "D" (rtos YH_cr 2 1)) YH_fileid) ) (close YH_fileid)       (startapp "notepad" "C:\\cr.txt")       )     (alert "所选区域没有圆")     )   (princ)   )

yth0407

真是太谢谢sailorcwx兄了,非常感谢.

flfcegu168

有下了  再次顶一下