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

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

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

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

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


Друзья помогите пожалуйста!
есть такая программа как Кредо_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
здесь как я думаю оп названию блока можно расскидать по слоям


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


возможно ли это все воплотить в лисп?
если возможно то помогите пожалуйста
Просмотров: 25074
 
Автор темы   Непрочитано 10.10.2008, 07:47
#61
Gotch


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


все равно что то не работает вот что пишет -

Command: (test)
Масштаб съемки [500/1000/2000] <500>:
Regenerating model.

Установлено новое отображения точекRegenerating model.

Установлен новый размер отображения точек; error: no function definition:
M-CREATE-TEXTSTYLE
Gotch вне форума  
 
Непрочитано 10.10.2008, 08:16
#62
Makswell

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


Вчера в 08:17 утра я обновил лисп из поста №41. Ты точно его запустил? Хотя из лога твоей ком. строки очевидно, что ты запускаешь какой-то предыдущий вариант.
Makswell вне форума  
 
Автор темы   Непрочитано 11.10.2008, 19:01
#63
Gotch


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


Сегодня проверил да оказывается работает

но один нюанс...
он блоки не расскидывает по слоям
все блоки собирает в слой - Блоки Колодцы

что то я непонимаю
в одном файле он неправильно расскидал
а в другом наоборот правильно все сделал

Последний раз редактировалось Кулик Алексей aka kpblc, 11.10.2008 в 21:42.
Gotch вне форума  
 
Непрочитано 13.10.2008, 09:18
#64
Makswell

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


Да, точно - так и есть.
Опять исправил код в посте №41.
Пробуй..
Makswell вне форума  
 
Автор темы   Непрочитано 14.10.2008, 14:42
#65
Gotch


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


вроде все нормально

смотри а если файл немного обрабатывали то происходит сбой -

Command: (test)
Масштаб съемки [500/1000/2000] <500>: 2000
Regenerating layout.
Regenerating model.

Установлено новое отображения точек
Regenerating layout.
Regenerating model.

Установлен новый размер отображения точек
Создан текстовый стиль new_style
Все тексты со слоя DEFAULT перенесены на слой NAD_MDEFAULT
Удалены слои PI_DTDEFAULT, SETLN, STR_LDEFAULT со всеми примитивами
Завершено переименование слоёв и задание для них цвета
Завершено задание цвета для всех объектов поСлою; error: Automation Error. Key not found

это выходит из за того что обрабатывали да?
Gotch вне форума  
 
Непрочитано 14.10.2008, 15:29
#66
Makswell

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


Вот новая версия. А то что-то надоело всё время в к 41-му посту возвращаться.
Код:
[Выделить все]
(defun test (/		   reply	 txt_height    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	   lw		 pt_size       flag
	     o_angle	   width
	    )
  (vl-load-com)
  (setq	width	1.
	o_angle	(/ pi 30.)
  )
  (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)
;;; 9 пункт - начало
  (initget 6)
  (setq	reply (getint
		"Масштаб съемки [500/1000/2000] <500>: "
	      )
  )
  (if (not reply)
    (setq reply 500)
  )
  (cond	((= reply 500)
	 (progn (setq lw 0.2) (setq pt_size 0.3) (setq txt_height 1))
	)
	((= reply 1000)
	 (progn (setq lw 0.5) (setq pt_size 0.5) (setq txt_height 2))
	)
	((= reply 2000)
	 (progn (setq lw 1.) (setq pt_size 1.) (setq txt_height 4))
	)
	(t (setq flag t))
  )
  (if flag
    (progn
      (alert "Масштаб съемки выбран неверно")
    )
    (progn
      (setvar "PDMODE" 32)
      (princ "\nУстановлено новое отображения точек\n")
      (setvar "PDSIZE" pt_size)
      (princ "\nУстановлен новый размер отображения точек")
;;;**************************************************************** 
      (defun create-textstyle
			      (name	    font_filename
			       height	    width	 o_angle
			       /	    ent_list	 font_filename
			       exist_style
			      )
	(setq ent_list
	       (list
		 (cons 0 "STYLE")
		 (cons 100 "AcDbSymbolTableRecord")
		 (cons 100 "AcDbTextStyleTableRecord")
		 (cons 2 name)		; имя стиля
		 (cons 70 0)		;
		 (cons 40 height)	; высота
		 (cons 41 width)	; width factor
		 (cons 50 o_angle)	; oblique angle
		 (cons 71 0)		; not backwatf, not upside down
		 (cons 42 2.5)		; last height used
		 (cons 3 font_filename)	; primary font file name
		 (cons 4 "")		; big font file name
	       )
	)
	(entmake ent_list)
	(setvar "textstyle" name)
      )
;;;****************************************************************
      (create-textstyle "new_style" "Arial.ttf" 0 1 0)
      (princ "\nСоздан текстовый стиль new_style")

;;; 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)
      )
      (princ "\nВсе тексты со слоя DEFAULT перенесены на слой NAD_MDEFAULT")
;;; 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)
      )
      (princ
	"\nУдалены слои PI_DTDEFAULT, SETLN, STR_LDEFAULT со всеми примитивами"
      )
