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

Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > LISP > ЛИСП слои цвета преобразование

ЛИСП слои цвета преобразование

Ответ
Поиск в этой теме
Непрочитано 02.10.2008, 12:48 #1
ЛИСП слои цвета преобразование
Gotch
 
Регистрация: 07.02.2007
Сообщений: 200

ЛИСП Переименовывание слоев и распределение блоков


Друзья помогите пожалуйста!
есть такая программа как Кредо_MIX
в ней мы делаем наши топопланы(собираемся переходить на CIVIL)
но пока трудимся в ней

этот MIX выгоняет полученные планы в dxf со своими названиями слоев
DEFAULT
GOR_BDEFAULT
GOR_DEFAULT
KNT_RDEFAULT
KNT_SDEFAULT
NAD_MDEFAULT
OBRIVDEFAULT
OTKOSDEFAULT
PI_DTDEFAULT
PI_NUDEFAULT
PI_OTDEFAULT
PI_STDEFAULT
PI_TTDEFAULT
SETKR
SETLN
SIT_LDEFAULT
STR_LDEFAULT
TREUGDEFAULT
USLZNDEFAULT
ZAPSKDEFAULT

вот что после я делаю

1
Очищаю файл Purge от одного до двух раз пока неочищу

2
из слоя DEFAULT - вытаскиваю все тексты и переношу в слой NAD_MDEFAULT

3
удаляю слои -
PI_DTDEFAULT
SETLN
STR_LDEFAULT

4
переименовываю слои -
GOR_BDEFAULT - Рельеф Горизонтали основные утолщенные
GOR_DEFAULT - Рельеф Горизонтали основные
KNT_RDEFAULT - Рельеф Контур рельеф
KNT_SDEFAULT - Растительность Контур
NAD_MDEFAULT - Текст
OBRIVDEFAULT - Рельеф Обрыв
OTKOSDEFAULT - Рельеф Откос
PI_NUDEFAULT - Рельеф Отметки номера
PI_OTDEFAULT - Рельеф Отметки
PI_STDEFAULT - Рельеф Точки СТ
PI_TTDEFAULT - Рельеф Точки
SETKR - Координатная сетка
SIT_LDEFAULT - Линии Ситуации
TREUGDEFAULT - Рельеф Поверхность
USLZNDEFAULT - Блоки Разные
ZAPSKDEFAULT - Блоки Растительности

5
задаю цвет для слоя -
GOR_BDEFAULT - Рельеф Горизонтали основные утолщенные - 32
GOR_DEFAULT - Рельеф Горизонтали основные - 32
KNT_RDEFAULT - Рельеф Контур рельеф - 92
KNT_SDEFAULT - Растительность Контур - 172
NAD_MDEFAULT - Текст - white(т.е.черный)
OBRIVDEFAULT - Рельеф Обрыв - 32
OTKOSDEFAULT - Рельеф Откос - 32
PI_NUDEFAULT - Рельеф Отметки номера - red
PI_OTDEFAULT - Рельеф Отметки - blue
PI_STDEFAULT - Рельеф Точки СТ - magneta
PI_TTDEFAULT - Рельеф Точки - blue
SETKR - Координатная сетка - 94
SIT_LDEFAULT - Линии Ситуации - white(т.е.черный)
TREUGDEFAULT - Рельеф Поверхность - 132
USLZNDEFAULT - Блоки Разные - white(т.е.черный)
ZAPSKDEFAULT - Блоки Растительности - 92

6
выделаю в модели все что есть и задаю цвет - по слою, так как по выходу из кредо микса и в слое присвоен цвет и так же каждому объекту присвоен цвет

7
Полилинии в этих слоях по выходу из тогоже кредо микса получаются 3D полилинии
GOR_BDEFAULT - Рельеф Горизонтали основные утолщенные - 32
GOR_DEFAULT - Рельеф Горизонтали основные - 32
преобразовываю в обычные полилинии
отключаю все слои кроме для начала
GOR_BDEFAULT - Рельеф Горизонтали основные утолщенные - 32
выбираю этот слой для использования
и обрабатываю лиспом от Алексея ака kpblc
и тоже самое со вторым слоем

8
после всего этого если бывает время то раскидываю блоки находящиеся в этом слое
USLZNDEFAULT - Блоки Разные - white(т.е.черный)
на дополнительные слои примерно
Блоки Трасса - blue
Блоки Растительности - 92
Блоки Колодцы - white(т.е.черный)
Блоки Аппликация - red
здесь как я думаю оп названию блока можно расскидать по слоям


