[编程交流] 为什么不导出到real coordin

(defun c:Ex_coord ( )
(setq filename (getstring "Add File Name: "))
(setq foldername (substr filename 1 4))
(setq directory (strcat "c:\\LLMS CAD\" foldername))
(LM:createdirectory directory)
(setq pt 0)
 (setq f (open (strcat "c:\\LLMS CAD\" foldername "\" filename ".txt") "a"))
      (while (setq ent (entsel "\nSelect polyline (or press Enter to Exit) >> "))
      (setq ent (car ent))
      (setq coords (vl-remove-if 'not
      (mapcar
      (function (lambda(p)
      (if (= 10 (car p))(cdr p))))
      (entget ent))))
      (setq coords (append coords (list (nth 0 coords))))
      (foreach pt coords
(princ pt f)
))
 (close f)
(princ)
)
;; Create Directory  -  Lee Mac
;; dir - [str] directory to create ("C:\\Folder1\\Folder2")
;; Returns:  T if directory creation is successful, else nil
(defun LM:createdirectory ( dir )
   (   (lambda ( fun )
           (   (lambda ( lst ) (fun (car lst) (cdr lst)))
               (vl-remove "" (LM:str->lst (vl-string-translate "/" "\" dir) "\"))
           )
       )
       (lambda ( root lst / dir )
           (if lst
               (if (or (vl-file-directory-p (setq dir (strcat root "\" (car lst)))) (vl-mkdir dir))
                   (fun dir (cdr lst))
               )
           )
       )
   )
   (vl-file-directory-p dir)
)

(defun c:excoord ( / *error* des dir ent enx fnm )
   (defun *error* ( msg )
       (if (= 'file (type des)) (close des))
       (if (and msg (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*")))
           (princ (strcat "\nError: " msg))
       )
       (princ)
   )
   
   (while
       (and (/= "" (setq fnm (LM:fixfilename (getstring t "Add filename: "))))
            (< (strlen fnm) 5)
       )
       (princ "\nFilename must be longer than 4 characters.")
   )
   (cond
       (   (= "" fnm))
       (   (not (LM:createdirectory (setq dir (strcat "C:\\LLMS CAD\" (substr fnm 1 4)))))
           (princ (strcat "\nUnable to create "" dir "" directory."))
       )
       (   (not (setq des (open (strcat dir "\" fnm ".txt") "a")))
           (princ (strcat "\nUnable to write to "" dir "\" fnm ".txt"."))
       )
       (   (while (setq ent (car (entsel "\nSelect polyline <Exit>: ")))
               (if (= "LWPOLYLINE" (cdr (assoc 0 (setq enx (entget ent)))))
                   (foreach dxf enx
                       (if (= 10 (car dxf))
                           (write-line
                               (apply 'strcat
                                   (cons "("
                                       (mapcar '(lambda ( x y ) (strcat (rtos x) y))
                                           (cdr dxf)
                                          '("," "," ")")
                                       )
                                   )
                               )
                               des
                           )
                       )
                   )
               )
           )
       )
   )
   (*error* nil)
   (princ)
)
;; Fix Filename  -  Lee Mac
;; Returns a string valid for use as a filename
        
(defun LM:fixfilename ( str )
   (vl-string-translate "\\/:*?"<>|" "_________" str)
)
;; Create Directory  -  Lee Mac
;; dir - [str] directory to create ("C:\\Folder1\\Folder2")
;; Returns:  T if directory creation is successful, else nil
(defun LM:createdirectory ( dir )
   (   (lambda ( fun )
           (   (lambda ( lst ) (fun (car lst) (cdr lst)))
               (vl-remove "" (LM:str->lst (vl-string-translate "/" "\" dir) "\"))
           )
       )
       (lambda ( root lst / dir )
           (if lst
               (if (or (vl-file-directory-p (setq dir (strcat root "\" (car lst)))) (vl-mkdir dir))
                   (fun dir (cdr lst))
               )
           )
       )
   )
   (vl-file-directory-p dir)
)
(princ)

(defun c:excoord ( / *error* des dir ent enx fnm )
   (defun *error* ( msg )
       (if (= 'file (type des)) (close des))
       (if (and msg (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*")))
           (princ (strcat "\nError: " msg))
       )
       (princ)
   )
   
   (while
       (and (/= "" (setq fnm (LM:fixfilename (getstring t "Add filename: "))))
            (< (strlen fnm) 5)
       )
       (princ "\nFilename must be longer than 4 characters.")
   )
   (cond
       (   (= "" fnm))
       (   (not (LM:createdirectory (setq dir (strcat "C:\\LLMS CAD\" (substr fnm 1 4)))))
           (princ (strcat "\nUnable to create "" dir "" directory."))
       )
       (   (not (setq des (open (strcat dir "\" fnm ".txt") "a")))
           (princ (strcat "\nUnable to write to "" dir "\" fnm ".txt"."))
       )
       (   (while (setq ent (car (entsel "\nSelect polyline <Exit>: ")))
               (if (= "LWPOLYLINE" (cdr (assoc 0 (setq enx (entget ent)))))
                   (foreach dxf enx
                       (if (= 10 (car dxf))
                           ;(write-line
                  (princ
                               (apply 'strcat
                                   (cons "("
                                       (mapcar '(lambda ( x y ) (strcat (rtos x) y))
                                           (cdr dxf)
                                         ; '("," "," ")")
                                        '(" " ")")
                                       )
                                   )
                               )
                               des
                           )
                       )
                   )
               )
             (close des)
           )
       )
   )
   (*error* nil)
   (princ)
)
;; Fix Filename  -  Lee Mac
;; Returns a string valid for use as a filename
        
(defun LM:fixfilename ( str )
   (vl-string-translate "\\/:*?"<>|" "_________" str)
)
;; Create Directory  -  Lee Mac
;; dir - [str] directory to create ("C:\\Folder1\\Folder2")
;; Returns:  T if directory creation is successful, else nil
(defun LM:createdirectory ( dir )
   (   (lambda ( fun )
           (   (lambda ( lst ) (fun (car lst) (cdr lst)))
               (vl-remove "" (LM:str->lst (vl-string-translate "/" "\" dir) "\"))
           )
       )
       (lambda ( root lst / dir )
           (if lst
               (if (or (vl-file-directory-p (setq dir (strcat root "\" (car lst)))) (vl-mkdir dir))
                   (fun dir (cdr lst))
               )
           )
       )
   )
   (vl-file-directory-p dir)
)
(princ)