Программирование (ObjectARX, ARX, .NET, LISP и др.)

Программирование (ObjectARX, ARX, .NET, LISP и др.)

Ответить
Contributor
Foxxxy
Сообщения: 22
Зарегистрированный: ‎07-10-2012
Сообщение 1 из 16 (732 просмотров)
Утвержденное решение

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

[ Изменено ]
732 Просмотры, 15 Ответы
07-10-2012 11:34 PM

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

Valued Contributor
ElpanovEvgeniy
Сообщения: 89
Зарегистрированный: ‎06-05-2006
Сообщение 2 из 16 (719 просмотров)

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

07-10-2012 11:55 PM в ответ на Foxxxy

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

   
Valued Contributor
ElpanovEvgeniy
Сообщения: 89
Зарегистрированный: ‎06-05-2006
Сообщение 3 из 16 (710 просмотров)

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

[ Изменено ]
07-11-2012 12:13 AM в ответ на Foxxxy

 

(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)
)

 

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

   
Contributor
Foxxxy
Сообщения: 22
Зарегистрированный: ‎07-10-2012
Сообщение 4 из 16 (706 просмотров)

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

[ Изменено ]
07-11-2012 12:22 AM в ответ на ElpanovEvgeniy

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

Contributor
Foxxxy
Сообщения: 22
Зарегистрированный: ‎07-10-2012
Сообщение 5 из 16 (704 просмотров)

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

07-11-2012 12:29 AM в ответ на ElpanovEvgeniy

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

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

Valued Contributor
ElpanovEvgeniy
Сообщения: 89
Зарегистрированный: ‎06-05-2006
Сообщение 6 из 16 (699 просмотров)

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

[ Изменено ]
07-11-2012 12:34 AM в ответ на Foxxxy
(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 добавляет полилинии и удаляет полигоны. Предыдущая программа работала на данном вами примере...

   
Valued Contributor
ElpanovEvgeniy
Сообщения: 89
Зарегистрированный: ‎06-05-2006
Сообщение 7 из 16 (692 просмотров)

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

07-11-2012 12:58 AM в ответ на Foxxxy

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

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

 

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

   
Contributor
Foxxxy
Сообщения: 22
Зарегистрированный: ‎07-10-2012
Сообщение 8 из 16 (690 просмотров)

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

07-11-2012 12:59 AM в ответ на ElpanovEvgeniy

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

Valued Contributor
ElpanovEvgeniy
Сообщения: 89
Зарегистрированный: ‎06-05-2006
Сообщение 9 из 16 (673 просмотров)

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

[ Изменено ]
07-11-2012 04:54 AM в ответ на Foxxxy

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

 

 

(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)
)

 

   
Contributor
Foxxxy
Сообщения: 22
Зарегистрированный: ‎07-10-2012
Сообщение 10 из 16 (667 просмотров)

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

07-11-2012 05:19 AM в ответ на ElpanovEvgeniy

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

You are not logged in.

Войдите под своим именем, чтобы задавать и отвечать на вопросы, делиться идеями и т.п. Еще не зарегистрировались? Зарегистрироваться

Need installation help?

Start with some of our most frequented solutions to get help installing your software.

Спросить Сообщество