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

Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > Автоматическое назначение цветов по градиенту на комплект слоев

Автоматическое назначение цветов по градиенту на комплект слоев

Ответ
Поиск в этой теме
Непрочитано 25.01.2009, 03:05 #1
Автоматическое назначение цветов по градиенту на комплект слоев
Olga_@@@
 
Екатеринбург
Регистрация: 14.03.2008
Сообщений: 678

Не получается решить такую задачу:
назначить цвета таким образом, чтобы слоям лежащим между слоями с заданными цветами, были присвоены цвета образуюшие плавный градиентный переход от одного заданного цвета к другому.
Прикладываю фрагмент файла, который хотелось бы обработать таким образом, если это возможно (в оригинале слоев намного больше). Это горизонтали, отбитые через 5 м. Все горизонтали распределены по слоям, названия которых соответствуют высотным отметкам горизонталей.
Может быть можно сделать это с помощью лиспа?

PS Готовлю иллюстрацию в книгу, хотелось бы сделать рельеф более наглядным за счет цвета линий (чтобы показать в какую сторону идет повышение/понижение рельефа), т.к. высотные отметки не будут указаны.

PPS Все данные в этом файле получены из источников, находящихся в открытом доступе.
Просмотров: 5708
 
Автор темы   Непрочитано 25.01.2009, 03:16
#2
Olga_@@@


 
Регистрация: 14.03.2008
Екатеринбург
Сообщений: 678
<phrase 1= Отправить сообщение для Olga_@@@ с помощью Skype™


Вот файл для примера
Вложения
Тип файла: dwg
DWG 2004
fr1.dwg (2.40 Мб, 754 просмотров)
Olga_@@@ вне форума  
 
Непрочитано 25.01.2009, 17:18
#3
Andi55

инженер-электрик
 
Регистрация: 12.08.2005
Иркутск
Сообщений: 523
<phrase 1=


Блажь это. Для одной разовой операции - сделай все сама ручками, или поручи подчиненному.
Andi55 вне форума  
 
Автор темы   Непрочитано 25.01.2009, 18:12
#4
Olga_@@@


 
Регистрация: 14.03.2008
Екатеринбург
Сообщений: 678
<phrase 1= Отправить сообщение для Olga_@@@ с помощью Skype™


Если бы это была разовая задача, я бы не стала создавать тему.
Olga_@@@ вне форума  
 
Непрочитано 25.01.2009, 22:23
#5
Donhuan

Проектировщик СС
 
Регистрация: 24.06.2008
Минск
Сообщений: 134
<phrase 1=


