| Правила | Регистрация | Пользователи | Поиск | Сообщения за день | Все разделы прочитаны |  Справка по форуму | Файлообменник |

Вернуться   Форум DWG.RU > Программное обеспечение > AutoCAD > Как уменьшить количество вершин в полилинии

Как уменьшить количество вершин в полилинии

Ответ
Поиск в этой теме
Непрочитано 12.07.2006, 04:29 #1
Как уменьшить количество вершин в полилинии
Димас
 
джедай
 
Магадан
Регистрация: 31.01.2005
Сообщений: 460

Подскажите как быстро уменьшить количество вершин у полилинии?
много полилиний вершины которой лежат на одной прямой, удалять их (вершины) в ручную - долго...
Может кто подскажет более быстрое решение?
Просмотров: 37934
 
Непрочитано 12.07.2006, 08:47
#2
_Andre_

механизатор
 
Регистрация: 28.12.2004
Самара
Сообщений: 312
<phrase 1=


Воспользуйтесь командой OVERKILL из Expresstools.
Она позволяет оптимизировать такие полилинии.
_Andre_ вне форума  
 
Непрочитано 12.07.2006, 08:53
#3
Кочетков Андрей

Java/Kotlin backend
 
Регистрация: 03.02.2006
Сообщений: 5,736


Есть еще такие варианты:
1. Команда Weed Polyline из Тулпака или Лэнд Десктопа.
2. Команда Join из 2006-го Акада. Для этого надо предварительно эксплодить полилинию.
Кочетков Андрей вне форума  
 
Непрочитано 12.07.2006, 09:10
#4
Profan


 
Регистрация: 25.12.2005
Москва
Сообщений: 13,627


Для Кочетков Андрей.
Что такое "эксплодить"? В русском языке такого слова нет. Может быть, расплодить?
Profan вне форума  
 
Автор темы   Непрочитано 12.07.2006, 09:25
#5
Димас

джедай
 
Регистрация: 31.01.2005
Магадан
Сообщений: 460
<phrase 1=


блин(( опять забыл уточнить
экспресс тулз есть, тулпаком пользоваться тоже умею)

все что советовали не подходит, работаю в ПСК, команда DSTP_PLWEED (которая Weed) не умеет работать в ПСК и выдает ошибку

может кто в курсе в 10-я версия тулпака может работать в ПСК? есть ли смысл его искать?
Димас вне форума  
 
Автор темы   Непрочитано 12.07.2006, 09:36
#6
Димас

джедай
 
Регистрация: 31.01.2005
Магадан
Сообщений: 460
<phrase 1=


не хочу чтобы у всех участвовавших вот в этой http://dwg.ru/forum/viewtopic.php?t=8509 ветке конференции создалось впечатление что получив лисп с возможностью создания вершин, создал кучу вершин и теперь пытаюсь уменьшить их количество))
просто теперь нужна помощь в "упрощении" dxf файлов с диким количеством точек))
Димас вне форума  
 
Непрочитано 12.07.2006, 10:20
#7
Кочетков Андрей

Java/Kotlin backend
 
Регистрация: 03.02.2006
Сообщений: 5,736


>>Димас
Каждый пользуется тем, что знает. Поэтому я бы воспользовался для этого Лэндом, чес слово! Если решишься на это - расскажу как делать
Кочетков Андрей вне форума  
 
Непрочитано 12.07.2006, 23:23 Re: Как уменьшить количество вершин в полилинии
#8
Лентяй

Project Engineer
 
Регистрация: 05.01.2005
Лос Анджелес
Сообщений: 1,392


Цитата:
Сообщение от Димас
Подскажите как быстро уменьшить количество вершин у полилинии?
много полилиний вершины которой лежат на одной прямой, удалять их (вершины) в ручную - долго...
Может кто подскажет более быстрое решение?
Самый простой способ - использоавть опцию "СПРЯМИТЬ" ("STRAIGHTEN") из меню "РЕДАКТИРОВАНИЕ ВЕРШИН"("EDIT VERTEX")комады "РЕДАКТИРОВАНИ ПОЛИЛИНИИ" ("_PEDIT"). И нехрен мудрить :twisted: !
Лентяй вне форума  
 
