[编程交流] 尺寸和C的差异

;; Write CSV  -  Lee Mac
;; Writes a matrix list of cell values to a CSV file.
;; lst - [lst] list of lists, sublist is row of cell values
;; csv - [str] filename of CSV file to write
;; Returns T if successful, else nil
(defun LM:writecsv ( lst csv / des sep )
   (if (setq des (open csv "w"))
       (progn
           (setq sep (cond ((vl-registry-read "HKEY_CURRENT_USER\\Control Panel\\International" "sList")) (",")))
           (foreach row lst (write-line (LM:lst->csv row sep) des))
           (close des)
           t
       )
   )
)
;; List -> CSV  -  Lee Mac
;; Concatenates a row of cell values to be written to a CSV file.
;; lst - [lst] list containing row of CSV cell values
;; sep - [str] CSV separator token
(defun LM:lst->csv ( lst sep )
   (if (cdr lst)
       (strcat (LM:csv-addquotes (car lst) sep) sep (LM:lst->csv (cdr lst) sep))
       (LM:csv-addquotes (car lst) sep)
   )
)
(defun LM:csv-addquotes ( str sep / pos )
   (cond
       (   (wcmatch str (strcat "*[`" sep ""]*"))
           (setq pos 0)    
           (while (setq pos (vl-string-position 34 str pos))
               (setq str (vl-string-subst """" """ str pos)
                     pos (+ pos 2)
               )
           )
           (strcat """ str """)
       )
       (   str   )
   )
)
;; gc:distinct (gilles chanteau)
;; Suprime tous les doublons d'une liste
;;
;; Argument
;; l : une liste
(defun gc:distinct (l)
   (if l
       (cons (car l) (gc:distinct (vl-remove (car l) l)))
   )
)
(defun l-coor2l-pt (lst flag / )
   (if lst
       (cons
           (list
               (car lst)
               (cadr lst)
               (if flag
                   (+ (if (vlax-property-available-p ename 'Elevation) (vlax-get ename 'Elevation) 0.0) (caddr lst))
                   (if (vlax-property-available-p ename 'Elevation) (vlax-get ename 'Elevation) 0.0)
               )
           )
           (l-coor2l-pt (if flag (cdddr lst) (cddr lst)) flag)
       )
   )
)
(defun c:ptdef2notepad ( / js dxf_cod mod_sel n lremov str_sep oldim ename l_pt l_pr pr l_x l_y tmp1 f_openx tmp2 f_openy)
 (princ "\nSelect model object for filtering: ")
 (while
   (null
     (setq js
       (ssget "_+.:E:S"
         (list
           '(0 . "*LINE,POINT,ARC,CIRCLE,ELLIPSE,INSERT")
           (cons 67 (if (eq (getvar "CVPORT") 1) 1 0))
           (cons 410 (if (eq (getvar "CVPORT") 1) (getvar "CTAB") "Model"))
         )
       )
     )
   )
   (princ "\nIsn't an available object!")
 )
 (vl-load-com)
 (setq dxf_cod (entget (ssname js 0)))
 (foreach m (foreach n dxf_cod (if (not (member (car n) '(0 67 410 8 6 62 48 420 70))) (setq lremov (cons (car n) lremov))))
   (setq dxf_cod (vl-remove (assoc m dxf_cod) dxf_cod))
 )
 (initget "Single All Manual")
 (if (eq (setq mod_sel (getkword "\nSelect mode, [single/All/Manual]<Manual>: ")) "Single")
   (setq n -1)
   (if (eq mod_sel "All")
       (setq js (ssget "_X" dxf_cod) n -1)
       (setq js (ssget dxf_cod) n -1)
   )
 )
 (setq
   str_sep " "  ;-> **** YOU CAN CHANGE THIS STRING BY WHAT YOU WONT ! **** <-
   oldim (getvar "dimzin")
 )
 (setvar "dimzin" 0)
 (repeat (sslength js)
   (setq ename (vlax-ename->vla-object (ssname js (setq n (1+ n)))))
   (setq l_pr (list 'StartPoint 'EndPoint 'Center 'InsertionPoint 'Coordinates 'FitPoints))
   (foreach pr l_pr
     (if (vlax-property-available-p ename pr)
       (setq l_pt
         (if (or (eq pr 'Coordinates) (eq pr 'FitPoints))
           (append
             (if (eq (vla-get-ObjectName ename) "AcDbPolyline")
               (l-coor2l-pt (vlax-get ename pr) nil)
               (if (and (eq pr 'FitPoints) (zerop (vlax-get ename 'FitTolerance)))
                 (l-coor2l-pt (vlax-get ename 'ControlPoints) T)
                 (l-coor2l-pt (vlax-get ename pr) T)
               )
             )
             l_pt
           )
           (append (l-coor2l-pt (vlax-get ename pr) T) l_pt)
         )
       )
     )
   )
 )
 (setq l_x (gc:distinct (mapcar '(lambda (x) (rtos (/ x 1.0) 2 2)) (vl-sort (mapcar 'car l_pt) '<))))  ;-> **** YOU CAN CHANGE UNIT AND PREC (rtos x unit prec) ! **** <-
 (setq l_y (gc:distinct (mapcar '(lambda (x) (rtos (/ x 1.0) 2 2)) (vl-sort (mapcar 'cadr l_pt) '<))))  ;-> **** YOU CAN CHANGE UNIT AND PREC (rtos x unit prec) ! **** <
 (cond
   (
    (< (length l_x) (length l_y))
    (while (< (length l_x) (length l_y))
      (setq l_x (append l_x '("")))
    ) ;_ >while
   )
   (
    (> (length l_x) (length l_y))
    (while (> (length l_x) (length l_y))
      (setq l_y (append l_y '("")))
    ) ;_ >while
   )
 ) ;_ >cond
 
 (setq    l_x (append '("x") l_x)
   l_y (append '("y ") l_y)
 ) ;_ >setq
    
 (setq fn (getfiled "Create Output File" "" "csv" 1))
 (if (LM:WriteCSV (mapcar '(lambda (x y) (list x y))l_x l_y) fn)
   (startapp "explorer" fn)
 )  
 
;;;  (setq
;;;    tmp1 (vl-filename-mktemp "tmp_x.csv")
;;;    f_openx (open tmp1 "w")
;;;  )
;;;  (mapcar '(lambda (x) (write-line x f_openx)) l_x)
;;;  ;(write-line (apply 'strcat (mapcar '(lambda (x) (strcat x str_sep)) l_x)) f_openx)
;;;  (close f_openx)
;;;  (startapp "notepad" tmp1)
;;;  (setq
;;;    tmp2 (vl-filename-mktemp "tmp_y.csv")
;;;    f_openy (open tmp2 "w")
;;;  )
;;;  (mapcar '(lambda (y) (write-line y f_openy)) l_y)
;;;  ;(write-line (apply 'strcat (mapcar '(lambda (x) (strcat x str_sep)) l_y)) f_openy)
;;;  (close f_openy)
 (startapp "notepad" tmp2)
 (setvar "dimzin" oldim)
 (prin1)
)

(rtos (/ x 1.0) 2 2)

(rtos x 2