[Profan]

Простейшая программа для удаления совпадающих вершин в полилинии.

Код:

[Выделить все]

;;; Удаление совпадающих вершин в полилинии с помощью команды "_-OVERKILL" ("-ПОДЧИСТИТЬ")
(defun C:D-Vx-PL ( / pll)
(setq pll (car (entsel "\nУкажите контур: ")))
(if (and pll (= (cdr (assoc 0 (entget pll))) "LWPOLYLINE"))
    (vl-cmdf "_-OVERKILL" pll "" "_P" "_B" "_N" "_Y" "")
) ; if
(princ)
)

[Кулик Алексей aka kpblc]

По-моему, в "Новых командах по работе с полилиниями" нечто подобное уже было.

----- добавлено через ~7 мин. -----
Второй вариант, без использования командных методов:

Код:

[Выделить все]

 (vl-load-com)

(defun tt (/ ent coord lst)
  (if (= (type
           (setq ent (vl-catch-all-apply (function (lambda () (ssname (ssget "_+.:L:E:S" '((0 . "LWPOLYLINE"))) 0)))))
           ) ;_ end of type
         'ename
         ) ;_ end of =
    (progn (setq coord (mapcar (function cdr) (vl-remove-if-not (function (lambda (x) (= (car x) 10))) (entget ent)))
                 ent   (vlax-ename->vla-object ent)
                 ) ;_ end of setq
           (foreach item coord
             (if (not (equal (car lst) item 1e-3))
               (setq lst (cons item lst))
               ) ;_ end of if
             ) ;_ end of foreach
           (setq lst (apply 'append (reverse lst)))
           (vla-put-coordinates ent
                                (vlax-make-variant
                                  (vlax-safearray-fill (vlax-make-safearray vlax-vbdouble (cons 0 (1- (length lst)))) lst)
                                  ) ;_ end of vlax-make-variant
                                ) ;_ end of vla-put-Coordinates
           (princ)
           ) ;_ end of progn
    ) ;_ end of if
  ) ;_ end of defun

[Profan]

Используя мой код, а также предложение Евгения Елпанова отсюда
http://www.caduser.ru/forum/index.ph...D=44&TID=36569
можно написать простенькую программу выбора всех объектов внутри указанного контура-полилинии:

Код:

[Выделить все]

;;; Выбор объектов внутри контура-полилинии.
(defun C:SEL-PL ( / echo pll fuzz ss)
(setq echo (getvar "CMDECHO"))
(setvar "CMDECHO" 0)
(setq pll (car (entsel "\nУкажите контур-полилинию: ")))
(if (and pll (= (cdr (assoc 0 (entget pll))) "LWPOLYLINE"))
    (progn
    (vl-cmdf "_-OVERKILL" pll "" "_P" "_B" "_N" "_Y" "")
    (setq fuzz 0.5) ; точность проверки..
    (vl-cmdf "_ZOOM" "_O" pll "")
    (setq ss (ssget "_WP" (ACET-GEOM-OBJECT-POINT-LIST pll fuzz)))
    (sssetfirst ss ss)
    (princ (strcat "\nВыбрано " (itoa (sslength ss)) " объектов."))
    ) ; progn
    (princ "\nКонтур-полилиния не выбран.")
) ; if
(setvar "CMDECHO" echo)
(princ)
)

Необходим установленный пакет программ Express Tools.

[Лентяй]

Вот нарыл в дальних закромах. Почти, как у kpblc'а, только не с фиксированным линейным, а с переменным угловым допуском.

Код:

[Выделить все]

 (defun C:PlVxRdc ( / pl adoc *error* vx lst pang tol ls l)
  (vl-load-com)
  (defun *error* (message)
    (princ message)(vla-endundomark adoc)(princ)
  );defun
  (defun rec_lst (lst)
    (if lst (cond ((= (vla-get-ObjectName pl) "AcDb3dPolyline")
                   (cons (list (car lst)(cadr lst)(caddr lst)) (rec_lst (cdddr lst))))
                  ((= (vla-get-ObjectName pl) "AcDbPolyline")
                   (cons (list (car lst)(cadr lst)) (rec_lst (cddr lst))))));if
  );defun
  (setq adoc (vla-get-activedocument (vlax-get-acad-object))
        ass (vla-get-ActiveSelectionSet adoc)
        util (vla-get-utility adoc) m 0)
  (if (< 0 (vla-get-count ass)) (vla-clear ass))
  (vla-startundomark adoc)
  (vla-SelectOnScreen ass (vlax-safearray-fill (vlax-make-safearray vlax-vbinteger '(0 . 0)) '(0)) 
    (vlax-safearray-fill (vlax-make-safearray vlax-vbvariant '(0 . 0)) (list "*Polyline")))
  (vla-InitializeUserInput util 4)
  (setq tol (if (vl-catch-all-error-p (vl-catch-all-apply '(lambda ()
               (setq tol (vla-getReal util "Enter Angular Tolerance or <ENTER> for 0 : ")))))
              1e-4 tol))
  (if (< 0 (vla-get-count ass))
    (vlax-for pl ass
      (setq vx (rec_lst (vlax-get pl 'coordinates))
            n (1- (fix (vlax-curve-getEndParam pl)))
            lst (cdr vx)
            pang (apply 'angle (mapcar '(lambda (x) (vlax-curve-getPointAtParam pl x))
                               (list (1+ n) n)))
            m (1+ m));setq
      (while (< 0 n)
        (setq ang (apply 'angle (mapcar '(lambda (x) (vlax-curve-getPointAtParam pl x))
                               (list n (1- n)))))
        (if (equal ang pang (* (/ tol 180) pi)) (progn
            (setq lst (vl-remove (nth (1- n) lst) lst)
                  ls (append (list (car vx)) lst)
                  l (apply 'append ls));setq
            (vla-put-coordinates pl (vlax-make-variant (vlax-safearray-fill
               (vlax-make-safearray vlax-vbDouble (cons 0 (1- (length l)))) l))));progn
          (setq pang ang));if
        (setq n (1- n)));while
      (print (strcat "Poliline " (itoa m) " Purged: "
             (itoa (- (length vx) (length ls))) " Vertex(es) Removed with "
               (rtos tol 2) "-deg. Tolerance.")));vlax-for
    (alert "Nothing Selected!!"));if
  (vla-endundomark adoc)
  (princ))
  (princ "\nEnter PlVxRdc")

[Profan]

Ребята, вот для чего вы упражняетесь в нагромождении функций? Я ведь предложил максимально простое решение с использованием штатных возможностей AutoCAD'а. Ведь раньше, когда OVERKILL входила в состав ET, в ней не было еще тех возможностей, которые появились, когда эта функция стала штатной командой AutoCAD'а. А всякие другие решения неоднократно обсуждались на просторах caduser.ru (autocad.ru) и dwg.ru.

Сообщение от Кулик Алексей aka kpblc По-моему, в "Новых командах по работе с полилиниями" нечто подобное уже было.

Мне ли не знать, поскольку я стоял у истоков создания пакета программ Pltools...