я прикрепил файл в архиве как он именно выходит из кредо микса


возможно ли это все воплотить в лисп?
если возможно то помогите пожалуйста
Просмотров: 34827
 
Непрочитано 02.10.2008, 12:58
#2
SetQ

конструктор
 
Регистрация: 21.07.2007
Петрозаводск
Сообщений: 1,971


1. на лиспе - можно, начинай - поможем ))
2. можно тупо в scr сделать - кто-нибудь помнит что это такое? )))
SetQ вне форума  
 
Непрочитано 02.10.2008, 13:03
#3
SetQ

конструктор
 
Регистрация: 21.07.2007
Петрозаводск
Сообщений: 1,971


создавай файл 1.scr
первая строчка
_-purge _all _n
и т.д... запускается командой _script
SetQ вне форума  
 
Автор темы   Непрочитано 02.10.2008, 13:55
#4
Gotch


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


этот скрипт потом в виде кнопки можно будет в автокаде сделать?

я бы рад что либо сам написать но не лисп но не скрипты я незнаю
Gotch вне форума  
 
Непрочитано 02.10.2008, 14:03
#5
Makswell

Инженер-строитель
 
Регистрация: 15.08.2007
Киров
Сообщений: 2,204


Пункты 1, 4 и 5. Может кто дальше продолжит...
Код:
[Выделить все]
(defun test (/ adoc name_old_lay_lst new_lay_lst tbl_ent n)
  (vl-load-com)
  (setq adoc (vla-get-activedocument (vlax-get-acad-object)))
  (repeat 2 (vla-purgeall adoc))
  (setq	name_old_lay_lst
	 '("GOR_BDEFAULT"	"GOR_DEFAULT"	     "KNT_RDEFAULT"
	   "KNT_SDEFAULT"	"NAD_MDEFAULT"	     "OBRIVDEFAULT"
	   "OTKOSDEFAULT"	"PI_NUDEFAULT"	     "PI_OTDEFAULT"
	   "PI_STDEFAULT"	"PI_TTDEFAULT"	     "SETKR"
	   "SIT_LDEFAULT"	"TREUGDEFAULT"	     "USLZNDEFAULT"
	   "ZAPSKDEFAULT"
	  )
  )

  (setq	new_lay_lst
	 (list
	   (cons "Рельеф Горизонтали основные утолщенные" 32)
	   (cons "Рельеф Горизонтали основные" 32)
	   (cons "Рельеф Контур рельеф" 92)
	   (cons "Растительность Контур" 172)
	   (cons "Текст" 7)
	   (cons "Рельеф Обрыв" 32)
	   (cons "Рельеф Откос" 32)
	   (cons "Рельеф Отметки номера" 1)
	   (cons "Рельеф Отметки" 5)
	   (cons "Рельеф Точки СТ" 6)
	   (cons "Рельеф Точки" 5)
	   (cons "Координатная сетка" 94)
	   (cons "Линии Ситуации" 7)
	   (cons "Рельеф Поверхность" 132)
	   (cons "Блоки Разные" 7)
	   (cons "Блоки Растительности" 92)
	 )
  )
  (setq n 0)
  (foreach item	name_old_lay_lst
    (if	(tblsearch "LAYER" item)
      (progn
	(setq tbl_ent (entget (tblobjname "LAYER" item)))
	(setq tbl_ent (subst (cons 2 (car (nth n new_lay_lst)))
			     (assoc 2 tbl_ent)
			     tbl_ent
		      )
	)
	(setq tbl_ent (subst (cons 62 (cdr (nth n new_lay_lst)))
			     (assoc 62 tbl_ent)
			     tbl_ent
		      )
	)
	(entmod tbl_ent)
      )
    )
    (setq n (1+ n))
  )
  (princ)
)

ЗЫ Код не проверял.

Последний раз редактировалось Makswell, 02.10.2008 в 15:48.
Makswell вне форума  
 
Непрочитано 02.10.2008, 14:04
#6
SetQ

конструктор
 
Регистрация: 21.07.2007
Петрозаводск
Сообщений: 1,971


это скрипт потом хоть куда))) можни и кнопочкой, можно и на сочетание клавишь..

