[编程交流] 中需要的小修改

;; 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) ! **** <-
 (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)
)