;;; 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))
      )
      (princ "\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)
	  )
	)
      )
      (princ "\nЗавершено задание цвета для всех объектов поСлою")
;;; 6.1 пункт - заморозка слоёв
      (setq freez_lay_lst
	     '("Растительность Контур"
	       "Рельеф Отметки номера"
	       "Рельеф Поверхность"
	       "Рельеф Контур рельеф"
	      )
      )
      (setq lay_fam (vla-get-Layers adoc))
      (foreach item freez_lay_lst
	(if (tblsearch "LAYER" item)
	  (vla-put-Freeze (vla-item lay_fam item) 1)
	)
      )
      (princ "\nПроизведена заморозка 4-х слоёв")
;;; 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)
      (princ "\nЗавершена конвертация полилиний из 3d в 2d")
;;; 8 пункт + п.9 - установка высоты текстов и присвоение стиля + вес линий
      (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)
	  )
	)
      )
      (princ "\nСозданы новые слои для блоков")
      (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))
	    )
	  )
	)
	(if (= (vla-get-ObjectName f_item) "AcDbText")
	  (progn
	    (vla-put-Height f_item txt_height)
	    (vla-put-StyleName f_item "new_style")
	    (vla-put-ObliqueAngle f_item o_angle)
	    (vla-put-ScaleFactor f_item width)
	  )
	)
	(if (= (vla-get-ObjectName f_item) "AcDbPolyline")
	  (if
	    (= (vla-get-Layer f_item) "Рельеф Горизонтали основные утолщенные")
	     (vla-put-ConstantWidth f_item lw)
	  )
	)
      )
      (princ "\nЗавершено расположение блоков на соответствующих слоях")
      (princ "\nТекстам присвоена новая высота, стиль new_style")
      (princ
	"\nПолилиниям на слое \"Рельеф Горизонтали основные утолщенные\" присоена глобальная ширина "
      )
      (princ lw)
;;; 1 пункт - лучше делать в конце
      (repeat 3 (vla-purgeall adoc))
      (princ "\nПроизведена очистка рисунка от неиспользуемых объектов")
    )
  )
  (vla-endundomark adoc)
  (princ "\nОбработка файла завершена")
  (princ)
)
Makswell вне форума  
 
Автор темы   Непрочитано 15.10.2008, 12:53
#67
Gotch


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


все работает!!!!
клева!!!!
спасибо Makswell!!!!!!
я могу как либо тебя отблагодарить?
Gotch вне форума  
 
Непрочитано 15.10.2008, 13:11
#68
Makswell

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


Конечно! С тебя 1000 баксов. Шутка...

Желаю удачи в дальнейшем.
Makswell вне форума  
 
Автор темы   Непрочитано 13.11.2008, 13:52
#69
Gotch


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


Цитата:
Сообщение от Makswell Посмотреть сообщение
Конечно! С тебя 1000 баксов. Шутка...

Желаю удачи в дальнейшем.
Makswell прости что снова беспкою но ту снова бывает возникает ошибка

Command: (test)
Масштаб съемки [500/1000/2000] <500>:
Regenerating model.

Установлено новое отображения точек
Regenerating model.

Установлен новый размер отображения точек
Создан текстовый стиль new_style
Все тексты со слоя DEFAULT перенесены на слой NAD_MDEFAULT
Удалены слои PI_DTDEFAULT, SETLN, STR_LDEFAULT со всеми примитивами
Завершено переименование слоёв и задание для них цвета
Завершено задание цвета для всех объектов поСлою; error: Automation Error. Key
not found