Автор темы   Непрочитано 13.07.2006, 01:45 Re: Как уменьшить количество вершин в полилинии
#9
Димас

джедай
 
Регистрация: 31.01.2005
Магадан
Сообщений: 460
<phrase 1=


Цитата:
Сообщение от Лентяй
...Самый простой способ - использоавть опцию "СПРЯМИТЬ" ("STRAIGHTEN") из меню "РЕДАКТИРОВАНИЕ ВЕРШИН"("EDIT VERTEX")комады "РЕДАКТИРОВАНИ ПОЛИЛИНИИ" ("_PEDIT"). И нехрен мудрить :twisted: !
а вот приходится))
ибо работаю не один и есть люди которым автокад очень сложен, вот для них и нужен лисп вершины убивать
а то ну очень меня нервирует по 10 раз в день объяснять как добавить вершину, как ее убрать и почему убрались вершины с другой полилинии и т.д.
спасите мои нервы!))) дайте пожалуйста лисп убивающий вершины)
to Кочетков Андрей
лендом пользовался но вот так сразу не могу придумать как убить лишние вершины, может в двух словах объясните?
Димас вне форума  
 
Непрочитано 13.07.2006, 09:09
#10
Кочетков Андрей

Java/Kotlin backend
 
Регистрация: 03.02.2006
Сообщений: 5,736


Сначала конвертируем двухмерные линии в трехмерные (потому что последующие команды Лэнда не работают с 2д линиями). Это можно сделать либо с помощью Лэнда (см. картинку), либо с помощью Тулпака. Я предпочитаю Тулпак, но принципиальной разницы нет.
Затем импользуем команду Weed Vertices из Лэнда (см. картинку).
Для "максимально минимального" искажения линий, угол надо выставить именно таким, а вот с длиной поиграйся - тут нет общих рекомендаций.
Ну и наконец, если необходимо, преобразуй 3д линии в 2д, опять же с помощью либо Тулпака, либо Лэнда.
[ATTACH]1152767351.jpg[/ATTACH]
Кочетков Андрей вне форума  
 
Автор темы   Непрочитано 13.07.2006, 09:41
#11
Димас

джедай
 
Регистрация: 31.01.2005
Магадан
Сообщений: 460
<phrase 1=


ага, с лендом понятно))
мне по другому будет тогда проще делать - копировать в новый файл(COPY, Paste to orig..), там тулпаком уменьшать к-во вершин, и обратно копировать уже с меньшим к-вом вершиин
так мне не нужно будет на машины ленд ставить)
но за совет спасибо)
Димас вне форума  
 
Непрочитано 14.07.2006, 04:04
#12
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,990
<phrase 1= Отправить сообщение для VVA с помощью Skype™


Попробуй эту команду для LWPOLYLINE
Код:
[Выделить все]
(defun C:PLVXDEL ( / lw adoc *error* )
(defun *error* (message)
  (princ message)(vla-endundomark adoc)(princ))
  
(defun lwplvxdel (lw / pln ed pvx cvx item)
  (setq ed (entget lw))
  (while ed
    (setq item (car ed)
	  ed   (cdr ed))
    (cond
      ((= (car item) 10)
       (setq cvx (list item
		       (assoc 40 ed)
		       (assoc 41 ed)
		       (assoc 42 ed))
	     ed	 (cdddr ed))
       (if pvx
	 (progn
	   (setq cang (angle (cdr (assoc 10 pvx))
			     (cdr (assoc 10 cvx))))
	   (cond
	     ((not (zerop (cdr (assoc 42 pvx))))
	      (setq pln	 (append pln pvx cvx)
		    pang nil))
	     ((zerop (cdr (assoc 42 pvx)))
	      (cond
		((null pang)
		 (setq pang cang))
		((not (equal pang cang 0.01))
		 (setq pln  (append pln pvx)
		       pang cang))
		(t nil)) ;_cond
	     )
	   ) ;_cond
	   (setq pvx cvx)
	 )
	 (setq pvx cvx
	       pln (append pln pvx)
	 )
       ) ;_if pvx
      )
      (t (setq pln (append pln (list item))))
    ) ;_cond
  );_while
  (setq pln (append pln cvx))
  (setq	pln (subst (cons 90 (length (lib:massoc 10 pln)))
		   (assoc 90 pln)
		   pln ))
  (entmod pln)
  (entupd lw)
)
  (setq adoc (vla-get-activedocument (vlax-get-acad-object)))
  (vla-startundomark adoc)	
    (setq lw (car (entsel "\nВыберите полилинию:")))
    (if (and lw
	     (= (cdr(assoc 0 (entget lw))) "LWPOLYLINE"))
      (lwplvxdel lw)
      (alert "\nНичего не выбрано\nили объект не LWPOLYLINE"))
  (vla-endundomark adoc)	
(princ))
(princ "\nНаберите PLVXDEL")
VVA вне форума  
 
