Как разбить МПолигоны

[Anonymous]

Подскажите, пожалуйста, имею в чертеже огромное количество МПолигонов. Возможно ли автоматически преобразовать МПолигон в замкнутую полилинию и заливку с цветом МПолигона? Спасибо.

[Anonymous]

задача решаема, добавьте в тему еще один примерчек, где будет несколько "MPOLYGON"  с различным количеством вершин. Вчерновую уже готово...

[Anonymous]

(defun c:test (/ V)
  (if (setq v (ssget "_x" '((0 . "MPOLYGON"))))
    (foreach e (mapcar (function cadr) (ssnamex v))
      (setq e (entget e)
            v (cons 0 (mapcar (function -) (cdr (assoc 11 e)) (cdr (assoc 10 e))))
      )
      (entmakex (append (list '(0 . "LWPOLYLINE")
                              '(100 . "AcDbEntity")
                              (assoc 67 e)
                              '(410 . "Model")
                              (assoc 8 e)
                              (assoc 62 e)
                              '(100 . "AcDbPolyline")
                              (cons 90 (cdr (assoc 93 e)))
                              '(70 . 1)
                        )
                        (mapcar (function (lambda (a) (mapcar (function +) a v)))
                                (cdr (vl-remove-if-not (function (lambda (a) (= (car a) 10))) e))
                        )
                        (list (assoc 210 e))
                )
      )
    )
  )
  (princ)
)

выкладываю код как есть, почти без проверок...

[Anonymous]

Евгений, извините за задержку. Эту задачу нам придется выполнять каждый день, так как база обновляется каждый день. Полилиния должна иметь цвет контура мполигона, а цвет штриховки должен быть как цвет заполнения мполигона. Тип как у полигона. Спасибо!

[Anonymous]

Евгений, вылетает ошибка

Команда: _test
; ошибка: неверная DXF-группа: nil

[Anonymous]

(defun c:t1 (/ V)
  (if (setq v (ssget "_x" '((0 . "MPOLYGON"))))
    (foreach e (mapcar (function cadr) (ssnamex v))
      (setq e (entget e)
            v (cons 0 (mapcar (function -) (cdr (assoc 11 e)) (cdr (assoc 10 e))))
      )
      (entmakex
        (vl-remove nil
                   (append (list '(0 . "LWPOLYLINE")
                                 '(100 . "AcDbEntity")
                                 (assoc 67 e)
                                 '(410 . "Model")
                                 (assoc 8 e)
                                 (assoc 62 e)
                                 '(100 . "AcDbPolyline")
                                 (cons 90 (cdr (assoc 93 e)))
                                 '(70 . 1)
                           )
                           (mapcar (function (lambda (a) (mapcar (function +) a v)))
                                   (cdr (vl-remove-if-not (function (lambda (a) (= (car a) 10))) e))
                           )
                           (list (assoc 210 e))
                   )
        )
      )
    )
  )
  (princ)
)
(defun c:t2 (/ V)
  (if (setq v (ssget "_x" '((0 . "MPOLYGON"))))
    (foreach e (mapcar (function cadr) (ssnamex v))
      (setq e (entget e)
            v (cons 0 (mapcar (function -) (cdr (assoc 11 e)) (cdr (assoc 10 e))))
      )
      (entmakex
        (vl-remove nil
                   (append (list '(0 . "LWPOLYLINE")
                                 '(100 . "AcDbEntity")
                                 (assoc 67 e)
                                 '(410 . "Model")
                                 (assoc 8 e)
                                 (assoc 62 e)
                                 '(100 . "AcDbPolyline")
                                 (cons 90 (cdr (assoc 93 e)))
                                 '(70 . 1)
                           )
                           (mapcar (function (lambda (a) (mapcar (function +) a v)))
                                   (cdr (vl-remove-if-not (function (lambda (a) (= (car a) 10))) e))
                           )
                           (list (assoc 210 e))
                   )
        )
      )
      (entdel (cdar e))
    )
  )
  (princ)
)

 программа t1 добавляет полилинии, t2 добавляет полилинии и удаляет полигоны. Предыдущая программа работала на данном вами примере...

[Anonymous]

кстати, начал дальше разбираться с мполигонами, оказывается в них моет содержаться куча контуров - внешний и внутренние, да еще поддерживаются самопересечения...

Это уже действительно беда! Эти полигоны были разработаны для решения задач, которые не решаются штриховками, те. в штриховке не может быть совпадающих точек, самопересечений итд. Штриховка поддерживает только внешние и внутренние контура, при пересечении внешних и внутренних контуров, она автоматом вычисляет новые контура без самопересечений  (но только если не очень сложно). Другими словами, перевод МПолигонов в полилинию и штриховку возможен только в частном случае...

И еще, моя программа вытаскивает из полигона все точки и генерит по ним полилинию, уберая лишние точки, попадающие во внутренние контура, те. на данный момент программа работает не верно для полигонов с отверстиями. Чуть позже поправлю.

[Anonymous]

Евгений, было бы здорово чтобы полилинии которые создаются по команде _t1 имели цвет закрашивания МПолигона и чтобы мполигон заменялся просто штриховкой цвета и типа Мполигона.

[Anonymous · Accepted solution]

Вроде сделал. Тестируйте.

(defun c:mp2p (/ L LL LST P V)
  ;; by ElpanovEvgeniy
  ;; convert MPolygon to Lwpolyline
  ;; version 0.2
  ;; 2012.07.11
  ;; mailto: elpanov@gmail.com
  ;; web:    elpanov.com
  (if (setq v (ssget "_x" '((0 . "MPOLYGON"))))
    (foreach e (mapcar (function cadr) (ssnamex v))
      ;;(setq e(car(entsel)))
      (setq e   (entget e)
            v   (cons 0 (mapcar (function -) (cdr (assoc 11 e)) (cdr (assoc 10 e))))
            l   (vl-remove nil
                           (list '(0 . "LWPOLYLINE")
                                 '(100 . "AcDbEntity")
                                 (assoc 67 e)
                                 (assoc 410 e)
                                 (assoc 8 e)
                                 (if (assoc 63 e)
                                   (cons 62 (cdr (assoc 63 e)))
                                 )
                                 (if (assoc 421 e)
                                   (cons 420 (cdr (assoc 421 e)))
                                 )
                                 '(100 . "AcDbPolyline")
                           )
                )
            lst e
            ll  nil
      )
      (defun f (l i)
        (if (> i 0)
          (cons (mapcar (function +) (car l) v) (f (cdr l) (1- i)))
        )
      )
      (while (setq lst (member (assoc 93 (cdr lst)) (cdr lst)))
        (setq p  (f (cdr lst) (cdar lst))
              ll (append ll (list '(92 . 7) '(72 . 0) '(73 . 1) (car lst)) p '((97 . 0)))
        )
        (entmakex (vl-remove nil (append l (list (cons 90 (cdar lst)) '(70 . 1)) p (list (assoc 210 e)))))
      )
      (entmakex (vl-remove nil
                           (append (list '(0 . "HATCH")
                                         '(100 . "AcDbEntity")
                                         (assoc 410 l)
                                         (assoc 8 l)
                                         (assoc 62 l)
                                         (assoc 420 l)
                                         '(100 . "AcDbHatch")
                                         (assoc 10 e)
                                         (assoc 210 e)
                                         '(2 . "SOLID")
                                         (assoc 70 e)
                                         (assoc 71 e)
                                         (assoc 91 e)
                                   )
                                   ll
                                   (list '(75 . 0)
                                         '(76 . 1)
                                         '(47 . 1.)
                                         '(98 . 2)
                                         '(10 0. 0. 0.0)
                                         '(10 0. 0. 0.0)
                                         '(450 . 0)
                                         '(451 . 0)
                                         '(460 . 0.0)
                                         '(461 . 0.0)
                                         '(452 . 0)
                                         '(462 . 0.0)
                                         '(453 . 2)
                                         '(463 . 0.0)
                                         '(63 . 256)
                                         '(463 . 1.0)
                                         '(63 . 256)
                                         '(470 . "LINEAR")
                                   )
                           )
                )
      )
    )
  )
  (princ)
)

[Anonymous]

Евгений, спасибо Вам!!!!! Работает. Буду тестировать!!!!!! Ура!

[Anonymous]

Не забудь отписаться, чем закончилось тестирование! Если все ок, выстави балы, у меня их пока нет, я уже много лет не заходил на этот форум...

Тогда, еще не придумали баллы, а я тоже хочу! 

[Anonymous]

Хорошо! Спасибо Вам!

[Olga_Shevchenko]

Тоже затестила, ошибок не выявилось пока. Все отлично.

Вот сделать бы еще обратное преобразование 🙂 Автокадовскую штриховку переделать в МПолигоны также с сохранением стилей и поддержкой многоконтурности. Это возможно?

[Anonymous]

Спасибо за тесты!

Оля, ты  же сама рассказывала, что МПолигоны поддерживают дуговые сегменты...

Моя программа, сейчас обрабатывает только линейные сегменты!

По обратной обработке:

На сколько мне удалось узнать, мполигоны поддерживают линейные и дуговые сегменты и отверстия.

Со штриховками все сложнее:

1. штриховки поодерживают разрозненные области, причем каждая из них поддерживает отверстия с остравками.

2. штриховки моут ограничиваться линейными, дуговыми, эллиптическими и сплайновыми кривыми.

Другими словами, не в любом случае можно создать по штриховке МПолигон. В некоторых случаях, придется выполнять апроксимацию, т.е упрощение геометрии...

[Olga_Shevchenko]

это приемлемо, особенно если апроксимизация управляемая

[sertor]

Доброго времени суток. У меня ворок к тем форумчанам, кто тестировал вышеуказанный лисп. А сохраняется ли прозрачность после преобразования МПолигона?

[АлексЮстасу]

Можно сделать сохранение типов штриховок (конкретных pattern), а не только цвета?

[АлексЮстасу]

И можно сделать штриховки ассоциативными с их контурами?