Коряво наверное, но работает.
Код:
[Выделить все]
(defun c:gr_color_layers
		       (/	      LayersCol	    ActiveDoc
			ListLayers    FirstColor    SecondColor
			IncRGB
		       )
  (setq	ActiveDoc (vla-get-ActiveDocument (vlax-get-acad-object))
	LayersCol (vla-get-layers ActiveDoc)
  ) ;_ end of setq
  (vlax-for i LayersCol
    (setq ListLayers
	   (cons (list (vla-get-name i) (vla-get-truecolor i) i)
		 ListLayers
	   ) ;_ end of cons
    ) ;_ end of setq
  ) ;_ end of vlax-for
  (setq	ListLayers
		   (vl-remove-if-not
		     '(lambda (x) (wcmatch (car x) "###*"))
		     ListLayers
		   ) ;_ end of vl-remove-if-not
	ListLayers (mapcar '(lambda (x)
			      ((lambda (y / i)
				 (setq i 1)
				 (while	(wcmatch (substr y i 1) "#")
				   (setq i (1+ i))
				 ) ;_ end of while
				 (cons (atoi (substr y 1 (1- i))) x)
			       ) ;_ end of lambda
				(car x)
			      )
			    ) ;_ end of lambda
			   ListLayers
		   ) ;_ end of mapcar
	ListLayers (create_range
		     (vl-sort ListLayers
			      '(lambda (x y) (< (car x) (car y)))
		     ) ;_ end of vl-sort
		     nil
		     1
		   ) ;_ end of create_range
	ListLayers ((lambda (x y z)
		      (while (<= x y)
			(setq z	(cons (vl-remove-if-not
					'(lambda (a) (= (car a) y))
					ListLayers
				      ) ;_ end of vl-remove-if-not
				      z
				) ;_ end of cons
			      y	(1- y)
			) ;_ end of setq
		      ) ;_ end of while
		      z
		    ) ;_ end of lambda
		     1
		     (car (last ListLayers))
		     nil
		   )
  ) ;_ end of setq
  (while (cdr ListLayers)
    (setq FirstColor  ((lambda (x)
			 (list (vla-get-red x)
			       (vla-get-green x)
			       (vla-get-blue x)
			 ) ;_ end of list
		       ) ;_ end of lambda
			(cadr (cddaar ListLayers))
		      )
	  SecondColor ((lambda (x)
			 (list (vla-get-red x)
			       (vla-get-green x)
		  	       (vla-get-blue x)
			 ) ;_ end of list
		       ) ;_ end of lambda
			(caddr (cdaadr ListLayers))
		      )
	  IncRGB      ((lambda (x)
			 (list
			   (/ (- (car SecondColor) (car FirstColor))
			      x
			   ) ;_ end of /
			   (/ (- (cadr SecondColor) (cadr FirstColor))
			      x
			   ) ;_ end of /
			   (/ (- (caddr SecondColor)
				 (caddr FirstColor)
			      ) ;_ end of -
			      x
			   ) ;_ end of /
			 ) ;_ end of list
		       ) ;_ end of lambda
			(length (car ListLayers))
		      )
    ) ;_ end of list
    (change_color (cdar ListLayers) (1- (length (car ListLayers))) IncRGB FirstColor)
    (setq ListLayers (cdr ListLayers))
  ) ;_ end of setq
  (princ)
) ;_ end of defun


(defun create_range (l f i /)
  (cond
    ((null l) nil)
    ((and (not f)
	  (not (= (vla-get-colorindex (caddar l)) acWhite))
     ) ;_ end of and
     (cons (cons i (car l)) (create_range (cdr l) t i))
    )
    ((and f (not (= (vla-get-colorindex (caddar l)) acWhite)))
     (cons (cons (setq i (1+ i)) (car l))
	   (create_range (cdr l) t i)
     ) ;_ end of cons
    )
    (t (cons (cons i (car l)) (create_range (cdr l) t i)))
  ) ;_ end of cond
) ;_ end of defun

(defun change_color (l i IncRGB FirstColor /)
  (repeat i
    ((lambda (x)
       ((lambda	(y z)
	  (vla-setrgb x (car z) (cadr z) (caddr z))
	  (vla-put-truecolor y x)
	) ;_ end of lambda
	 (last (car l))
	 (setq FirstColor
		(list (+ (car FirstColor) (car IncRGB))
		      (+ (cadr FirstColor) (cadr IncRGB))
		      (+ (caddr FirstColor) (caddr IncRGB))
		) ;_ end of list
	 ) ;_ end of list
       ) ;_ end of lambda
       
     ) ;_ end of lambda
      (car (cdddar l))
    ) ;_ end of repeat
    (setq l (cdr l))
  ) ;_ end of repeat
) ;_ end of defun

(vl-load-com)
(princ "\nЗапуск функции: набрать в ком. строке gr_color_layers")
(princ "\n")
Результат работы на приложенном скрине.
Внимание программа изменяет цвета всех слоев формата "###*", включая замороженные и заблокированные, кроме тех, для которых указан цвет отличный от белого.
Миниатюры
Нажмите на изображение для увеличения
Название: До.jpg
Просмотров: 130
Размер:	172.9 Кб
ID:	15106  Нажмите на изображение для увеличения
Название: После.jpg
Просмотров: 144
Размер:	157.9 Кб
ID:	15107  