выходит на пункте
;;; 6.1 пункт - заморозка слоёв
происходит сбой

это происходит на файле который уже чем либо обрабатывался редактировался

Последний раз редактировалось Gotch, 13.11.2008 в 14:00.
Gotch вне форума  
 
Непрочитано 13.11.2008, 14:14
#70
Makswell

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


Приложи файл, где так происходит.
Makswell вне форума  
 
Автор темы   Непрочитано 13.11.2008, 14:19
#71
Gotch


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


Цитата:
Сообщение от Makswell Посмотреть сообщение
Приложи файл, где так происходит.
вот тут
Вложения
Тип файла: dwg
DWG 2004
Дюртюли нб план.dwg (1.44 Мб, 1142 просмотров)
Gotch вне форума  
 
Непрочитано 14.11.2008, 08:48
#72
Makswell

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


Не знаю...
У меня всё работает нормально.

Даже и не знаю, что предположить. Остаётся надеятся, что кто-нибудь из Уважаемых подключится и поможет...
Makswell вне форума  
 
Автор темы   Непрочитано 19.01.2010, 09:19
#73
Gotch


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


Код:
[Выделить все]
(defun test (/		   reply	 txt_height    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	   lw		 pt_size       flag
	     o_angle	   width
	    )
  (vl-load-com)
  (setq	width	1.
	o_angle	(/ pi 30.)
  )
  (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 "Горизонтали утолщенные" 30)
	   (cons "Горизонтали основные" 32)
	   (cons "Граница рельефа" 92)
	   (cons "Граница растительности" 100)
	   (cons "Подписи и выноски" 7)
	   (cons "Обрыв" 32)
	   (cons "Откос" 32)
	   (cons "Отметки номера" 1)
	   (cons "Отметки" 7)
	   (cons "Пикеты СТ" 7)
	   (cons "Пикеты" 7)
	   (cons "Координатная сетка" 84)
	   (cons "Здания и сооружения" 7)
	   (cons "Рельеф поверхность" 132)
	   (cons "Блоки Разные" 7)
	   (cons "Растительность" 100)
	 )
  )
  (vla-startundomark adoc)
;;; 9 пункт - начало
  (initget 6)
  (setq	reply (getint
		"Масштаб съемки [500/1000/2000] <500>: "
	      )
  )
  (if (not reply)
    (setq reply 500)
  )
  (cond	((= reply 500)
	 (progn (setq lw 0.25) (setq pt_size 0.3) (setq txt_height 1))
	)
	((= reply 1000)
	 (progn (setq lw 0.5) (setq pt_size 0.5) (setq txt_height 2))
	)
	((= reply 2000)
	 (progn (setq lw 1.) (setq pt_size 1.) (setq txt_height 4))
	)
	(t (setq flag t))
  )
  (if flag
    (progn
      (alert "Масштаб съемки выбран неверно")
    )
    (progn
      (setvar "PDMODE" 32)
      (princ "\nУстановлено новое отображения точек\n")
      (setvar "PDSIZE" pt_size)
      (princ "\nУстановлен новый размер отображения точек")
;;;**************************************************************** 
      (defun create-textstyle
			      (name	    font_filename
			       height	    width	 o_angle
			       /	    ent_list	 font_filename
			       exist_style
			      )
	(setq ent_list
	       (list
		 (cons 0 "STYLE")
		 (cons 100 "AcDbSymbolTableRecord")
		 (cons 100 "AcDbTextStyleTableRecord")
		 (cons 2 name)		; имя стиля
		 (cons 70 0)		;
		 (cons 40 height)	; высота
		 (cons 41 width)	; width factor
		 (cons 50 o_angle)	; oblique angle
		 (cons 71 0)		; not backwatf, not upside down
		 (cons 42 2.5)		; last height used
		 (cons 3 font_filename)	; primary font file name
		 (cons 4 "")		; big font file name
	       )
	)
	(entmake ent_list)
	(setvar "textstyle" name)
      )
;;;****************************************************************
      (create-textstyle "new_style" "Arial.ttf" 0 1 0)
      (princ "\nСоздан текстовый стиль new_style")

;;; 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)
      )
      (princ "\nВсе тексты со слоя DEFAULT перенесены на слой NAD_MDEFAULT")
