Тема: 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