Последний раз редактировалось Donhuan, 26.01.2009 в 00:51.
Donhuan вне форума  
 
Автор темы   Непрочитано 26.01.2009, 00:26
#6
Olga_@@@


 
Регистрация: 14.03.2008
Екатеринбург
Сообщений: 678
<phrase 1= Отправить сообщение для Olga_@@@ с помощью Skype™


Donhuan, классно работает Спасибо!!!
Вот как получилось. Это первые пробы. Но, руками однозначно хуже получается.
Миниатюры
Нажмите на изображение для увеличения
Название: Снимок1.jpg
Просмотров: 142
Размер:	74.3 Кб
ID:	15111  Нажмите на изображение для увеличения
Название: Снимок2.jpg
Просмотров: 224
Размер:	154.9 Кб
ID:	15112  

Последний раз редактировалось Olga_@@@, 26.01.2009 в 00:38.
Olga_@@@ вне форума  
 
Непрочитано 26.01.2009, 00:38
#7
Donhuan

Проектировщик СС
 
Регистрация: 24.06.2008
Минск
Сообщений: 134
<phrase 1=


Не за что, мне самому тоже понравилось
P.S. А можно узнать адрес источника, где эти файлы лежат, а то охота поэкспериментировать на чем нибудь более объемном?
Donhuan вне форума  
 
Автор темы   Непрочитано 26.01.2009, 01:03
#8
Olga_@@@


 
Регистрация: 14.03.2008
Екатеринбург
Сообщений: 678
<phrase 1= Отправить сообщение для Olga_@@@ с помощью Skype™


Сначала это все на сайте NASA было, потом несколько зеркал появилось. Качать можно здесь http://ftp.ecc.u-tokyo.ac.jp/GIS/e0s...SRTM3/Eurasia/или здесь http://ftp.ecc.u-tokyo.ac.jp/GIS/e0s...SRTM3/Eurasia/. Неполная коллекция лежит еще и здесь http://gps.uralstars.com/srtm/- по скорости значительно быстрее первых двух.
Эти файлы открываются и обрабатываются в GlobalMapper http://www.globalmapper.com/
Olga_@@@ вне форума  
 
Автор темы   Непрочитано 26.01.2009, 01:10
#9
Olga_@@@


 
Регистрация: 14.03.2008
Екатеринбург
Сообщений: 678
<phrase 1= Отправить сообщение для Olga_@@@ с помощью Skype™


Donhuan, а как там можно формат имени слоя подредактировать, чтобы он не только трехзначные цифири видел?
Olga_@@@ вне форума  
 
Непрочитано 26.01.2009, 01:34
#10
Donhuan

Проектировщик СС
 
Регистрация: 24.06.2008
Минск
Сообщений: 134
<phrase 1=


Спасибо за ссылки.
В проге изначально считается, что имена начинаются с цифр.
Отбор слоев осуществляется в этом куске кода:
Код:
[Выделить все]
(vl-remove-if-not
  '(lambda (x) (wcmatch (car x) "###*"))
   ListLayers
) ;_ end of vl-remove-if-not
, а конкретней функцией wcmatch - в кавычках строка-шаблон. "###*"- означает 3 цифры и любое количество символов, для четырех цифр надо "####*" и т.д.
Можешь либо почитать в хелпе про формат шаблона данной функции, либо описать все возможные имена слоев, которые надо обрабатывать и я модернизирую прогу.
Вообще лучше наверное будет сделать, чтобы передавать шаблон как параметр в функцию.

Последний раз редактировалось Donhuan, 26.01.2009 в 01:52.
Donhuan вне форума  
 
Автор темы   Непрочитано 26.01.2009, 02:22
#11
Olga_@@@


 
Регистрация: 14.03.2008
Екатеринбург
Сообщений: 678
<phrase 1= Отправить сообщение для Olga_@@@ с помощью Skype™


К сожалению в лиспе совсем никак не ориентируюсь. Утром на свежую голову опишу возможные варианты.