;;; 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)
      )
      (princ
	"\nУдалены слои PI_DTDEFAULT, SETLN, STR_LDEFAULT со всеми примитивами"
      )
;;; 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))
      )
      (princ "\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)
	  )
	)
      )
      (princ "\nЗавершено задание цвета для всех объектов поСлою")
;;; 6.1 пункт - заморозка слоёв
      (setq freez_lay_lst
	     '("Граница растительности"
	       "Отметки номера"
	       "Рельеф поверхность"
	       "Граница рельефа"
	      )
      )
      (setq lay_fam (vla-get-Layers adoc))
      (foreach item freez_lay_lst
	(if (tblsearch "LAYER" item)
	  (vla-put-Freeze (vla-item lay_fam item) 1)
	)
      )
      (princ "\nПроизведена заморозка 4-х слоёв")
;;; 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)
      (princ "\nЗавершена конвертация полилиний из 3d в 2d")
;;; 8 пункт + п.9 - установка высоты текстов и присвоение стиля + вес линий
      (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)
	  )
	)
      )
      (princ "\nСозданы новые слои для блоков")
      (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))
	    )
	  )
	)
	(if (= (vla-get-ObjectName f_item) "AcDbText")
	  (progn
	    (vla-put-Height f_item txt_height)
	    (vla-put-StyleName f_item "new_style")
	    (vla-put-ObliqueAngle f_item o_angle)
	    (vla-put-ScaleFactor f_item width)
	  )
	)
	(if (= (vla-get-ObjectName f_item) "AcDbPolyline")
	  (if
	    (= (vla-get-Layer f_item) "Горизонтали утолщенные")
	     (vla-put-ConstantWidth f_item lw)
	  )
	)
      )
      (princ "\nЗавершено расположение блоков на соответствующих слоях")
      (princ "\nТекстам присвоена новая высота, стиль new_style")
      (princ
	"\nПолилиниям на слое \"Горизонтали утолщенные\" присоена глобальная ширина "
      )
      (princ lw)
;;; 1 пункт - лучше делать в конце
      (repeat 3 (vla-purgeall adoc))
      (princ "\nПроизведена очистка рисунка от неиспользуемых объектов")
    )
  )
  (vla-endundomark adoc)
  (princ "\nОбработка файла завершена")
  (princ)
)
для линий находящихся в этих слоях

(cons "Горизонтали утолщенные" 30)
(cons "Горизонтали основные" 32)
(cons "Граница рельефа" 92)
(cons "Граница растительности" 100)
(cons "Здания и сооружения" 7)

задать вес линий (неглобальный) 0.25

есть ли возможность в лиспе задать такую вещь
прикрепил файл
вдоль красной линии скажем трассы идут подписи
гл.х.хх
МН ххххх....
что бы с помощью лиспа была проведена выборка этих текстов из слоя
(cons "Подписи и выноски" 7)
скажем вдоль трассы вправо и влево от нее по на 0.3(по умлочанию) и была возможность задать расстояние вручную
и этот текст был закинут в слой этой коммуникации скажем Водопровод подземный для примера
такое возможно?
Вложения
Тип файла: dwg
DWG 2004
Оформление Дефектов.dwg (396.8 Кб, 1125 просмотров)

Последний раз редактировалось Gotch, 19.01.2010 в 10:08.
Gotch вне форума  
 
Непрочитано 19.01.2010, 10:41
#74
Makswell

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


Gotch, я так понял, файл "Оформление Дефектов.dwg" - это уже результат каких-то преобразований. Работаем именно с ним?
Просто нет там слоя "Горизонтали утолщенные" и т.д...
Makswell вне форума  
 
Автор темы   Непрочитано 19.01.2010, 12:46
#75
Gotch


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


Цитата:
Сообщение от Makswell Посмотреть сообщение
Gotch, я так понял, файл "Оформление Дефектов.dwg" - это уже результат каких-то преобразований. Работаем именно с ним?
Просто нет там слоя "Горизонтали утолщенные" и т.д...
нет просто что бы было с чем работать так для вида
на чем можно объяснить и показать

Последний раз редактировалось Gotch, 19.01.2010 в 12:52.
Gotch вне форума  
 
Непрочитано 19.01.2010, 15:46
#76
Makswell

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


