[编程交流] 用于点导出的LISP

(defun c:TesT (/ *error* dir fNme ss i sname c)
 (vl-load-com)
; THARWAT Oct. 07.2010
 (defun *error* (msg)
   (and fNme (close fNme))
   (if (and msg
            (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*QUIT*,"))
       )
     (princ (strcat "\nError: " msg))
   )
 )
 (setq dir "C:\\My Folder")
 (vl-mkdir dir)
 (if (and
       (setq fNme (open "C:/My Folder/coordinates.txt" "w"))
       (setq ss (ssget '((0 . "CIRCLE"))))
     )
   (progn
     (repeat (setq i (sslength ss))
       (setq sname (ssname ss (setq i (1- i))))
       (setq c (cdr (assoc 10 (entget sname))))
       (write-line
         (strcat (rtos (car c) 2 2) "\t" (rtos (cadr c) 2 2))
         fNme
       )
     )
     (close fNme)
   )
   (princ)
 )
 (princ)
)

(defun c:TesT (/ *error* dir fNme ss i sname c x y)
 (vl-load-com)
; THARWAT Oct. 07.2010
 (defun *error* (msg)
   (and fNme (close fNme))
   (if (and msg
            (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*QUIT*,"))
       )
     (princ (strcat "\nError: " msg))
   )
 )
 (setq dir "C:\\My Folder")
 (vl-mkdir dir)
 (if (and
       (setq fNme (open "C:/My Folder/coordinates.txt" "w"))
       (setq ss (ssget '((0 . "CIRCLE"))))
     )
   (progn
     (repeat (setq i (sslength ss))
       (setq sname (ssname ss (setq i (1- i))))
       (setq c (cdr (assoc 10 (entget sname))))
       (write-line
         (strcat (setq x (rtos (car c) 2 2))
                 "\t"
                (setq y (rtos (cadr c) 2 2))
         )
         fNme
       )
       (entmakex (list '(0 . "MTEXT")
                       '(100 . "AcDbEntity")
                       '(100 . "AcDbMText")
                       (cons 40 (getvar 'textsize))
                       (cons 1
                             (strcat "X" "=" " " x "\\P" "Y" "=" " " y)
                       )
                       (assoc 10 (entget sname))
                       '(50 . 0.)
                       '(210 0.0 0.0 1.0)
                 )
       )
     )
     (close fNme)
   )
   (princ)
 )
 (princ)
)