а в scr не надо никаого языка знать - там просто пишешь те команды, которые в автокаде даёшь. только есть варианты команд с диалогами и без, например пурге - _purge покажет окошко, а _-purge - в командной строке будет рубится. вот нам нужны для командной строки, к ним надо значёк мунса добавлять в начале.

в общем, надо сначала в ручную сделать всё то что ты делаешь, но только с клавиаутуры. например работа со слоями - команда _-layer, изменение свойств объектов - _change..

так что надо покапаться, но это совсем не сложно..
SetQ вне форума  
 
Автор темы   Непрочитано 02.10.2008, 14:11
#7
Gotch


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


(repeat 2 (vla-purgeall adoc))

Makswell как я понимаю это первый пункт
смотри а если он за один роход все очищает то небудет ошибки что во второй раз чистить нечего?


а остальные пункты с ними сложнее?
Gotch вне форума  
 
Автор темы   Непрочитано 02.10.2008, 14:18
#8
Gotch


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


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

Код:
[Выделить все]
(defun c:poly3dto2d (/             adoc       selset 
           3dpoly          counter       2dpoly 
           coord          coord_lst 
           _kpblc-conv-pointlist-to-variant 
           ) 

  (defun _kpblc-conv-pointlist-to-variant (point-list / safe_list result) 
    (setq safe_list (vlax-make-safearray 
            vlax-vbdouble 
            (cons 0 (1- (length point-list))) 
            ) ;_ end of vlax-make-safearray 
     ) ;_ end of setq 
    (setq result (vlax-safearray-fill safe_list point-list)) 
    (vlax-make-variant result) 
    ) ;_ end of defun 

  (vl-load-com) 
  (setq adoc (vla-get-activedocument (vlax-get-acad-object))) 
  (vla-startundomark adoc) 
  (if (setq selset (ssget "_:L" '((0 . "POLYLINE") (410 . "Model")))) 
    (progn 
      (foreach 3dpoly (vl-remove-if 'listp (mapcar 'cadr (ssnamex selset))) 
   (setq 3dpoly  (vlax-ename->vla-object 3dpoly) 
         counter 0 
         ) ;_ end of setq 
   (while 
     (not (vl-catch-all-error-p 
       (vl-catch-all-apply 'vla-get-coordinate (list 3dpoly counter)) 
       ) ;_ end of VL-CATCH-ALL-ERROR-P 
          ) ;_ end of not 
      (setq coord_lst (append coord_lst 
               (list (vlax-safearray->list 
                  (vlax-variant-value 
                    (vla-get-coordinate 3dpoly counter) 
                    ) ;_ end of vlax-variant-value 
                  ) ;_ end of vlax-safearray->list 
                ) ;_ end of list 
               ) ;_ end of append 
       counter   (1+ counter) 
       ) ;_ end of setq 
      ) ;_ end of while 
   (setq 
     2dpoly 
      (vla-addlightweightpolyline 
        (vla-get-modelspace adoc) 
        (_kpblc-conv-pointlist-to-variant 
          (apply 
       'append 
       (mapcar '(lambda (x) (list (car x) (cadr x))) coord_lst) 
       ) ;_ end of apply 
          ) ;_ end of _kpblc-conv-pointlist-to-variant 
        ) ;_ end of vla-AddLightWeightPolyline 
     ) ;_ end of setq 
   (vla-put-elevation 2dpoly (caddar coord_lst)) 
   (setq coord_lst nil) 
   ) ;_ end of foreach 
      (while (and selset (> (sslength selset) 0)) 
   (setq 3dpoly (ssname selset 0)) 
   (ssdel 3dpoly selset) 
   (entdel 3dpoly) 
   ) ;_ end of while 
      ) ;_ end of progn 
    ) ;_ end of if 
  (vla-endundomark adoc) 
  (princ) 
  ) ;_ end of defun
Gotch вне форума  
 
Непрочитано 02.10.2008, 15:03
#9
Makswell

Инженер-строитель
 
Регистрация: 15.08.2007
Киров
Сообщений: 2,204


Цитата:
Сообщение от Gotch Посмотреть сообщение
(repeat 2 (vla-purgeall adoc))

Makswell как я понимаю это первый пункт
смотри а если он за один роход все очищает то небудет ошибки что во второй раз чистить нечего?
Ошибки не будет
Цитата:
Сообщение от Gotch Посмотреть сообщение
а остальные пункты с ними сложнее?
По-разному, но всё решаемо. Если выложишь образец файла, то будет проще.
Makswell вне форума  
 
Непрочитано 02.10.2008, 15:06
#10
Makswell

Инженер-строитель
 
Регистрация: 15.08.2007
Киров
Сообщений: 2,204


Давай по порядку:
п.2 Тексты или ещё МТексты?
п.3 Слои удаляешь LAYDEL'ем? Значит на них ещё что-то находится?
Makswell вне форума  
 
Автор темы   Непрочитано 02.10.2008, 15:33
#11
Gotch


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


вот вложил

п.2
там обычно только текст
он микс не разу мтекст не выдавал,непонимает такого

п.3
да они не пустые
но все что в них мне ненужно
Вложения
Тип файла: rar LIST5.rar (142.7 Кб, 141 просмотров)
Gotch вне форума  
 
Непрочитано 02.10.2008, 15:48
#12
Makswell

Инженер-строитель
 
Регистрация: 15.08.2007
Киров
Сообщений: 2,204


Код из поста №5 не работал. Сейчас исправлено.
Makswell вне форума  
 
Непрочитано 02.10.2008, 16:06
#13
VVA

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


По п.7 могу предложить использовать ConvTo2d -Преобразование линейных объектов в 2D полилинии. Тогда фрагмент кода может выглядеть так:
Код:
[Выделить все]
(if (setq ss (ssget "_X" '((0 . "POLYLINE")(8 . "GOR_*"))))
  (progn
    (SSSETFIRST ss ss)
    (C:ConvTO2D)
    )
  )
3D полилинии должны быть в одной плоскости
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Непрочитано 02.10.2008, 16:14
#14
SetQ

конструктор
 
Регистрация: 21.07.2007
Петрозаводск
Сообщений: 1,971


п. 2

Код:
[Выделить все]
  (If (SetQ ss (ssget "x" '((0 . "TEXT") (8 . "DEFAULT"))))
    (Command "_change" ss "" "_p" "_la" "NAD_MDEFAULT" "")
  )

Последний раз редактировалось SetQ, 02.10.2008 в 16:30.
SetQ вне форума  
 
Непрочитано 02.10.2008, 16:23
#15
Makswell

Инженер-строитель
 
Регистрация: 15.08.2007
Киров
Сообщений: 2,204


Решены пункты 1,2,3,4,5,6,6.1(см. пост 24),7,8:
Код:
[Выделить все]
(defun test (/		    selset	   ent_txt_lst	  txt_ent
	     tmp_lst	    adoc	   name_old_lay_lst
	     new_lay_lst    tbl_ent	   n		  tmp_ent
	     freez_lay_lst  lay_fam	   blk_name_lst	  blk_lay_lst
	     vla_ModelSpace blk_name
	    )
  (vl-load-com)
  (setq adoc (vla-get-activedocument (vlax-get-acad-object)))
  (setq	name_old_lay_lst
	 '("GOR_BDEFAULT"	"GORIZDEFAULT"	     "KNT_RDEFAULT"
	   "KNT_SDEFAULT"	"NAD_MDEFAULT"	     "OBRIVDEFAULT"
	   "OTKOSDEFAULT"	"PI_NUDEFAULT"	     "PI_OTDEFAULT"
	   "PI_STDEFAULT"	"PI_TTDEFAULT"	     "SETKR"
	   "SIT_LDEFAULT"	"TREUGDEFAULT"	     "USLZNDEFAULT"
	   "ZAPSKDEFAULT"
	  )
  )

  (setq	new_lay_lst
	 (list
	   (cons "Рельеф Горизонтали основные утолщенные" 32)
	   (cons "Рельеф Горизонтали основные" 32)
	   (cons "Рельеф Контур рельеф" 92)
	   (cons "Растительность Контур" 172)
	   (cons "Текст" 7)
	   (cons "Рельеф Обрыв" 32)
	   (cons "Рельеф Откос" 32)
	   (cons "Рельеф Отметки номера" 1)
	   (cons "Рельеф Отметки" 5)
	   (cons "Рельеф Точки СТ" 6)
	   (cons "Рельеф Точки" 5)
	   (cons "Координатная сетка" 94)
	   (cons "Линии Ситуации" 7)
	   (cons "Рельеф Поверхность" 132)
	   (cons "Блоки Разные" 7)
	   (cons "Блоки Растительности" 92)
	 )
  )
  (vla-startundomark adoc)
;;; 2 пункт
  (setq selset (ssget "_X" '((0 . "TEXT") (8 . "DEFAULT"))))
  (if selset
    (progn
      (setq ent_txt_lst (mapcar 'cadr (ssnamex selset)))
    )
  )
  (foreach item	ent_txt_lst
    (setq txt_ent (entget item))
    (setq txt_ent (subst (cons 8 "NAD_MDEFAULT") (assoc 8 txt_ent) txt_ent))
    (entmod txt_ent)
  )
;;; 3 пункт
  (setq	selset (ssget "_X"
		      '((-4 . "<OR")
			(8 . "PI_DTDEFAULT")
			(8 . "SETLN")
			(8 . "STR_LDEFAULT")
			(-4 . "OR>")
		       )
	       )
  )
  (if selset
    (progn
      (setq tmp_lst (mapcar 'cadr (ssnamex selset)))
    )
  )
  (foreach item	tmp_lst
    (entdel item)
  )
;;; 4,5 пункт
  (setq n 0)
  (foreach item	name_old_lay_lst
    (if	(tblsearch "LAYER" item)
      (progn
	(setq tbl_ent (entget (tblobjname "LAYER" item)))
	(setq tbl_ent (subst (cons 2 (car (nth n new_lay_lst)))
			     (assoc 2 tbl_ent)
			     tbl_ent
		      )
	)
	(setq tbl_ent (subst (cons 62 (cdr (nth n new_lay_lst)))
			     (assoc 62 tbl_ent)
			     tbl_ent
		      )
	)
	(entmod tbl_ent)
      )
    )
    (setq n (1+ n))
  )
;;; 6 пункт
  (setq selset (ssget "_A"))
  (if selset
    (progn
      (setq tmp_lst (mapcar 'cadr (ssnamex selset)))
    )
  )
  (foreach item	tmp_lst
    (setq tmp_ent (entget item))
    (if	(assoc 62 tmp_ent)
      (progn
	(setq tmp_ent (subst (cons 62 256) (assoc 62 tmp_ent) tmp_ent))
	(entmod tmp_ent)
      )
    )
  )
;;; 6.1 пункт - заморозка слоёв
  (setq	freez_lay_lst
	 '("Растительность Контур"
	   "Рельеф Отметки номера"
	   "Рельеф Поверхность"
	   "Рельеф Контур рельеф"
	  )
  )
  (setq lay_fam (vla-get-Layers adoc))
  (foreach item	freez_lay_lst
    (vla-put-Freeze (vla-item lay_fam item) 1)
  )
;;; 7 пункт
;;;Функция poly3dto2d (подправленый код Алексея Кулика)
;;;****************************************************************
  (defun poly3dto2d (/		       adoc		 selset
		     3dpoly	       counter		 2dpoly
		     coord	       coord_lst
		     _kpblc-conv-pointlist-to-variant
		    )
;;;-------------------------------
    (defun _kpblc-conv-pointlist-to-variant (point-list / safe_list result)
      (setq safe_list (vlax-make-safearray
			vlax-vbdouble
			(cons 0 (1- (length point-list)))
		      )
      )
      (setq result (vlax-safearray-fill safe_list point-list))
      (vlax-make-variant result)
    )
;;;-------------------------------
    (setq adoc (vla-get-activedocument (vlax-get-acad-object)))
    (if
      (setq selset (ssget "_X" '((0 . "POLYLINE") (8 . "Рельеф Горизонтали*"))))
       (progn
	 (foreach 3dpoly (vl-remove-if 'listp (mapcar 'cadr (ssnamex selset)))
	   (setq 3dpoly	 (vlax-ename->vla-object 3dpoly)
		 counter 0
	   )
	   (while
	     (not (vl-catch-all-error-p
		    (vl-catch-all-apply 'vla-get-coordinate (list 3dpoly counter))
		  )
	     )
	      (setq coord_lst (append coord_lst
				      (list (vlax-safearray->list
					      (vlax-variant-value
						(vla-get-coordinate 3dpoly counter)
					      )
					    )
				      )
			      )
		    counter   (1+ counter)
	      )
	   )
	   (setq
	     2dpoly
	      (vla-addlightweightpolyline
		(vla-get-modelspace adoc)
		(_kpblc-conv-pointlist-to-variant
		  (apply
		    'append
		    (mapcar '(lambda (x) (list (car x) (cadr x))) coord_lst)
		  )
		)
	      )
	   )
	   (vla-put-elevation 2dpoly (caddar coord_lst))
	   (vla-put-Layer 2dpoly (vla-get-Layer 3dpoly))
	   (setq coord_lst nil)
	 )
	 (while	(and selset (> (sslength selset) 0))
	   (setq 3dpoly (ssname selset 0))
	   (ssdel 3dpoly selset)
	   (entdel 3dpoly)
	 )
       )
    )
  )
;;;****************************************************************
  (poly3dto2d)
;;; 8 пункт
  (setq	blk_name_lst
	 (list
	   (list "BL_48"     "BL_64"	 "BL_66"     "BL_62"	 "BL_275"
		 "BL_63"     "BL_65"	 "BL_112"    "BL_47"	 "BL_60"
		 "BL_49"     "BL_58"	 "BL_53"     "BL_52"	 "BL_61"
		 "BL_57"     "BL_50"	 "BL_51"     "BL_59"	 "BL_54"
		 "BL_55"     "BL_56"	 "BL_4175"   "BL_4176"
		)
	   (list "BL_1001" "BL_86" "BL_1007" "BL_4017")
	   (list "BL_12"     "BL_6500"	 "BL_15"     "BL_13"	 "BL_117"
		 "BL_11"     "BL_10"	 "BL_16"     "BL_9"	 "BL_14"
		)
	   (list "BL_83"     "BL_84"	 "BL_87"     "BL_45"	 "BL_85"
		 "BL_73"     "BL_74"	 "BL_151"    "BL_67"	 "BL_1010"
		 "BL_152"    "BL_76"	 "BL_75"     "BL_46"	 "BL_153"
		 "BL_154"    "BL_155"	 "BL_156"    "BL_4152"
		)
	   (list "BL_114"    "BL_4449"	 "BL_28"     "BL_30"	 "BL_29"
		 "BL_31"     "BL_4458"	 "BL_4459"   "BL_4460"	 "BL_4461"
		 "BL_4454"   "BL_4462"	 "BL_4463"   "BL_4453"	 "BL_4457"
		 "BL_4456"   "BL_4455"	 "BL_17"     "BL_18"	 "BL_114"
		 "BL_160"    "BL_1000"	 "BL_44"     "BL_40"	 "BL_42"
		 "BL_41"     "BL_43"	 "BL_20"     "BL_26"	 "BL_27"
		 "BL_24"     "BL_25"	 "BL_22"     "BL_23"	 "BL_21"
		 "BL_36"     "BL_38"	 "BL_37"     "BL_39"	 "BL_32"
		 "BL_34"     "BL_33"	 "BL_35"
		)
	   (list "BL_8"	      "BL_141"	   "BL_142"	"BL_143"
		 "BL_144"     "BL_72"	   "BL_6035"	"BL_6036"
		 "BL_6037"    "BL_135"	   "BL_80"	"BL_2017"
		 "BL_138"     "BL_137"	   "BL_79"	"BL_136"
		 "BL_145"     "BL_146"	   "BL_140"	"BL_139"
		 "BL_78"      "BL_148"	   "BL_77"	"BL_71"
		 "BL_147"     "BL_127"	   "BL_128"	"BL_123"
		 "BL_124"     "BL_131"	   "BL_132"	"BL_129"
		 "BL_130"     "BL_125"	   "BL_126"	"BL_133"
		 "BL_134"     "BL_149"	   "BL_113"	"BL_150"
		)
	   (list "BL_2018"     "BL_2012"     "BL_2014"	   "BL_101"
		 "BL_104"      "BL_103"	     "BL_106"	   "BL_102"
		 "BL_105"      "BL_2001"     "BL_2015"	   "BL_2026"
		 "BL_2025"     "BL_2010"     "BL_2009"	   "BL_2116"
		 "BL_172"      "BL_2004"     "BL_2023"	   "BL_2031"
		 "BL_2118"     "BL_2117"     "BL_109"	   "BL_107"
		 "BL_108"      "BL_106"	     "BL_104"	   "BL_2002"
		 "BL_2013"     "BL_2008"     "BL_2006"	   "BL_2007"
		 "BL_2022"     "BL_2016"     "BL_2115"	   "BL_2011"
		 "BL_2020"     "BL_2019"
		)
	   (list "BL_4027" "BL_4024" "BL_4028" "BL_4025" "BL_4026" "BL_1003")
	   (list "BL_5"	    "BL_120"   "BL_2"	  "BL_1"     "BL_111"
		 "BL_121"   "BL_7"     "BL_6"	  "BL_122"   "BL_4"
		 "BL_3"	    "BL_119"
		)
	   (list "BL_164"    "BL_168"	 "BL_169"    "BL_162"	 "BL_161"
		 "BL_95"     "BL_91"	 "BL_92"     "BL_69"	 "BL_68"
		 "BL_70"     "BL_165"	 "BL_166"    "BL_89"	 "BL_171"
		 "BL_90"     "BL_170"	 "BL_167"    "BL_362"	 "BL_358"
		 "BL_2030"   "BL_94"
		)
	   (list "BL_985"     "BL_979"	   "BL_82"	"BL_970"
		 "BL_971"     "BL_975"	   "BL_972"	"BL_980"
		 "BL_981"     "BL_982"	   "BL_983"	"BL_984"
		 "BL_974"     "BL_989"	   "BL_990"	"BL_81"
		 "BL_973"     "BL_986"	   "BL_988"	"BL_987"
		)
	   (list "BL_6005"     "BL_6006"     "BL_6002"	   "BL_6004"
		 "BL_6003"     "BL_6007"     "BL_6008"	   "BL_6010"
		 "BL_6011"     "BL_6012"     "BL_6013"	   "BL_6014"
		 "BL_6009"     "BL_6015"     "BL_6016"	   "BL_6017"
		 "BL_6018"     "BL_6019"     "BL_6020"	   "BL_6021"
		 "BL_6022"     "BL_6023"     "BL_6024"	   "BL_6025"
		 "BL_6026"     "BL_6027"     "BL_6028"	   "BL_6029"
		 "BL_6030"     "BL_6031"     "BL_6032"	   "BL_6033"
		 "BL_6034"
		)
	 )
  )
  (setq	blk_lay_lst
	 (list
	   (cons "Блоки Колодцы" 7)
	   (cons "Блоки Трасса" 5)
	   (cons "Блоки Светофоры и указатели" 7)
	   (cons "Блоки Объекты Пром и СХ" 7)
	   (cons "Блоки Столбы и опоры" 7)
	   (cons "Блоки Строения" 7)
	   (cons "Блоки Растительности" 92)
	   (cons "Блоки Переезды" 7)
	   (cons "Блоки ГЕО пункты" 7)
	   (cons "Блоки Гидрография" 7)
	   (cons "Блоки Геология" 7)
	   (cons "Блоки Аппликация" 7)
	 )
  )
;;;****************************************************************
  (defun _layer-new_ (lst_name_color)
    (entmakex
      (list (cons 0 "LAYER")
	    (cons 100 "AcDbSymbolTableRecord")
	    (cons 100 "AcDbLayerTableRecord")
	    ;;имя
	    (cons 2 (car lst_name_color))
	    ;;не заморожен, не отключен
	    (cons 70 0)
	    ;;цвет
	    (cons 62 (cdr lst_name_color))
	    ;;тип линии - "CONTI"
	    (cons 6 "CONTI")
	    ;;вес линии - поУмолчанию
	    (cons 370 -3)
	    ;;печать - да
	    (cons 290 1)
      )
    )
  )
;;;****************************************************************
  (foreach item	blk_lay_lst
    (if	(not (tblsearch "LAYER" (car item)))
      (progn
	(_layer-new_ item)
      )
    )
  )
  (setq vla_ModelSpace (vla-get-ModelSpace adoc))
  (vlax-for f_item vla_ModelSpace
    (if	(= (vla-get-ObjectName f_item) "AcDbBlockReference")
      (progn
	(setq n 0)
	(setq blk_name (vla-get-EffectiveName f_item))
	(foreach item blk_name_lst
	  (if (member blk_name item)
	    (progn
	      (vla-put-Layer f_item (car (nth n blk_lay_lst)))
	      (setq n (1+ n))
	    )
	  )
	)
      )
    )
  )
;;; 1 пункт - лучше делать в конце
  (repeat 3 (vla-purgeall adoc))
  (vla-endundomark adoc)
  (princ)
)
Вложения
Тип файла: lsp test.LSP (10.0 Кб, 129 просмотров)

Последний раз редактировалось Makswell, 06.10.2008 в 09:44.
Makswell вне форума  
 
Непрочитано 02.10.2008, 17:04
#16
dkite


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


Давненько в Credo не работал, но помню, что если в ЦММ сделать несколько слоев, то в DXF-файле получим еще комплект слоев, где DEFAULT будет заменено на имя слоя, например SIT_LТРАССА и т.п.
dkite вне форума  
 
Автор темы   Непрочитано 02.10.2008, 19:14
#17
Gotch


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


Код:
[Выделить все]
	 '("GOR_BDEFAULT"	"GOR_DEFAULT"	     "KNT_RDEFAULT"
	   "KNT_SDEFAULT"	"NAD_MDEFAULT"	     "OBRIVDEFAULT"
	   "OTKOSDEFAULT"	"PI_NUDEFAULT"	     "PI_OTDEFAULT"
	   "PI_STDEFAULT"	"PI_TTDEFAULT"	     "SETKR"
	   "SIT_LDEFAULT"	"TREUGDEFAULT"	     "USLZNDEFAULT"
	   "ZAPSKDEFAULT"
	  )
  )

  (setq	new_lay_lst
	 (list
	   (cons "Рельеф Горизонтали основные утолщенные" 32)
	   (cons "Рельеф Горизонтали основные" 32)
	   (cons "Рельеф Контур рельеф" 92)
	   (cons "Растительность Контур" 172)
	   (cons "Текст" 7)
	   (cons "Рельеф Обрыв" 32)
	   (cons "Рельеф Откос" 32)
	   (cons "Рельеф Отметки номера" 1)
	   (cons "Рельеф Отметки" 5)
	   (cons "Рельеф Точки СТ" 6)
	   (cons "Рельеф Точки" 5)
	   (cons "Координатная сетка" 94)
	   (cons "Линии Ситуации" 7)
	   (cons "Рельеф Поверхность" 132)
	   (cons "Блоки Разные" 7)
	   (cons "Блоки Растительности" 92)
	 )
в этом коде я так понимаю прописано сопоставление слоев так сказать типа -
"GOR_BDEFAULT" = (cons "Рельеф Горизонтали основные утолщенные" 32)

да?

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

и так же задание цвета
Gotch вне форума  
 
Автор темы   Непрочитано 02.10.2008, 19:17
#18
Gotch


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


Давненько в Credo не работал, но помню, что если в ЦММ сделать несколько слоев, то в DXF-файле получим еще комплект слоев, где DEFAULT будет заменено на имя слоя, например SIT_LТРАССА и т.п.

да да да так и есть

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

и тогда кредо уйдет в небытие

только одно убивет хотел CIVIL 2008 но не смог найти
придется работать с 2009
Gotch вне форума  
 
Непрочитано 03.10.2008, 08:30
#19
Makswell

Инженер-строитель
 
Регистрация: 15.08.2007
Киров
Сообщений: 2,204


Цитата:
Сообщение от Gotch Посмотреть сообщение
в этом коде я так понимаю прописано сопоставление слоев так сказать типа -
"GOR_BDEFAULT" = (cons "Рельеф Горизонтали основные утолщенные" 32)

да?

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

и так же задание цвета
Да. Эти списки можно пополнять, или урезать. Главное, чтобы количество элементов в первом списке равнялось количеству элементов во втором.

ЗЫ Ты запускал программу? А то не понятно, устраивает она тебя на данном этапе или нет.
Makswell вне форума  
 
Автор темы   Непрочитано 03.10.2008, 09:03
#20
Gotch


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


Цитата:
Сообщение от Makswell Посмотреть сообщение
ЗЫ Ты запускал программу? А то не понятно, устраивает она тебя на данном этапе или нет.

Opening a Release 12 DXF file.
Regenerating model.

AutoCAD Express Tools Copyright © 2002-2004 Autodesk, Inc.

AutoCAD menu utilities loaded.*Cancel*

Command: '_.zoom _e
Command: (load "test")
TEST

Command: test
Unknown command "TEST". Press F1 for help.

Command: TEST
Unknown command "TEST". Press F1 for help.


что то либо я не так запускаю, или она нехочет запускатья...
Gotch вне форума  
Ответ
Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > LISP > ЛИСП слои цвета преобразование

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

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


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Нужен Лисп для перевода цвета объекта ilka_t LISP 28 25.01.2022 16:04
Для чего нужны фильтры слоев?Как ими пользоваться? Aysulu AutoCAD 43 17.04.2019 10:59
Лисп для копирования данных нескольких мтекстов по принципу расположения. Red Nova LISP 14 18.06.2008 22:08
Как удалять слои???????? Абдула AutoCAD 2 03.10.2005 19:07