С весом линий это имелось ввиду?
Код:
[Выделить все]
(defun test (/		   reply	 txt_height    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	   lw		 pt_size       flag
	     o_angle	   width
	    )
  (vl-load-com)
  (setq	width	1.
	o_angle	(/ pi 30.)
  )
  (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 "Горизонтали утолщенные" 30)
	   (cons "Горизонтали основные" 32)
	   (cons "Граница рельефа" 92)
	   (cons "Граница растительности" 100)
	   (cons "Подписи и выноски" 7)
	   (cons "Обрыв" 32)
	   (cons "Откос" 32)
	   (cons "Отметки номера" 1)
	   (cons "Отметки" 7)
	   (cons "Пикеты СТ" 7)
	   (cons "Пикеты" 7)
	   (cons "Координатная сетка" 84)
	   (cons "Здания и сооружения" 7)
	   (cons "Рельеф поверхность" 132)
	   (cons "Блоки Разные" 7)
	   (cons "Растительность" 100)
	 )
  )
  (vla-startundomark adoc)
;;; 9 пункт - начало
  (initget 6)
  (setq	reply (getint
		"Масштаб съемки [500/1000/2000] <500>: "
	      )
  )
  (if (not reply)
    (setq reply 500)
  )
  (cond	((= reply 500)
	 (progn (setq lw 0.25) (setq pt_size 0.3) (setq txt_height 1))
	)
	((= reply 1000)
	 (progn (setq lw 0.5) (setq pt_size 0.5) (setq txt_height 2))
	)
	((= reply 2000)
	 (progn (setq lw 1.) (setq pt_size 1.) (setq txt_height 4))
	)
	(t (setq flag t))
  )
  (if flag
    (progn
      (alert "Масштаб съемки выбран неверно")
    )
    (progn
      (setvar "PDMODE" 32)
      (princ "\nУстановлено новое отображения точек\n")
      (setvar "PDSIZE" pt_size)
      (princ "\nУстановлен новый размер отображения точек")
;;;**************************************************************** 
      (defun create-textstyle
			      (name	    font_filename
			       height	    width	 o_angle
			       /	    ent_list	 font_filename
			       exist_style
			      )
	(setq ent_list
	       (list
		 (cons 0 "STYLE")
		 (cons 100 "AcDbSymbolTableRecord")
		 (cons 100 "AcDbTextStyleTableRecord")
		 (cons 2 name)		; имя стиля
		 (cons 70 0)		;
		 (cons 40 height)	; высота
		 (cons 41 width)	; width factor
		 (cons 50 o_angle)	; oblique angle
		 (cons 71 0)		; not backwatf, not upside down
		 (cons 42 2.5)		; last height used
		 (cons 3 font_filename)	; primary font file name
		 (cons 4 "")		; big font file name
	       )
	)
	(entmake ent_list)
	(setvar "textstyle" name)
      )
;;;****************************************************************
      (create-textstyle "new_style" "Arial.ttf" 0 1 0)
      (princ "\nСоздан текстовый стиль new_style")

;;; 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)
      )
      (princ "\nВсе тексты со слоя DEFAULT перенесены на слой NAD_MDEFAULT")
;;; 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)
      )
      (princ
	"\nУдалены слои PI_DTDEFAULT, SETLN, STR_LDEFAULT со всеми примитивами"
      )
;;; 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))
      )
      (princ "\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)
	  )
	)
      )
      (princ "\nЗавершено задание цвета для всех объектов поСлою")
;;; 6.1 пункт - заморозка слоёв
      (setq freez_lay_lst
	     '("Граница растительности"
	       "Отметки номера"
	       "Рельеф поверхность"
	       "Граница рельефа"
	      )
      )
      (setq lay_fam (vla-get-Layers adoc))
      (foreach item freez_lay_lst
	(if (tblsearch "LAYER" item)
	  (vla-put-Freeze (vla-item lay_fam item) 1)
	)
      )
      (princ "\nПроизведена заморозка 4-х слоёв")
;;; 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)
      (princ "\nЗавершена конвертация полилиний из 3d в 2d")
