[编程交流] 保存到选定多边形的TXT文件

;; Polyline Point Exported, by Lee McDonnell 26.07.2009
(defun c:zzz (/ doc spc ss file sel pts)
 (vl-load-com)
 (setq doc (vla-get-ActiveDocument
             (vlax-get-Acad-Object))
       spc (if (zerop (vla-get-activespace doc))
             (if (= (vla-get-mspace doc) :vlax-true)
               (vla-get-modelspace doc)
               (vla-get-paperspace doc))
             (vla-get-modelspace doc)))
 (if (and (setq ss (ssget '((0 . "*POLYLINE")(8 . "Warstwa 6"))))
          (setq file
            (getfiled "Output File"
              (if *load *load "") "csv;txt" 9)))
   (progn
     (setq *load file file (open file "a"))
     (vlax-for Obj (setq sel (vla-get-ActiveSelectionSet doc))
       (setq pts
         (vlax-list->3D-point
           (vlax-get Obj 'Coordinates)
             (cond ((eq (vla-get-ObjectName Obj) "AcDbPolyline"))) Obj))                                                                        
       (mapcar
         (function
           (lambda (x)
             (write-line 
               (strcat
                 (rtos (car x) 2 5) (chr 44)
                   (rtos (cadr x) 2 5) 
;                      (chr 44) (rtos (caddr x) 2 2)
                                  ) file)                                                   
 ;            (vla-addPoint spc (vlax-3D-point x))
                  )) pts)
                  (write-line "" file)                          
                  )
     (princ
       (strcat "\n<< Points from "
         (itoa (vla-get-Count sel)) " Polylines written to file >>"))
     (close file)
     (vla-delete sel)))
 (princ))
       
(defun vlax-list->3D-point (lst x Obj / oLst)
 (while lst
   (setq oLst
     (cons (list (car lst) (cadr lst)
                 (if x (vla-get-Elevation Obj) (caddr lst))) oLst)
         lst ((if x cddr cdddr) lst)))
 oLst)

14498.85,2477.59
14842.06,2466.01
14507.84,2569.84
14365.55,2717.78
14408.25,2758.83
14407.27,2776.11
14455.94,2778.89
14478.06,2804.62
13600.82,2594.97
13589.92,2635.92
13593.87,2699.13
13571.62,2700.52
13485.42,2678.3

14498.85,2477.59 14842.06,2466.01 14507.84,2569.84
14365.55,2717.78 14408.25,2758.83 14407.27,2776.11 14455.94,2778.89 14478.06,2804.62 
13600.82,2594.97 13589.92,2635.92 13593.87,2699.13 13571.62,2700.52 13485.42,2678.3

(defun c:polyex ( / des idx sel txt )
   (if (and (setq sel (ssget '((0 . "LWPOLYLINE"))))
            (setq txt (getfiled "Output File" "" "txt" 1))
       )
       (if (setq des (open txt "w"))
           (progn
               (repeat (setq idx (sslength sel))
                   (write-line
                       (substr
                           (apply 'strcat
                               (mapcar
                                   (function
                                       (lambda ( x )
                                           (strcat " "
                                               (rtos (cadr  x)) ","
                                               (rtos (caddr x))
                                           )
                                       )
                                   )
                                   (vl-remove-if-not '(lambda ( x ) (= 10 (car x)))
                                       (entget
                                           (ssname sel
                                               (setq idx (1- idx))
                                           )
                                       )
                                   )
                               )
                           )
                           2
                       )
                       des
                   )
               )
               (close des)
           )
           (princ (strcat "\n"" txt "" could not be opened for writing."))
       )
   )
   (princ)
)