LISP. Очистка сплайнов при экспорте из CorelDraw 12 в AutoCAD

;| ********************************************
* При экспорте из CorelDraw 12 в AutoCAD почти
* все линейные и дуговые объекты преобразовываются
* в сплайны (SPLINE). Эти сплайны имеют такую
* структуру, которая вызывает зависание в AutoCAD
* при натыканиии на них с включенымы привязками.
* Данная программа производит взрывание(explode)
* "неправильных" объектов SPLINE с последующей
* заменой линейных участков на отрезки(LINE)
* с сохранением свойств предшествеников.
*
* командная строка: z-purge-spline-to-line
* меню или кнопка: ^C^C_z-purge-spline-to-line
*
* Copyright 2006
* Виталий Зуенко (ZZZ)
* e-mail: zzz-v@mail.ru
*
***********************************************|;
(defun c:z-purge-spline-to-line    (/          ss
                 ent          pt_lst
                 fuzz          statistics_total
                 statistics_current
                 statistics_convert
                 )
  (vl-load-com)
  (setvar "cmdecho" 0)
  (vla-StartUndoMark
    (vla-Get-ActiveDocument (vlax-Get-Acad-Object))
    ) ;_ vla-StartUndoMark
  (setq fuzz 0.001)
;;;  Взрывание сплайнов
  (setq ss (ssget "x" '((0 . "SPLINE"))))
  (setq statistics_total (sslength ss))
  (setq statistics_current 0)
  (mapcar
    '(lambda (ent)
       (progn
     (setq statistics_current (1+ statistics_current))
     (z-progress-bar
       "Explode SPLINE "
       statistics_current
       statistics_total
       ) ;_ z-progress-bar
     (vl-cmdf "_.explode" (ssadd ent))
     ) ;_ progn
       ) ;_ lambda
    (z-ss-ename-lst ss)
    ) ;_ mapcar
  (princ
    (strcat "\nTry explode " (itoa statistics_total) " SPLINE")
    ) ;_ princ
;;;  Замена линейных сплайнов на отрезки
  (setq ss (ssget "x" '((0 . "SPLINE"))))
  (setq statistics_total (sslength ss))
  (setq statistics_current 0)
  (setq statistics_convert 0)
  (foreach ent (z-ss-ename-lst ss)
;;;    (setq ent (car(entsel)))
    (setq pt_lst
       (z-list-remove-series-repetition-fuzz
         (mapcar 'cdr
             (vl-remove-if-not
               '(lambda (dxf_data) (= (car dxf_data) 10))
               (entget ent)
               ) ;_ vl-remove-if-not
             ) ;_ mapcar
         0.001
         ) ;_ z-list-remove-series-repetition-fuzz
      ) ;_ setq
    (cond
      ((and
     (= (length pt_lst) 2)
     (equal (car pt_lst) (cadr pt_lst) fuzz)
     ) ;_ and
       (entdel ent)
       )
      ((and
     (= (length pt_lst) 2)
     (entmake (list
            '(0 . "LINE")
            '(100 . "AcDbEntity")
            (assoc 410 (entget ent)) ;Model
            (assoc 8 (entget ent)) ;layer
            (assoc 370 (entget ent)) ;lineweight
            (cons 10 (car pt_lst))
            (cons 11 (cadr pt_lst))
            ) ;_ list
          ) ;_ entmake
     ) ;_ and
       (entupd (entlast))
       (entdel ent)
       (setq statistics_convert (1+ statistics_convert))
       )
      ) ;_ cond
    (setq statistics_current (1+ statistics_current))
    (z-progress-bar
      "Convert SPLINE to LINE "
      statistics_current
      statistics_total
      ) ;_ z-progress-bar
    ) ;_ foreach
  (z-progress-bar-clear)
;;;  Вывод статистики по работе программы и выход
  (princ (strcat "\nConvert SPLINE to LINE "
         (itoa statistics_convert)
         "("
         (itoa statistics_total)
         ")"
         ) ;_ strcat
     ) ;_ princ
  (vla-EndUndoMark
    (vla-Get-ActiveDocument (vlax-Get-Acad-Object))
    ) ;_ vla-EndUndoMark
  (setvar "cmdecho" 1)
  (princ)
  ) ;_ defun
;;; * Дополнительные(библиотечные) функции *
(defun z-ss-ename-lst (ss /)
;;;(z-ss-ename-lst (ssget))
  (if (z-is-pickset ss)
    (vl-remove-if
      'listp
      (mapcar 'cadr (ssnamex ss))
      ) ;_ vl-remove-if
    ) ;_ if
  ) ;_ defun
(defun z-is-pickset (value) (= (type value) 'PICKSET))
 ;|Удаление из списка повторений подряд с допуском
(z-list-remove-series-repetition-fuzz '(0 1 2 2 3 4 5 0 5 3 2) 0.001) = '(0 1 2 3 4 5 0 5 3 2)
(z-list-remove-series-repetition-fuzz '(0) 0.001) = '(0)
(z-list-remove-series-repetition-fuzz '(0 (0 . 1) (0  1)(0 . 1)) 0.001) = '(0 (0 . 1) (0  1))
|;
(defun z-list-remove-series-repetition-fuzz (lst fuzz /)
  (cond
    ((and lst (equal (car lst) (cadr lst) fuzz))
     (z-list-remove-series-repetition-fuzz
       (cons (car lst) (cddr lst))
       fuzz
       ) ;_ z-list-remove-series-repetition-fuzz
     )
    (lst
     (cons (car lst)
       (z-list-remove-series-repetition-fuzz
         (cdr lst)
         fuzz
         ) ;_ z-list-remove-series-repetition-fuzz
       ) ;_ cons
     )
    (t nil)
    ) ;_ cond
  ) ;_ defun
(defun z-progress-bar (prefix i count)
;;;  Вывод в нижней области прогресса (проценты)
  (setvar "modemacro"
      (strcat prefix " " (itoa (fix (/ (* i 100) count))) "%")
      ) ;_ setvar
  ) ;_ defun
(defun z-progress-bar-clear ()
;;;  Вывод в нижней области прогресса (проценты)
  (setvar "modemacro" "")
  ) ;_ defun