LISP. Соединение разрывов незамкнутого контура

;|====================================================
Соединение разрывов незамкнутого контура

Программа Дениса Флюстикова "Soed_Den"

Макрос для кнопки:
^C^C^P(load "Soed_Den");Soed_Den

Замечания и предложения по адресу fd-@mail.ru
====================================================|;

(defun C:Soed_Den (/ ww0 ww1 ww2 ww3 ww4 ww5 ww6 ww7 ww8 ww9)

(setq ww0 1.5    ; Максимальный зазор по умолчанию
      ww7 0    ; 0 - С подсветкой результата,         1 - Без
      ww8 0    ; 0 - С индикацией пропущенных точек,     1 - Без
      ww3 '()
      ww1 (ssget "_I" '((0 . "*LINE,ARC,ELLIPSE"))))

(if (= ww8 1)
(setq ww8 nil)
(setq ww8 (/ (getvar "VIEWSIZE") 200)
      ww8 (list ww8 ww8))
)

(while (null ww1)

(princ "\nВыбор объектов контура или <Изменить зазор ")(princ ww0)(princ ">:")

(if (null (setq ww1 (ssget '((0 . "*LINE,ARC,ELLIPSE")))))
(if (setq ww2 (getdist (strcat "\nНовое значение максимального зазора в разрывах <" (rtos ww0) ">:")))
(setq ww0 ww2)
))

)

(vl-load-com)

(repeat (sslength ww1)

(setq ww2 (ssname ww1 0)
      ww1 (ssdel ww2 ww1 )
      ww2 (vlax-ename->vla-object ww2))

(if (not (vlax-curve-isClosed ww2))
(setq ww3 (cons (vlax-curve-getEndPoint ww2) ww3)
      ww3 (cons (vlax-curve-getStartPoint ww2) ww3))
)
)

(setq ww1 '()
      ww2 (length ww3))

(repeat ww2

(setq ww2 (1- ww2)
      ww4 (nth ww2 ww3)
      ww5 0)

(mapcar '(lambda (q)
(if (equal ww4 q 1e-6)(setq ww5 (1+ ww5)))
) ww3)

(if (= ww5 1)(setq ww1 (cons ww4 ww1)))

)

(if ww1 (progn

(if (= ww7 0)(setq ww7 (ssadd))(setq ww7 nil))

(setq ww5 0
      ww6 (/ (length ww1) 2))

(vla-startundomark (vla-get-activedocument (vlax-get-acad-object)))

(while ww1

(setq ww2 (car ww1)
      ww1 (cdr ww1)
      ww3 '(1e9)
      ww9 '(1 -1))

(mapcar '(lambda (q)
(if (< (setq ww4 (distance ww2 q))(car ww3))
(setq ww3 (list ww4 q)))
) ww1)

(if (<= (car ww3) ww0)(progn

(setq ww1 (vl-remove (cadr ww3) ww1)
      ww5 (1+ ww5))

(entmake (list '(0 . "LINE")
           '(62 . 64)        ; Цвет (строчку можно удалить, как и следующею)
           '(8 . "Defpoints")    ; Слой ("Defpoints" не печатается)
           (cons 10 ww2)
           (cons 11 (cadr ww3))))

(if ww7 (setq ww7 (ssadd (entlast) ww7)))
)(if ww8
(mapcar '(lambda (q)
(grdraw (trans (mapcar '+ ww2 (mapcar '* ww8 ww9)) 0 1)
    (trans (mapcar '+ ww2 (mapcar '* ww8 q)) 0 1) 1 1)
(setq ww9 q)       
) '((-1 -1)(-1 1)(1 1)(1 -1)))
)
)
)

(princ "\nПропущено (разрыв более ")(princ ww0)(princ "): ")(princ (- ww6 ww5))
(princ "\nСоединено: ")(princ ww5)

(vla-endundomark (vla-get-activedocument (vlax-get-acad-object)))

(if ww7 (sssetfirst nil ww7))
)
(princ "\nРазрывов не найдено")
)
(princ)
)