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

ЛИСП слои цвета преобразование · 02.10.2008, 12:48

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

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

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

возможно ли это все воплотить в лисп?
если возможно то помогите пожалуйста

Gotch · 10.10.2008, 07:47

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

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

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

Установлен новый размер отображения точек; error: no function definition:
M-CREATE-TEXTSTYLE

Makswell · 10.10.2008, 08:16

Вчера в 08:17 утра я обновил лисп из поста №41. Ты точно его запустил? Хотя из лога твоей ком. строки очевидно, что ты запускаешь какой-то предыдущий вариант.

Gotch · 11.10.2008, 19:01

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

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

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

Makswell · 13.10.2008, 09:18

Да, точно - так и есть.
Опять исправил код в посте №41.
Пробуй..

Gotch · 14.10.2008, 14:42

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

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

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

это выходит из за того что обрабатывали да?

Makswell · 14.10.2008, 15:29

Вот новая версия. А то что-то надоело всё время в к 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)
)

Gotch · 15.10.2008, 12:53

все работает!!!!
клева!!!!
спасибо Makswell!!!!!!
я могу как либо тебя отблагодарить?

Makswell · 15.10.2008, 13:11

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

Желаю удачи в дальнейшем.

Gotch · 13.11.2008, 13:52

Цитата:

Сообщение от 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 пункт - заморозка слоёв
происходит сбой

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

Makswell · 13.11.2008, 14:14

Приложи файл, где так происходит.

Gotch · 13.11.2008, 14:19

Цитата:

Сообщение от Makswell

Приложи файл, где так происходит.

вот тут

Makswell · 14.11.2008, 08:48

Не знаю...

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

Даже и не знаю, что предположить. Остаётся надеятся, что кто-нибудь из Уважаемых подключится и поможет...

Gotch · 19.01.2010, 09:19

Код:

[Выделить все]

(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(по умлочанию) и была возможность задать расстояние вручную
и этот текст был закинут в слой этой коммуникации скажем Водопровод подземный для примера
такое возможно?

Makswell · 19.01.2010, 10:41

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

Gotch · 19.01.2010, 12:46

Цитата:

Сообщение от Makswell

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

нет просто что бы было с чем работать так для вида
на чем можно объяснить и показать

Makswell · 19.01.2010, 15:46

С весом линий это имелось ввиду?

Код:

[Выделить все]

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

Gotch · 20.01.2010, 07:23

Цитата:

Сообщение от Makswell

С весом линий это имелось ввиду?

извиняюсь неправильно до этого написал

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

и после этого лиспа получаем что все отметки пропадают...
1 пред.rar - то что имеем вначале
2 пост.rar - после обработки лиспом

Makswell · 22.01.2010, 08:35

Так?

Gotch · 23.01.2010, 07:55

да точно именно так
только глобальный вес для
(cons "Горизонтали утолщенные" 30)
отключить бы

Makswell · 27.01.2010, 08:55

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

Насчёт этого:

Цитата:

Сообщение от Gotch

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

ИМХО нереально. Слишком много неопределённостей.
Все эти надписи находятся в слое "И Текст". И, кроме всего прочего, в этом же слое находятся и надписи координат. И вот например линия трассы "МН УБКУА ст.1220" вообще пересекает координатную надпись y=3830250. Как это отфильтровать? Я не знаю. Это только то, что видится в первом приближении, а ситуации могут быть разные, а программа должна быть универсальной и учитывать всё, что только можно и бла-бла-бла...
Короче, я это не могу. Sorry.

Похожие темы
Тема	Автор	Раздел	Ответов	Последнее сообщение
Нужен Лисп для перевода цвета объекта	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

02.10.2008, 12:48
ЛИСП слои цвета преобразование 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 здесь как я думаю оп названию блока можно расскидать по слоям я прикрепил файл в архиве как он именно выходит из кредо микса возможно ли это все воплотить в лисп? если возможно то помогите пожалуйста
Просмотров: 34990

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