ps если по GM появятся вопросы, то с удовольствием отвечу.
Olga_@@@ вне форума  
 
Непрочитано 26.01.2009, 18:06
#12
Donhuan

Проектировщик СС
 
Регистрация: 24.06.2008
Минск
Сообщений: 134
<phrase 1=


Дополненный вариант.
Запуск фукции (gr_color_layers "*_m") в ком. строке.
Работает непосредственно с файлом .dwg после экспорта из GM. От пользователя требуется только присвоить цвета нужным слоям. Установка цвета полилиний в bylayer и создание градиента производится функцией.

Код:
[Выделить все]
(defun gr_color_layers (Pattern	     /		  LayersCol
			OldVar	     ActiveDoc	  ListLayers
			FirstColor   SecondColor  IncRGB
			AcCmColor
		       )
  (setq	ActiveDoc (vla-get-ActiveDocument (vlax-get-acad-object))
	LayersCol (vla-get-layers ActiveDoc)
	AcCmColor (vla-GetInterfaceObject
		    (vlax-get-acad-object)
		    "AutoCAD.AcCmColor.16"
		  ) ;_ end of vla-GetInterfaceObject
	OldVar	  (getvar "CMDECHO")
  ) ;_ end of setq
  (setvar "CMDECHO" 0)
  (command "_.undo" "_be")
  (mapcar				; change polylines color to bylayer
    '(lambda (x / i)
       (vla-put-truecolor x AcCmColor)
     ) ;_ end of lambda
    (mapcar '(lambda (x) (vlax-ename->vla-object (cadr x)))
	    (ssnamex
	      (ssget "_x" (list (cons 0 "LWPOLYLINE") (cons 8 Pattern)))
	    ) ;_ end of ssnamex
    ) ;_ end of mapcar
  ) ;_ end of mapcar
  (vlax-for i LayersCol
    (if	(wcmatch (vla-get-name i) Pattern)
      (setq ListLayers			; create list layers
	     (cons (cons (vla-get-name i) i) ListLayers) ;_ end of cons
      ) ;_ end of setq
    ) ;_ end of setq
  ) ;_ end of vlax-for
  (setq	ListLayers (mapcar '(lambda (x)	; extract number from layers names
			      ((lambda (y / i)
				 (setq i 1)
				 (while	(wcmatch (substr y i 1) "#")
				   (setq i (1+ i))
				 ) ;_ end of while
				 (cons (atoi (substr y 1 (1- i))) (cdr x))
			       ) ;_ end of lambda
				(car x)
			      )
			    ) ;_ end of lambda
			   ListLayers
		   ) ;_ end of mapcar
	ListLayers (create_range	; sort layers and create ranges
		     (vl-sort ListLayers
			      '(lambda (x y) (< (car x) (car y)))
		     ) ;_ end of vl-sort
		     nil
		     1
		   ) ;_ end of create_range
  ) ;_ end of setq
  (while (cdr ListLayers)
    ((lambda (x z / l y)
       (setq y		 (vla-get-truecolor
			   z
			 ) ;_ end of vla-get-truecolor
	     FirstColor	 (list (vla-get-red x)
			       (vla-get-green x)
			       (vla-get-blue x)
			 ) ;_ end of list
	     SecondColor (list (vla-get-red y)
			       (vla-get-green y)
			       (vla-get-blue y)
			 ) ;_ end of list
	     l		 (-
			   (length ListLayers)
			   (length (member (cons (1+ (caar ListLayers)) z) ListLayers)
			   ) ;_ end of length
			 ) ;_ end of -
	     IncRGB	 (list
			   (/ (- (car SecondColor) (car FirstColor))
			      l
			   ) ;_ end of /
			   (/ (- (cadr SecondColor) (cadr FirstColor))
			      l
			   ) ;_ end of /
			   (/ (- (caddr SecondColor)
				 (caddr FirstColor)
			      ) ;_ end of -
			      l
			   ) ;_ end of /
			 ) ;_ end of list
	     ListLayers	 (cdr ListLayers)
       ) ;_ end of list
       (repeat (1- l)
	 (setq FirstColor
		(list (+ (car FirstColor) (car IncRGB))
		      (+ (cadr FirstColor) (cadr IncRGB))
		      (+ (caddr FirstColor) (caddr IncRGB))
		) ;_ end of list
	 ) ;_ end of setq
	 (vla-setrgb
	   AcCmColor
	   (car FirstColor)
	   (cadr FirstColor)
	   (caddr FirstColor)
	 ) ;_ end of vla-setrgb
	 (vla-put-truecolor (cdar ListLayers) AcCmColor)
	 (setq ListLayers (cdr ListLayers))
       ) ;_ end of repeat
     ) ;_ end of lambda
      (vla-get-truecolor (cdar ListLayers))
      (cdr (assoc (1+ (caar ListLayers)) ListLayers))
    )
  ) ;_ end of setq
  (command "_.undo" "_e")
  (setvar "CMDECHO" OldVar)
  (princ)
) ;_ end of defun