Автор темы   Непрочитано 14.07.2006, 06:35
#13
Димас

джедай
 
Регистрация: 31.01.2005
Магадан
Сообщений: 460
<phrase 1=


выдает ошибку:
Код:
[Выделить все]
Command:  PLVXDEL
Âûáåðèòå ïîëèëèíèþ:no function definition: LIB:MASSOC
Димас вне форума  
 
Непрочитано 14.07.2006, 14:05
#14
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,990
<phrase 1= Отправить сообщение для VVA с помощью Skype™


Вечно забываю библиотечные ф-ции
Лови
Код:
[Выделить все]
;|  ! ***************************************************************************
;; !                           lib:massoc
;; ! ***************************************************************************
;; ! Function : Utility function to get multiple group code
                Возвращает все вхождения ключа в списке
;; ! Argument : 'key'     - The DXF code to check / DXF код
;; !            'alist' -    The List to check  / Список
;; ! Returns  : The value of the DXF dotted pair, if it exists else returns nil
                Значение точечной пары, если есть или nil
;; ! ****************************************************************************|;
;;; Utility function to get multiple group code CDRs
(defun lib:massoc (key alist / x nlist)
  (foreach x alist
    (if (eq key (car x))
      (setq nlist (cons (cdr x) nlist))
    )
  )
  (reverse nlist)
)
VVA вне форума  
 
Непрочитано 15.07.2006, 02:04
#15
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,990
<phrase 1= Отправить сообщение для VVA с помощью Skype™