;;; 8 пункт + п.9 - установка высоты текстов и присвоение стиля + вес линий
;;; +просьба из поста 73 (тема http://forum.dwg.ru/showthread.php?p=507135)
      (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 tmp_lst '("Горизонтали утолщенные"
		      "Горизонтали основные"
		      "Граница рельефа"
		      "Граница растительности"
		      "Здания и сооружения"
		     )
      )
      (princ "\nСозданы новые слои для блоков")
      (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))
	    )
	  )
	)
	(if (= (vla-get-ObjectName f_item) "AcDbText")
	  (progn
	    (vla-put-Height f_item txt_height)
	    (vla-put-StyleName f_item "new_style")
	    (vla-put-ObliqueAngle f_item o_angle)
	    (vla-put-ScaleFactor f_item width)
	  )
	)
	(if (= (vla-get-ObjectName f_item) "AcDbPolyline")
	  (if
	    (member (vla-get-Layer f_item) tmp_lst)
	     (vla-put-Lineweight f_item aclnWt025)
	  )

	)
      )
      (princ "\nЗавершено расположение блоков на соответствующих слоях")
      (princ "\nТекстам присвоена новая высота, стиль new_style")
;;;      (princ
;;;	"\nПолилиниям на слое \"Горизонтали утолщенные\" присоена глобальная ширина "
;;;      )
;;;      (princ lw)
;;; 1 пункт - лучше делать в конце
      (repeat 3 (vla-purgeall adoc))
      (princ "\nПроизведена очистка рисунка от неиспользуемых объектов")
    )
  )
  (vla-endundomark adoc)
  (princ "\nОбработка файла завершена")
  (princ)
)
Вложения
Тип файла: lsp tmp.lsp (13.7 Кб, 78 просмотров)
Makswell вне форума  
 
Автор темы   Непрочитано 20.01.2010, 07:23
#77
Gotch


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


Цитата:
Сообщение от Makswell Посмотреть сообщение
С весом линий это имелось ввиду?
извиняюсь неправильно до этого написал

не немного не так
что бы не для каждой линии а для слоёв
(cons "Горизонтали утолщенные" 30)
(cons "Горизонтали основные" 32)
(cons "Граница рельефа" 92)
(cons "Граница растительности" 100)
(cons "Здания и сооружения" 7)
был присвоен вес линии 0.25
как это делаем через список слоев и там назначаем слою вес

и после этого лиспа получаем что все отметки пропадают...
1 пред.rar - то что имеем вначале
2 пост.rar - после обработки лиспом
Вложения
Тип файла: rar 1 пред.rar (136.7 Кб, 71 просмотров)
Тип файла: rar 2 пост.rar (332.3 Кб, 84 просмотров)

Последний раз редактировалось Gotch, 20.01.2010 в 08:58.
Gotch вне форума  
 
Непрочитано 22.01.2010, 08:35
#78
Makswell

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


Так?
Вложения
Тип файла: lsp tmp01.lsp (14.0 Кб, 83 просмотров)
Makswell вне форума  
 
Автор темы   Непрочитано 23.01.2010, 07:55
#79
Gotch


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


да точно именно так
только глобальный вес для
(cons "Горизонтали утолщенные" 30)
отключить бы
Gotch вне форума  
 
Непрочитано 27.01.2010, 08:55
#80
Makswell

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


Убрал в коде строки про глобальный вес.

Насчёт этого:
Цитата:
Сообщение от Gotch Посмотреть сообщение
есть ли возможность в лиспе задать такую вещь
прикрепил файл
вдоль красной линии скажем трассы идут подписи
гл.х.хх
МН ххххх....
что бы с помощью лиспа была проведена выборка этих текстов из слоя
(cons "Подписи и выноски" 7)
скажем вдоль трассы вправо и влево от нее по на 0.3(по умлочанию) и была возможность задать расстояние вручную
и этот текст был закинут в слой этой коммуникации скажем Водопровод подземный для примера
такое возможно?
ИМХО нереально. Слишком много неопределённостей.
Все эти надписи находятся в слое "И Текст". И, кроме всего прочего, в этом же слое находятся и надписи координат. И вот например линия трассы "МН УБКУА ст.1220" вообще пересекает координатную надпись y=3830250. Как это отфильтровать? Я не знаю. Это только то, что видится в первом приближении, а ситуации могут быть разные, а программа должна быть универсальной и учитывать всё, что только можно и бла-бла-бла...
Короче, я это не могу. Sorry.
Вложения
Тип файла: lsp tmp02.lsp (14.0 Кб, 75 просмотров)
Makswell вне форума  
Ответ
Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > LISP > ЛИСП слои цвета преобразование

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

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


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