(defun create_range (l f i /)
  (cond
    ((null l) nil)
    ((and (not f)
	  (not (= (vla-get-colorindex (vla-get-truecolor (cdar l)))
		  acWhite
	       ) ;_ end of =
	  ) ;_ end of not
     ) ;_ end of and
     (cons (cons i (cdar l)) (create_range (cdr l) t i))
    )
    ((and f
	  (not (= (vla-get-colorindex (vla-get-truecolor (cdar l)))
		  acWhite
	       ) ;_ end of =
	  ) ;_ end of not
     ) ;_ end of and
     (cons (cons (setq i (1+ i)) (cdar l))
	   (create_range (cdr l) t i)
     ) ;_ end of cons
    )
    (t (cons (cons i (cdar l)) (create_range (cdr l) t i)))
  ) ;_ end of cond
) ;_ end of defun

(vl-load-com)
(princ
  "\nЗапуск функции: набрать в ком. строке (gr_color_layers \"*_m\"), \"*_m\" - пример шаблона."
) ;_ end of princ
(princ "\n")
Donhuan вне форума  
 
Автор темы   Непрочитано 26.01.2009, 18:17
#13
Olga_@@@


 
Регистрация: 14.03.2008
Екатеринбург
Сообщений: 678
<phrase 1= Отправить сообщение для Olga_@@@ с помощью Skype™


Donhuan, Вы меня опередили я еще возможные форматы не описала, сорри. Сумашедший денёк был.
Сегодня совместила этот рельеф с гарминовской графикой и выдала археологам промежуточный вариант, им понравилась идея. Сказали, что это действительно удобно и даже сказали, что это лучшая карта из тех, что у них есть
Olga_@@@ вне форума  
 
Непрочитано 26.01.2009, 18:57
#14
Donhuan

Проектировщик СС
 
Регистрация: 24.06.2008
Минск
Сообщений: 134
<phrase 1=


Последняя функция должна сильно ускорять перевод цветов полилиний в bylayer, попробуйте.
У меня лично в больших файлах попытки измения цвета стандартным способом сразу всех полилиний скопом, приводили к вылету акада из-за нехватки памяти.
По-идее если названия слоев имеют формат "уровень *_m" (а других вариантов в GM кроме футов нет, для этого достаточно задать шаблон "*_ft"), то все они будут обработаны последним вариантом функции с указанным параметром (шаблоном).
P.S. Если планируется постоянное использование в работе данного лиспа, то в будущем можно присобачить к нему диалоговое окно и придумать как можно автоматом назначать ключевые цвета слоям.

Последний раз редактировалось Donhuan, 26.01.2009 в 19:03.
Donhuan вне форума  
 
Автор темы   Непрочитано 26.01.2009, 20:04
#15
Olga_@@@


 
Регистрация: 14.03.2008
Екатеринбург
Сообщений: 678
<phrase 1= Отправить сообщение для Olga_@@@ с помощью Skype™


