Подскажите, пожалуйста, имею в чертеже огромное количество МПолигонов. Возможно ли автоматически преобразовать МПолигон в замкнутую полилинию и заливку с цветом МПолигона? Спасибо.
Solved! Go to Solution.
задача решаема, добавьте в тему еще один примерчек, где будет несколько "MPOLYGON" с различным количеством вершин. Вчерновую уже готово...
(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) )
выкладываю код как есть, почти без проверок...
Евгений, извините за задержку. Эту задачу нам придется выполнять каждый день, так как база обновляется каждый день. Полилиния должна иметь цвет контура мполигона, а цвет штриховки должен быть как цвет заполнения мполигона. Тип как у полигона. Спасибо!
(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 добавляет полилинии и удаляет полигоны. Предыдущая программа работала на данном вами примере...
кстати, начал дальше разбираться с мполигонами, оказывается в них моет содержаться куча контуров - внешний и внутренние, да еще поддерживаются самопересечения...
Это уже действительно беда! Эти полигоны были разработаны для решения задач, которые не решаются штриховками, те. в штриховке не может быть совпадающих точек, самопересечений итд. Штриховка поддерживает только внешние и внутренние контура, при пересечении внешних и внутренних контуров, она автоматом вычисляет новые контура без самопересечений (но только если не очень сложно). Другими словами, перевод МПолигонов в полилинию и штриховку возможен только в частном случае...
И еще, моя программа вытаскивает из полигона все точки и генерит по ним полилинию, уберая лишние точки, попадающие во внутренние контура, те. на данный момент программа работает не верно для полигонов с отверстиями. Чуть позже поправлю.
Евгений, было бы здорово чтобы полилинии которые создаются по команде _t1 имели цвет закрашивания МПолигона и чтобы мполигон заменялся просто штриховкой цвета и типа Мполигона.
Вроде сделал. Тестируйте.
(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) )
Не забудь отписаться, чем закончилось тестирование! Если все ок, выстави балы, у меня их пока нет, я уже много лет не заходил на этот форум...
Тогда, еще не придумали баллы, а я тоже хочу!
Тоже затестила, ошибок не выявилось пока. Все отлично.
Вот сделать бы еще обратное преобразование 🙂 Автокадовскую штриховку переделать в МПолигоны также с сохранением стилей и поддержкой многоконтурности. Это возможно?
Спасибо за тесты!
Оля, ты же сама рассказывала, что МПолигоны поддерживают дуговые сегменты...
Моя программа, сейчас обрабатывает только линейные сегменты!
По обратной обработке:
На сколько мне удалось узнать, мполигоны поддерживают линейные и дуговые сегменты и отверстия.
Со штриховками все сложнее:
1. штриховки поодерживают разрозненные области, причем каждая из них поддерживает отверстия с остравками.
2. штриховки моут ограничиваться линейными, дуговыми, эллиптическими и сплайновыми кривыми.
Другими словами, не в любом случае можно создать по штриховке МПолигон. В некоторых случаях, придется выполнять апроксимацию, т.е упрощение геометрии...
Доброго времени суток. У меня ворок к тем форумчанам, кто тестировал вышеуказанный лисп. А сохраняется ли прозрачность после преобразования МПолигона?
Можно сделать сохранение типов штриховок (конкретных pattern), а не только цвета?
И можно сделать штриховки ассоциативными с их контурами?
Can't find what you're looking for? Ask the community or share your knowledge.