- ;; 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]: ")) "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 ! **** 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) ! **** 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))
| 
置顶卡