Вы прямо мысли читаете Весь день про диалоговое окно думала, но не решалась попросить.
Если бы было диалоговое окно, то тогда наверное стоило бы отвязаться от слоев с их форматами и задавать цвета по значению Elevation или по значению одного из полей в таблице объектных данных. Тогда этим лиспом можно было бы обрабатывать практически любые даные из разных программ.
Olga_@@@ вне форума  
 
Непрочитано 26.01.2009, 20:15
#16
Donhuan

Проектировщик СС
 
Регистрация: 24.06.2008
Минск
Сообщений: 134
<phrase 1=


По большому счету можно и отказаться от слоев, если каждое сечение заведомо расположено на своем уровне. Но здесь есть ньюанс: если понадобиться вдруг поэкспериментировать с рисунком в плане подбора окраски, то перекрашивать каждый раз линии будет гораздо медленее чем слои. Хотя есть выход - создавать нужные слои самостоятельно.
В диалоговом окне можно будет задавать шаблон слоев и настраивать цветовую шкалу. Только быстро это сделать не получится потому как работать еще надо
Donhuan вне форума  
 
Автор темы   Непрочитано 26.01.2009, 20:38
#17
Olga_@@@


 
Регистрация: 14.03.2008
Екатеринбург
Сообщений: 678
<phrase 1= Отправить сообщение для Olga_@@@ с помощью Skype™


Да, ясно.. слои-то он действительно за доли секунды обрабатывает, а с примитивами будет долго возиться и не факт, что памяти хватит
Olga_@@@ вне форума  
 
Автор темы   Непрочитано 27.01.2009, 02:09
#18
Olga_@@@


 
Регистрация: 14.03.2008
Екатеринбург
Сообщений: 678
<phrase 1= Отправить сообщение для Olga_@@@ с помощью Skype™


Не получилось почему-то... еще раз попробую завтра.
Сделала еще пару файлов, определились такие форматы:
-20_M
-2_M
0_M
20_M
200_M
2000_M

и вариант с десятичным делителем
20_5_M

и с сортировкой слоев проблема - сортируется, как текстовый формат, а не по возрастанию числовых значений.
Olga_@@@ вне форума  
 
Непрочитано 27.01.2009, 10:20
#19
VVA

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


Donhuan, Еще на заметку. Ты сейчас применяешь модель RGB для перехода. Как вариант попробовать перевести в HSL и управлять долями H (оттенок ), S (насыщенность) и L (яркость).
Функции перевода здесь. Хотя может это и лишнее. И так получается красиво

*** Добавлено
Ещ один вариант (про круги) http://autolisper.googlepages.com/
Беглый просмотр кода показывает, что тоже меняют градиент через HSL
__________________
Как использовать код на Лиспе читаем здесь

Последний раз редактировалось VVA, 25.08.2010 в 13:28.
VVA вне форума  
 
Автор темы   Непрочитано 27.01.2009, 13:44
#20
Olga_@@@


 
Регистрация: 14.03.2008
Екатеринбург
Сообщений: 678
<phrase 1= Отправить сообщение для Olga_@@@ с помощью Skype™


Donhuan, теперь все получилось (я вчера без скобок команду вводила поэтому и не шло). Классно, что программа теперь сама цвет примитивов меняет на BYLAIER. Намного быстрее, чем врукопашную.
А, с какого объема у Вас автокад начал вылетать? Может быть окно Свойств открыто было? Я вчера 15 квадратов в один файл собрала и все работало.
Olga_@@@ вне форума  
Ответ
Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > Автоматическое назначение цветов по градиенту на комплект слоев

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

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


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Для чего нужны фильтры слоев?Как ими пользоваться? Aysulu AutoCAD 43 17.04.2019 10:59
Назначение слоев в AutoCAD 2007 RodiXX1 AutoCAD 5 02.08.2007 23:58