记事本fo需要更改
尊敬的专家们：，我需要在记事本输出文件的Lisp程序修改的变化。在我作为附件生成的lisp的帮助下（文件名为实际lisp格式X坐标），我需要作为附件的记事本文件格式（文件名为所需格式X坐标）。请查找这些文件并修改当前的lisp程序。我附上了X坐标的样本文件。修改也需要Y坐标。
我现在的代码是：
;; 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, <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) ! **** <-
(setq
tmp1 (vl-filename-mktemp "tmp_x.csv")
f_openx (open tmp1 "w")
)
(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")
)
(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)
)
尊敬的专家：，
执行得很好，工作也很好。感谢您的准备。
非常感谢您，
致以最良好的祝愿。 The post has been edited. thank you master, now it is working good. my final request is, can you make for CSV file version? in CSV file version both X and Y Values should be in one file with different columns please find image for sample format.
Kindly make CSV file version.
Thanking you,
Best regards.
Hint, look at the open function portion of the code, it would be good practice to mess around with it. Also, if you want a great example and good code to use when writing to a csv file, look at Lee Mac's code http://www.lee-mac.com/writecsv.html.
Dear sir,
Thank you for great guidance. i have no minimum idea about coding.
please suggest how to adopt LEEMac's code to Luís Augusto's code.
Thanking you,
With best wishes. ;; Write CSV-Lee Mac;; Writes a matrix list of cell values to a CSV file.;; lst - list of lists, sublist is row of cell values;; csv - 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 - list containing row of CSV cell values;; sep - 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") (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))
Dear Expert,
Really well executed and worked well. thank you for preparing.
Thanking you very much,
With Best Wishes.
页:
[1]