Вот вариант программы, работающий со всеми (надеюсь) полилиниями
Код:
[Выделить все]
;;;Удаление вершин полилиний, которые лежат на одной прямой
(defun C:PLVXREDUCE ( / lw adoc *error* l )
(defun *error* (message)
  (princ message)(vla-endundomark adoc)(princ))
  (defun lib:massoc (key alist / x nlist)
  (foreach x alist
   (if (eq key (car x))(setq nlist (cons (cdr x) nlist))))
  (reverse nlist))
    (defun rec_lst_3d (lst)
    (if lst
      (cons (list  (car lst)(cadr lst)(caddr lst))
	    (rec_lst_3d (cdddr lst))))
    ) ;_  defun
  (defun rem-3d-pl (lst) 
 (cond ((not lst) nil) 
       ((and (cdr lst)
	  (equal (angle (car lst) (cadr lst)) pang 1e-6)) 
           (rem-3d-pl (cdr lst)))
       ((and (cdr lst)
	  (not(equal (angle (car lst) (cadr lst)) pang 1e-6)))
	  (setq pang (angle (car lst) (cadr lst)))
           (cons (car lst) (rem-3d-pl (cdr lst))))
       
       (t (cons (car lst) (rem-3d-pl (cdr lst))))) ;_  cond 
) ;_  defun 
(defun pl3d2dvxdel (lw / vx lst pang l cv)
(setq vx (rec_lst_3d (vlax-get lw 'coordinates))
     lst (cdr vx)
    pang (angle (car vx)(cadr vx))
       l (rem-3d-pl lst)
       l (append (list (car vx)) l)
      cv (- (length vx)(length l))
       l (apply 'append l))
 (vla-put-coordinates lw (vlax-make-variant (vlax-safearray-fill 
                     (vlax-make-safearray vlax-vbDouble (cons 0 (1- (length l)))) l)))
  (princ "\nУдалено ")(princ cv)(princ " вершин")
  )
(defun lwplvxdel (lw / pln ed pvx cvx item cv)
  (setq ed (entget lw) cv 0)
  (while ed
    (setq item (car ed)
	  ed   (cdr ed))
    (cond
      ((= (car item) 10)
       (setq cvx (list item (assoc 40 ed)(assoc 41 ed)(assoc 42 ed))
	     ed	 (cdddr ed))
       (if pvx
	 (progn
	   (setq cang (angle (cdr (assoc 10 pvx))
			     (cdr (assoc 10 cvx))))
	   (cond
	     ((not (zerop (cdr (assoc 42 pvx))))
	      (setq pln	 (append pln pvx cvx) pang nil))
	     ((zerop (cdr (assoc 42 pvx)))
	      (cond
		((null pang)(setq pang cang))
		((not (equal pang cang 0.01))
		 (setq pln  (append pln pvx) pang cang))
		(t (setq cv (1+ cv)))))) ;_cond
	   (setq pvx cvx))
	 (setq pvx cvx pln (append pln pvx))) ;_if pvx
      )
      (t (setq pln (append pln (list item))))) ;_cond
  );_while
  (setq pln (append pln cvx))
  (setq	pln (subst (cons 90 (length (lib:massoc 10 pln)))
		   (assoc 90 pln)
		   pln ))
  (princ "\nУдалено ")(princ cv)(princ " вершин")
  (entmod pln)(entupd lw)
)
  (setq adoc (vla-get-activedocument (vlax-get-acad-object)))
  (vla-startundomark adoc)

  (vla-getEntity (vla-get-utility adoc) 
    'lw 'nil "\nSelect any Polyline: ")
  (cond
    ((member (vla-get-ObjectName lw) '("AcDb3dPolyline" "AcDb2dPolyline"))
     (pl3d2dvxdel lw))
    ((= (vla-get-ObjectName lw) "AcDbPolyline")
	 (lwplvxdel (vlax-vla-object->ename lw)))
    (t (princ "\nВы не выбрали  полилинию")))
  (vla-endundomark adoc)	
(princ))
(princ "\nНаберите PLVXREDUCE")

Последний раз редактировалось VVA, 18.09.2015 в 23:50.
VVA вне форума  
 
Непрочитано 15.07.2006, 08:45
#16
Лентяй

Project Engineer
 
Регистрация: 05.01.2005
Лос Анджелес
Сообщений: 1,392


Скажите, VVA, ну почему у вас такая классовая ненависть к "легким полилиниям"? Почему вы их посточнно отлучаете от всех прочих? Посмотрите, как просто и изящно вы могли бы сделать вашу программу, если бы не были таким непримирмым:
Код:
[Выделить все]
(defun C:PLVXREDUCE ( / lw adoc *error* l ) 
(defun *error* (message) 
  (princ message)(vla-endundomark adoc)(princ)) 
  (defun lib:massoc (key alist / x nlist) 
  (foreach x alist 
   (if (eq key (car x))(setq nlist (cons (cdr x) nlist)))) 
  (reverse nlist))
  (defun rec_lst (lst)
    (if lst (cond ((= (vla-get-ObjectName lw) "AcDb3dPolyline")
                   (cons (list (car lst)(cadr lst)(caddr lst)) (rec_lst (cdddr lst))))
                  ((= (vla-get-ObjectName lw) "AcDbPolyline")
                   (cons (list (car lst)(cadr lst)) (rec_lst (cddr lst))))));if
  );defun
  (defun rem-pl (lst / ang)
    (cond ((not lst) nil)
          ((cdr lst)
           (setq n (1- (length lst))
                 ang (apply 'angle (mapcar '(lambda (x) (vlax-curve-getPointAtParam lw x))
                               (list n (1- n)))))
           (if (equal ang pang 1e-6) (rem-pl (cdr lst))
             (progn (setq pang ang)
               (cons (car lst) (rem-pl (cdr lst))))))
          (t (cons (car lst) (rem-pl (cdr lst)))));cond
  );rem-pl
  (defun plvxdel (lw / vx lst pang l cv)
    (setq vx (rec_lst (vlax-get lw 'coordinates))
          n (1- (vlax-curve-getEndParam lw))
          lst (cdr vx)
          pang (apply 'angle (mapcar '(lambda (x) (vlax-curve-getPointAtParam lw x))
                               (list (1+ n) n)))
          l (append (list (car vx)) (rem-pl lst))
          cv (- (length vx) (length l))
          l (apply 'append l));setq
    (vla-put-coordinates lw (vlax-make-variant (vlax-safearray-fill 
                     (vlax-make-safearray vlax-vbDouble (cons 0 (1- (length l)))) l)))
    (princ "\nУдалено ")(princ cv)(princ " вершин")
  );plvxdel
  (setq adoc (vla-get-activedocument (vlax-get-acad-object)))
  (vla-startundomark adoc)
  (if (not (vl-catch-all-error-p (vl-catch-all-apply '(lambda ()
             (vla-getEntity (vla-get-utility adoc) 'lw 'nil "\nSelect any Polyline: ")))))
    (if (wcmatch (vla-get-ObjectName lw) "*Polyline")
      (plvxdel lw)
      (alert "It's Not a Polyline!!"));if
    (alert "Nothing Selected!!"));if 
  (vla-endundomark adoc)    
(princ)) 
(princ "\nНаберите PLVXREDUСЕ")
Заметьте, я опять практически ничего не поменял, только применил функцию вычисления угла - общую для всех типов плилиний.
Лентяй вне форума  
 
Непрочитано 15.07.2006, 10:31
#17
aldt


 
Регистрация: 12.02.2006
Сообщений: 114


Лентяй
посмотрите еще раз тест.
почему то не удаляется вторая вершина.
и можно ли ввести допуск на отклонение от прямой.
[ATTACH]1152945102.rar[/ATTACH]
aldt вне форума  
 
Непрочитано 15.07.2006, 20:36
#18
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,990
<phrase 1= Отправить сообщение для VVA с помощью Skype™


>Лентяй Похоже, что у "легких полилиниях" классовая ненависть ко мне. Опять Актовад выдает
Цитата:
Команда: ; ошибка: Возникло исключение: 0xC0000005 (Нарушение доступа)
; предупреждение: раскрутка пропущена для неверное исключение
Автокад 2006 Русский. Может в нем дело?
>aldt Пока что свой вариант прогаммы ввиду вышесказанного.
Код:
[Выделить все]
;;;Удаление вершин полилиний, которые лежат на одной прямой
(defun C:PLVXREDUCE ( / lw adoc *error* l nev )
(defun *error* (message)
  (princ message)(vla-endundomark adoc)(princ))
    (defun rec_lst_3d (lst)
    (if lst
      (cons (list  (car lst)(cadr lst)(caddr lst))
	    (rec_lst_3d (cdddr lst))))
    ) ;_  defun
  (defun rem-3d-pl (lst) 
 (cond ((not lst) nil) 
       ((and (cdr lst)
	  (equal pang (angle (car lst) (cadr lst)) nev)) 
           (rem-3d-pl (cdr lst)))
       ((and (cdr lst)
	  (not(equal pang (angle (car lst) (cadr lst)) nev)))
	  (setq pang (angle (car lst) (cadr lst)))
           (cons (car lst) (rem-3d-pl (cdr lst))))
       (t (cons (car lst) (rem-3d-pl (cdr lst))))) ;_  cond 
) ;_  defun 
(defun pl3d2dvxdel (lw / vx lst pang l cv)
(setq vx (rec_lst_3d (vlax-get lw 'coordinates))
     lst (cdr vx)
    pang (angle (car vx)(cadr vx))
       l (rem-3d-pl lst)
       l (append (list (car vx)) l)
      cv (- (length vx)(length l))
       l (apply 'append l))
 (vla-put-coordinates lw (vlax-make-variant (vlax-safearray-fill 
                     (vlax-make-safearray vlax-vbDouble (cons 0 (1- (length l)))) l)))
  (princ "\nУдалено ")(princ cv)(princ " вершин")
  )
(defun lwplvxdel (lw / pln ed pvx cvx item cv)
  (setq ed (entget lw) cv 0)
  (while ed
    (setq item (car ed)
	  ed   (cdr ed))
    (cond
      ((= (car item) 10)
       (setq cvx (list item (assoc 40 ed)(assoc 41 ed)(assoc 42 ed))
	     ed	 (cdddr ed))
       (if pvx
	 (progn
	   (setq cang (angle (cdr (assoc 10 pvx))
			     (cdr (assoc 10 cvx))))
	   (cond
	     ((not (zerop (cdr (assoc 42 pvx))))
	      (setq pln	 (append pln pvx cvx) pang nil))
	     ((zerop (cdr (assoc 42 pvx)))
	      (cond
		((null pang)(setq pang cang))
		((not (equal pang cang nev))
		 (setq pln  (append pln pvx) pang cang))
		(t (setq cv (1+ cv)))))) ;_cond
	   (setq pvx cvx))
	 (setq pvx cvx pln (append pln pvx))) ;_if pvx
      )
      (t (setq pln (append pln (list item))))) ;_cond
  );_while
  (setq pln (append pln cvx))
  (setq	pln (subst (cons 90
			 (length (VL-REMOVE-IF-NOT
				   '(lambda (x)(= (car x) 10))
				   pln)))
		   (assoc 90 pln)
		   pln ))
  (princ "\nУдалено ")(princ cv)(princ " вершин")
  (entmod pln)(entupd lw)
)
  (setq adoc (vla-get-activedocument (vlax-get-acad-object)))
  (vla-startundomark adoc)
  (initget 6)
  (if (null (setq nev (getangle "\nУгол невязки в градусах <1>:")))
    (setq nev 0.0174533))
  (vla-getEntity (vla-get-utility adoc) 
    'lw 'nil "\nSelect any Polyline: ")
  (cond
    ((member (vla-get-ObjectName lw) '("AcDb3dPolyline" "AcDb2dPolyline"))
     (pl3d2dvxdel lw))
    ((= (vla-get-ObjectName lw) "AcDbPolyline")
	 (lwplvxdel (vlax-vla-object->ename lw)))
    (t (princ "\nВы не выбрали  полилинию")))
  (vla-endundomark adoc)	
(princ))
(princ "\nНаберите PLVXREDUCE")
В твоем чертеже для наклонной полилинии вершины спрямились с невязкой в 2 градуса
Если код Лентяя работает, то замени в
Код:
[Выделить все]
(equal ang pang 1e-6)
1e-6 на значение нужного угла в радианах
Так же вершина может не спрямится, если она "переходит" через 0.
Т.е. при навравлении 1 и 359 градусов с невязкой в 2 программа не удалит вершину (хотя должна). Но пока не придумал алгоритм проверки. Как вариант выхода -> повернуть плинию на некий угол, а потом вернуть обратно.

Последний раз редактировалось VVA, 18.09.2015 в 23:51.
VVA вне форума  
 
Непрочитано 15.07.2006, 20:56
#19
aldt


 
Регистрация: 12.02.2006
Сообщений: 114


VVA
спасибо!
попробую разобраться.
aldt вне форума  
 
Автор темы   Непрочитано 17.07.2006, 02:26
#20
Димас

джедай
 
Регистрация: 31.01.2005
Магадан
Сообщений: 460
<phrase 1=


to VVA
Спасибо буду пробовать)
Димас вне форума  
Ответ
Вернуться   Форум DWG.RU > Программное обеспечение > AutoCAD > Как уменьшить количество вершин в полилинии

Размещение рекламы
Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск