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

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

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

Ответ
Поиск в этой теме
Непрочитано 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
здесь как я думаю оп названию блока можно расскидать по слоям


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


возможно ли это все воплотить в лисп?
если возможно то помогите пожалуйста
Просмотров: 34841
 
Автор темы   Непрочитано 27.01.2010, 17:41
#81
Gotch


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


Цитата:
Сообщение от Makswell Посмотреть сообщение
Убрал в коде строки про глобальный вес.

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

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

так сможешь?
Gotch вне форума  
 
Автор темы   Непрочитано 01.11.2010, 11:06 Makswell Доброго времени суток!
#82
Gotch


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


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

Код:
[Выделить все]
(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 "И1 Рельеф Горизонтали основные утолщенные" 32)
	   (cons "И1 Рельеф Горизонтали основные" 32)
	   (cons "И1 Рельеф Контур рельеф" 92)
	   (cons "И1 Растительность Контур" 172)
	   (cons "И1 Текст" 7)
	   (cons "И1 Рельеф Обрыв" 32)
	   (cons "И1 Рельеф Откос" 32)
	   (cons "И1 Рельеф Отметки номера" 1)
	   (cons "И1 Рельеф Отметки" 5)
	   (cons "И1 Рельеф Точки СТ" 6)
	   (cons "И1 Рельеф Точки" 5)
	   (cons "И1 Координатная сетка" 94)
	   (cons "И1 Линии Ситуации" 7)
	   (cons "И1 Рельеф Поверхность" 132)
	   (cons "И1 Блоки Разные" 7)
	   (cons "И1 Блоки Растительности" 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 .8))
	)
	((= reply 1000)
	 (progn (setq lw 0.5) (setq pt_size 0.5) (setq txt_height 1.6))
	)
	((= reply 2000)
	 (progn (setq lw 1.) (setq pt_size 1.) (setq txt_height 3.2))
	)
	(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
	     '("И1 Растительность Контур"
	       "И1 Рельеф Отметки номера"
	       "И1 Рельеф Поверхность"
	       "И1 Рельеф Контур рельеф"
	      )
      )
      (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 "И1 Блоки Колодцы" 7)
	       (cons "И1 Блоки Трасса" 5)
	       (cons "И1 Блоки Светофоры и указатели" 7)
	       (cons "И1 Блоки Объекты Пром и СХ" 7)
	       (cons "И1 Блоки Столбы и опоры" 7)
	       (cons "И1 Блоки Строения" 7)
	       (cons "И1 Блоки Растительности" 92)
	       (cons "И1 Блоки Переезды" 7)
	       (cons "И1 Блоки ГЕО пункты" 7)
	       (cons "И1 Блоки Гидрография" 7)
	       (cons "И1 Блоки Геология" 7)
	       (cons "И1 Блоки Аппликация" 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) "И1 Рельеф Горизонтали основные утолщенные")
	     (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)
)
1 Format -> Units
Length
Type = Decimal
Precision = 0.00
Angel
Type = Deg/Min/Sec
Precision = 0d00`00``
Insertion scale
Units to scale inserted content = Millimeters

2
встрой сюда пожалуйста сразу Plinegen = 1
для включения генерации линий

3
создание трех стилей для размеров
500
# Symbols
Arrow size = 1.00

# Text
Text style = new_style
Text height = 0.8
Text placement
Vertical = Above
Horizontal = Centered
Offset from dim line = 0.20
Text alignment = Aligned with dimension line

# Primary Units
Linear dimensions
Unit format = Decimal
Precision = 0.00
Measurement scale
Scale factor = 2
Angular dimensions
Units format = Degrees Minutes Seconds
Precision = 0d00`00``


1000
# Symbols
Arrow size = 2.00

# Text
Text style = new_style
Text height = 1.6
Text placement
Vertical = Above
Horizontal = Centered
Offset from dim line = 0.40
Text alignment = Aligned with dimension line

# Primary Units
Linear dimensions
Unit format = Decimal
Precision = 0.00
Measurement scale
Scale factor = 1
Angular dimensions
Units format = Degrees Minutes Seconds
Precision = 0d00`00``


2000
# Symbols
Arrow size = 4.00

# Text
Text style = new_style
Text height = 3.2
Text placement
Vertical = Above
Horizontal = Centered
Offset from dim line = 0.80
Text alignment = Aligned with dimension line

# Primary Units
Linear dimensions
Unit format = Decimal
Precision = 0.00
Measurement scale
Scale factor = 0.5
Angular dimensions
Units format = Degrees Minutes Seconds
Precision = 0d00`00``
Gotch вне форума  
 
Непрочитано 01.11.2010, 11:20
#83
Makswell

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


Учитывая, что обращение именно ко мне, видимо мне и отвечать первым.
Так вот, к сожалению сейчас у меня нет ни времени, ни возможностей. Помочь не смогу.

Но я точно знаю, что есть немало людей на форуме, которым это под силу. Тем более, что эти 3 вопроса никак не привязаны к коду, т.е. их можно сделать отдельно, даже не смотря на код и потом тупо вставить в начало. Надеюсь, они помогут. Как в старые добрые времена dwg.ru.
Удачи.
Makswell вне форума  
 
Непрочитано 01.11.2010, 13:07
#84
VVA

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


1.
Код:
[Выделить все]
(setvar "LUNITS" 2)
(setvar "LUPREC" 2)
(setvar "AUNITS" 1)
(setvar "AUPREC" 3)
(setvar "INSUNITS" 4)
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Автор темы   Непрочитано 01.11.2010, 14:03
#85
Gotch


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


Цитата:
Сообщение от VVA Посмотреть сообщение
1.
Код:
[Выделить все]
(setvar "LUNITS" 2)
(setvar "LUPREC" 2)
(setvar "AUNITS" 1)
(setvar "AUPREC" 3)
(setvar "INSUNITS" 4)
VVA а для второго пункта я так понимаю будет так -
(setvar "PLINEGEN" 1)
или 2
или я ошибаюсь?

Код:
[Выделить все]
(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 "И1 Рельеф Горизонтали основные утолщенные" 32)
	   (cons "И1 Рельеф Горизонтали основные" 32)
	   (cons "И1 Рельеф Контур рельеф" 92)
	   (cons "И1 Растительность Контур" 172)
	   (cons "И1 Текст" 7)
	   (cons "И1 Рельеф Обрыв" 32)
	   (cons "И1 Рельеф Откос" 32)
	   (cons "И1 Рельеф Отметки номера" 1)
	   (cons "И1 Рельеф Отметки" 5)
	   (cons "И1 Рельеф Точки СТ" 6)
	   (cons "И1 Рельеф Точки" 5)
	   (cons "И1 Координатная сетка" 94)
	   (cons "И1 Линии Ситуации" 7)
	   (cons "И1 Рельеф Поверхность" 132)
	   (cons "И1 Блоки Разные" 7)
	   (cons "И1 Блоки Растительности" 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 .8))
	)
	((= reply 1000)
	 (progn (setq lw 0.5) (setq pt_size 0.5) (setq txt_height 1.6))
	)
	((= reply 2000)
	 (progn (setq lw 1.) (setq pt_size 1.) (setq txt_height 3.2))
	)
	(t (setq flag t))
  )
  (if flag
    (progn
      (alert "Масштаб съемки выбран неверно")
    )
    (progn
      (setvar "PDMODE" 32)
      (princ "\nУстановлено новое отображения точек\n")
      (setvar "PDSIZE" pt_size)
      (princ "\nУстановлен новый размер отображения точек")
      (setvar "LUNITS" 2)
      (setvar "LUPREC" 2)
      (setvar "AUNITS" 1)
      (setvar "AUPREC" 3)
      (setvar "INSUNITS" 4)
      (princ "\nУстановлены новые единицы")
      (setvar "PLINEGEN" 1)
      (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
	     '("И1 Растительность Контур"
	       "И1 Рельеф Отметки номера"
	       "И1 Рельеф Поверхность"
	       "И1 Рельеф Контур рельеф"
	      )
      )
      (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 "И1 Блоки Колодцы" 7)
	       (cons "И1 Блоки Трасса" 5)
	       (cons "И1 Блоки Светофоры и указатели" 7)
	       (cons "И1 Блоки Объекты Пром и СХ" 7)
	       (cons "И1 Блоки Столбы и опоры" 7)
	       (cons "И1 Блоки Строения" 7)
	       (cons "И1 Блоки Растительности" 92)
	       (cons "И1 Блоки Переезды" 7)
	       (cons "И1 Блоки ГЕО пункты" 7)
	       (cons "И1 Блоки Гидрография" 7)
	       (cons "И1 Блоки Геология" 7)
	       (cons "И1 Блоки Аппликация" 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) "И1 Рельеф Горизонтали основные утолщенные")
	     (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)
)
я поставил в конце этого кода строчки и почему то лисп перестал работать
их куда то в другое место надо ставить?

убрал
но все равно лисп почему то неработает вот что пишет
Command: (test) ; error: no function definition: TEST

перезагрузил лисп
Command: _appload test.LSP successfully loaded.


Command: ; error: misplaced dot on input

Command:
Command: (test) ; error: no function definition: TEST

Последний раз редактировалось Gotch, 01.11.2010 в 14:15.
Gotch вне форума  
 
Непрочитано 01.11.2010, 14:56
#86
VVA

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


Цитата:
Сообщение от Gotch Посмотреть сообщение
VVA а для второго пункта я так понимаю будет так -
(setvar "PLINEGEN" 1)

Цитата:
Сообщение от Gotch Посмотреть сообщение
Command: ; error: misplaced dot on input
Перевод-> ошибка: неверно расположенная точка на входе
Найди строчку (setq txt_height .8) замени на
(setq txt_height 0.8)
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Автор темы   Непрочитано 01.11.2010, 15:32
#87
Gotch


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


Цитата:
Сообщение от VVA Посмотреть сообщение
Перевод-> ошибка: неверно расположенная точка на входе
Найди строчку (setq txt_height .8) замени на
(setq txt_height 0.8)
спасибо VVA
а с 3им пунктом поможешь?
Gotch вне форума  
 
Автор темы   Непрочитано 13.11.2010, 12:45
#88
Gotch


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


Цитата:
Сообщение от VVA Посмотреть сообщение
Цитата:
Цитата:
Сообщение от Gotch Посмотреть сообщение
Сообщение от Gotch
VVA а для второго пункта я так понимаю будет так -
(setvar "PLINEGEN" 1)
раз PLINEGEN задается так (setvar "PLINEGEN" 1) то

у меня есть макрос но не совсем корректный
он меняет в стиле Стандард настройки на нужные мне
а хотелось бы что бы были созданы три новых размерных стиля
^C^C_-dimstyle;R;Standard;dimtxsty;new_style;dimasz;1;dimtxt;1;dimtih;Off;dimtad;1;dimgap;0.2;DIMDEC;2;DIMAUNIT;1;DIMADEC;3;

как задать создать новый размерный стиль?
(setvar "-DIMSTYLE" AN No 500)
(setvar "DIMTXSTY" new_style)
(setvar "DIMASZ" 1)
(setvar "DIMTXT" 1)
(setvar "DIMTIH" Off)
(setvar "DIMTAD" 1)
(setvar "DIMGAP" 0.2)
(setvar "DIMDEC" 2)
(setvar "DIMAUNIT" 1)
(setvar "DIMADEC" 3)

думал что так но неработает

и хотел попросить помочь с сбросом масштабов
_-scalelistedit
Enter option [?/Add/Delete/Reset/Exit] <Add>: R
Reset scale list to defaults? [Yes/No] <No>: y
Scale list reset to default entries.
Enter option [?/Add/Delete/Reset/Exit] <Add>: E

чем тут пользоваться что бы заработало в смысле какими функциями?

Последний раз редактировалось Gotch, 16.03.2011 в 07:57.
Gotch вне форума  
 
Непрочитано 16.03.2011, 11:33
#89
VVA

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


Цитата:
Сообщение от Gotch Посмотреть сообщение
а хотелось бы что бы были созданы три новых размерных стиля
Создание размерного стиля
Программное создание размерных стилей

Цитата:
Сообщение от Gotch Посмотреть сообщение
и хотел попросить помочь с сбросом масштабов
Не выполняется копирование объектов между файлами через буфер обмена
Еще посмотри ссылку в конце варианта №1:
Цитата:
Дополнительный программный вариант решения проблемы, без применения командных методов ...
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Автор темы   Непрочитано 14.06.2011, 09:33
#90
Gotch


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



VVA хотел спросить по поводу сброса масштабов
Код:
[Выделить все]
(vl-load-com)
(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 "И1 Рельеф Горизонтали основные утолщенные" 32)
	   (cons "И1 Рельеф Горизонтали основные" 32)
	   (cons "И1 Рельеф Контур рельеф" 92)
	   (cons "И1 Растительность Контур" 172)
	   (cons "И1 Текст" 7)
	   (cons "И1 Рельеф Обрыв" 32)
	   (cons "И1 Рельеф Откос" 32)
	   (cons "И1 Рельеф Отметки номера" 1)
	   (cons "И1 Рельеф Отметки" 5)
	   (cons "И1 Рельеф Точки СТ" 6)
	   (cons "И1 Рельеф Точки" 5)
	   (cons "И1 Координатная сетка" 94)
	   (cons "И1 Линии Ситуации" 7)
	   (cons "И1 Рельеф Поверхность" 132)
	   (cons "И1 Блоки Разные" 7)
	   (cons "И1 Блоки Растительности" 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 0.8))
	)
	((= reply 1000)
	 (progn (setq lw 0.5) (setq pt_size 0.5) (setq txt_height 1.6))
	)
	((= reply 2000)
	 (progn (setq lw 1.) (setq pt_size 1.) (setq txt_height 3.2))
	)
	(t (setq flag t))
  )
  (if flag
    (progn
      (alert "Масштаб съемки выбран неверно")
    )
    (progn
      (setvar "PDMODE" 32)
      (princ "\nУстановлено новое отображения точек\n")
      (setvar "PDSIZE" pt_size)
      (princ "\nУстановлен новый размер отображения точек")
      (setvar "LUNITS" 2)
      (setvar "LUPREC" 2)
      (setvar "AUNITS" 0)
      (setvar "AUPREC" 2)
      (setvar "INSUNITS" 4)
      (princ "\nУстановлены новые единицы")
      (setvar "PLINEGEN" 1)
      (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
	     '("И1 Растительность Контур"
	       "И1 Рельеф Отметки номера"
	       "И1 Рельеф Поверхность"
	       "И1 Рельеф Контур рельеф"
	      )
      )
      (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 . "И1 Рельеф Горизонтали*")))
	  )
	   (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 "И1 Блоки Колодцы" 7)
	       (cons "И1 Блоки Трасса" 5)
	       (cons "И1 Блоки Светофоры и указатели" 7)
	       (cons "И1 Блоки Объекты Пром и СХ" 7)
	       (cons "И1 Блоки Столбы и опоры" 7)
	       (cons "И1 Блоки Строения" 7)
	       (cons "И1 Блоки Растительности" 92)
	       (cons "И1 Блоки Переезды" 7)
	       (cons "И1 Блоки ГЕО пункты" 7)
	       (cons "И1 Блоки Гидрография" 7)
	       (cons "И1 Блоки Геология" 7)
	       (cons "И1 Блоки Аппликация" 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) "И1 Рельеф Горизонтали основные утолщенные")
	     (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)
)

;;;======================================================
;;; СПИСОК МАСШТАБОВ SCALELIST SCALE
;;;======================================================

(vl-catch-all-apply
  '(lambda ()
     ((lambda (lst / dict dn)
;;; Purge excess scales
;;; gile
;;; http://www.theswamp.org/index.php?topic=29663.0 
;;;lst - шаблон маштабов состоит из списков вида
;;;  (("имя в списке масштабов1" "Масштаб единицы листа1" "Масштаб единицы чертежа1")
;;;   ("имя в списке масштабов2" "Масштаб единицы листа2" "Масштаб единицы чертежа2")
;;;   ...
;;;   )
;;; lst - the pattern scale is made up of lists of species 
;;; (("Name of the Scale 1" Scale_paper_unit_1 Scale_drawing_unit_1) 
;;; ("Name of the Scale 2"  Scale_paper_unit_2 Scale_drawing_unit_2) 
;;; ... 
;;;)
;;; Usage (SetScale)
;;;  (setq pat '(("1:1" 1 1)("1:2" 1 2)("1:10" 1 10) ;_Correct scale here
;;;	      ("1:50" 1 50)("1:100" 1 100)("2:1" 2 1)
;;;	      ))
	(setq dn "A")
        (if (setq dict (dictsearch (namedobjdict) "ACAD_SCALELIST"))
          (progn
            (entmod (vl-remove-if
                      '(lambda (x) (or (= (car x) 3) (= (car x) 350)))
                      dict
                    ) ;_ end of vl-remove-if
            ) ;_ end of entmod
            (setq dict (cdr (assoc -1 dict))
                  n    -1
            ) ;_ end of setq
            (foreach s lst
              (dictadd dict
		       (progn
			 (if (= n 9)
			 (setq dn (chr(1+ (ascii dn)))
			       n -1
			       )
			 )
			 (terpri)
			 (princ
			   (strcat dn (itoa (setq n (1+ n))))
			   )
			 )
                       (entmakex
                         (list
                           '(0 . "SCALE")
                           '(100 . "AcDbScale")
                           (cons 300 (car s))
                           (cons 140 (cadr s))
                           (cons 141 (caddr s))
                         ) ;_ end of list
                       ) ;_ end of entmakex
              ) ;_ end of dictadd
            ) ;_ end of foreach
          ) ;_ end of progn
        ) ;_ end of if
      )
       '(("1000 (1:1)" 1 1)
	 ("2000 (1:2)" 1 2)
	 ("10 000 (1:10)" 1 10)
	 ("50 000 (1:50)" 1 50)
	 ("100 000 (1:100)" 1 100)
	 ("200 000 (1:200)" 1 200)
	 ("500 (2:1)" 2 1)
	)
     )
   )
)
добавил в конце сброс масштабов

а в итоге при вызове списка масштабов в акаде
меня выбивает из акада с фатальной ошибкой
Gotch вне форума  
 
Непрочитано 14.06.2011, 11:32
#91
VVA

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


Вариант без командных методов нужно использовать осторожно. Он сносит все без учета, есть аннотативные объекты или нет. Я его использую только на новых чертежах.
В любом случае нужна версия Автокада, наличие серсивпаков, можно файлик приложить.
Судя по именам слоев и блоков, ты получаешь dxf из Credo. Это так же может добавить нюансы.
Попробуй по ссылке средний вариант. Там используются команды.
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Автор темы   Непрочитано 14.06.2011, 12:40
#92
Gotch


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


Цитата:
Сообщение от VVA Посмотреть сообщение
Вариант без командных методов нужно использовать осторожно. Он сносит все без учета, есть аннотативные объекты или нет. Я его использую только на новых чертежах.
В любом случае нужна версия Автокада, наличие серсивпаков, можно файлик приложить.
Судя по именам слоев и блоков, ты получаешь dxf из Credo. Это так же может добавить нюансы.
Попробуй по ссылке средний вариант. Там используются команды.
попробовал второй вариант что то тоже не помог
масштабы в списке масштабов не очистились и не появились

я правильно понимаю что я просто этот лисп вставляю в конце того длинного лиспа и все?
Gotch вне форума  
 
Непрочитано 14.06.2011, 17:04
#93
VVA

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


Цитата:
Сообщение от Gotch Посмотреть сообщение
я правильно понимаю что я просто этот лисп вставляю в конце того длинного лиспа и все?
Нет Нужно добавить в самом низу еще одну строчку:
Код:
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Автор темы   Непрочитано 23.06.2011, 14:47
#94
Gotch


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


не что то все равно не работает
Gotch вне форума  
 
Непрочитано 23.06.2011, 23:42
#95
VVA

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


я сейчас в отпуске, подними эту тему после 4 июля, разберемся
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Автор темы   Непрочитано 08.11.2011, 08:00
#96
Gotch


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


Цитата:
Сообщение от VVA Посмотреть сообщение
я сейчас в отпуске, подними эту тему после 4 июля, разберемся

лисп такой
Код:
[Выделить все]
(vl-load-com)
(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 "И1 Рельеф Горизонтали основные утолщенные" 32)
	   (cons "И1 Рельеф Горизонтали основные" 32)
	   (cons "И1 Рельеф Контур рельеф" 92)
	   (cons "И1 Растительность Контур" 172)
	   (cons "И1 Текст" 7)
	   (cons "И1 Рельеф Обрыв" 32)
	   (cons "И1 Рельеф Откос" 32)
	   (cons "И1 Рельеф Отметки номера" 1)
	   (cons "И1 Рельеф Отметки" 5)
	   (cons "И1 Рельеф Точки СТ" 6)
	   (cons "И1 Рельеф Точки" 5)
	   (cons "И1 Координатная сетка" 94)
	   (cons "И1 Линии Ситуации" 7)
	   (cons "И1 Рельеф Поверхность" 132)
	   (cons "И1 Блоки Разные" 7)
	   (cons "И1 Блоки Растительности" 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 0.8))
	)
	((= reply 1000)
	 (progn (setq lw 0.5) (setq pt_size 0.5) (setq txt_height 1.6))
	)
	((= reply 2000)
	 (progn (setq lw 1.) (setq pt_size 1.) (setq txt_height 3.2))
	)
	(t (setq flag t))
  )
  (if flag
    (progn
      (alert "Масштаб съемки выбран неверно")
    )
    (progn
      (setvar "PDMODE" 32)
      (princ "\nУстановлено новое отображения точек\n")
      (setvar "PDSIZE" pt_size)
      (princ "\nУстановлен новый размер отображения точек")
      (setvar "LUNITS" 2)
      (setvar "LUPREC" 2)
      (setvar "AUNITS" 0)
      (setvar "AUPREC" 2)
      (setvar "INSUNITS" 4)
      (princ "\nУстановлены новые единицы")
      (setvar "PLINEGEN" 1)
      (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
	     '("И1 Растительность Контур"
	       "И1 Рельеф Отметки номера"
	       "И1 Рельеф Поверхность"
	       "И1 Рельеф Контур рельеф"
	      )
      )
      (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 . "И1 Рельеф Горизонтали*")))
	  )
	   (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 "И1 Блоки Колодцы" 7)
	       (cons "И1 Блоки Трасса" 5)
	       (cons "И1 Блоки Светофоры и указатели" 7)
	       (cons "И1 Блоки Объекты Пром и СХ" 7)
	       (cons "И1 Блоки Столбы и опоры" 7)
	       (cons "И1 Блоки Строения" 7)
	       (cons "И1 Блоки Растительности" 92)
	       (cons "И1 Блоки Переезды" 7)
	       (cons "И1 Блоки ГЕО пункты" 7)
	       (cons "И1 Блоки Гидрография" 7)
	       (cons "И1 Блоки Геология" 7)
	       (cons "И1 Блоки Аппликация" 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) "И1 Рельеф Горизонтали основные утолщенные")
	     (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)
)

(defun SetScale( / lst pat tmp)
;;; pat - шаблон маштабов состоит из списков вида
;;;  (("имя в списке масштабов1" Масштаб_единицы_листа1 Масштаб_единицы_чертежа1)
;;;   ("имя в списке масштабов2"  Масштаб_единицы_листа2 Масштаб_единицы_чертежа2)
;;;   ...
;;;   )
  (setq pat '(("1000 (1:1)" 1 1)("2000 (1:2)" 1 2)("10 000 (1:10)" 1 10)
	      ("50 000 (1:50)" 1 50)("100 000 (1:100)" 1 100)("200 000 (1:200)" 1 200)
	      ("500 (2:1)" 2 1)))
  ;;;Удаляем не входящие в шаблон масштаб
  (setq tmp (mapcar 'car pat))
(if (GETCNAME "_SCALELISTEDIT")
  (progn
    (COMMAND "_-SCALELISTEDIT" "_R" "_Y" "_E")
    (setq lst nil)
    (foreach item (dictsearch (namedobjdict) "ACAD_SCALELIST")
      (if (= 350 (car item))
     (setq lst (cons (cdr(assoc 300 (entget(cdr item)))) lst))
    ) ;_ end of if
  )
  (while (> (getvar "CMDACTIVE") 0) (command))
    (command "_.-SCALELISTEDIT")
  (foreach item lst
    (command "_D" item)
    )
    (command "_E")
   (setq lst nil) 
  ;;;Список оставшихся масштабов
   (foreach item (dictsearch (namedobjdict) "ACAD_SCALELIST")
    (if	(= 350 (car item))
      (setq lst (cons (cdr(assoc 300 (entget (cdr item)))) lst))
    ) ;_ end of if
  ) ;_ end of foreach
)
  )
    
  ;;;Список не созданных масштабов из шаблона pat
   (if (and lst (setq pat (vl-remove-if '(lambda(x)(member (car x) lst)) pat)))
     (progn
       (while (> (getvar "CMDACTIVE") 0)(command))
       (command "_.-scalelistedit")
       (foreach item pat
	 (command "_Add" (car item) (strcat (rtos (cadr item)) ":" (rtos (caddr item))))
	 ) ;_ end of foreach
       (command "_Exit")
       (while (> (getvar "CMDACTIVE") 0)(command))
       )
     )
  (princ)
   )
(defun C:SetScale ()(SetScale))
(SetScale)
если возможно сделать такое -
если DEFAULT
Код:
[Выделить все]
	 '("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"
То
Код:
[Выделить все]
	   (cons "И1 Рельеф Горизонтали основные утолщенные" 32)
	   (cons "И1 Рельеф Горизонтали основные" 32)
	   (cons "И1 Рельеф Контур рельеф" 92)
	   (cons "И1 Растительность Контур" 172)
	   (cons "И1 Текст" 7)
	   (cons "И1 Рельеф Обрыв" 32)
	   (cons "И1 Рельеф Откос" 32)
	   (cons "И1 Рельеф Отметки номера" 1)
	   (cons "И1 Рельеф Отметки" 5)
	   (cons "И1 Рельеф Точки СТ" 6)
	   (cons "И1 Рельеф Точки" 5)
	   (cons "И1 Координатная сетка" 94)
	   (cons "И1 Линии Ситуации" 7)
	   (cons "И1 Рельеф Поверхность" 132)
	   (cons "И1 Блоки Разные" 7)
	   (cons "И1 Блоки Растительности" 92)
как оно на данный момент и есть
Иначе (заместо слова "DEFAULT" может быть любое другое слово или число)
Код:
[Выделить все]
	   (cons "И1 Рельеф Горизонтали основные утолщенные" 32)
	   (cons "И1 Рельеф Горизонтали основные" 32)
	   (cons "И1 Рельеф Контур рельеф" 92)
	   (cons "И1 Растительность Контур" 172)
	   (cons "И1 Текст" 7)
	   (cons "И1 Рельеф Обрыв" 32)
	   (cons "И1 Рельеф Откос" 32)
	   (cons "И1 Рельеф Отметки номера" 1)
	   (cons "И1 Рельеф Отметки" 5)
	   (cons "И1 Рельеф Точки СТ" 6)
	   (cons "И1 Рельеф Точки" 5)
	   (cons "И1 Координатная сетка" 94)
	   (cons "И1 Линии Ситуации" 7)
	   (cons "И1 Рельеф Поверхность" 132)
	   (cons "И1 Блоки Разные" 7)
	   (cons "И1 Блоки Растительности" 92)
в конце каждого слоя та часть которая заместо DEFAULT
иногда просто в этом есть нужда
если не сильно затруднит помогите

сегодня при открытии файла сработала вот такая вещь
именно просто при открытии, без запуска лиспа
Код:
[Выделить все]
AutoCAD menu utilities loaded._-SCALELISTEDIT Enter option 
[?/Add/Delete/Reset/Exit] <Add>: _R Reset scale list to defaults? [Yes/No] 
<No>: _Y Scale list reset to default entries.
Enter option [?/Add/Delete/Reset/Exit] <Add>: _E _.-SCALELISTEDIT Enter option 
[?/Add/Delete/Reset/Exit] <Add>: _D Enter scale name to delete or * to delete 
all unused scales: 1'-0" = 1'-0" 1'-0" = 1'-0" scale deleted.
Enter option [?/Add/Delete/Reset/Exit] <Add>: _D Enter scale name to delete or 
* to delete all unused scales: 6" = 1'-0" 6" = 1'-0" scale deleted.
Enter option [?/Add/Delete/Reset/Exit] <Add>: _D Enter scale name to delete or 
* to delete all unused scales: 3" = 1'-0" 3" = 1'-0" scale deleted.
Enter option [?/Add/Delete/Reset/Exit] <Add>: _D Enter scale name to delete or 
* to delete all unused scales: 1-1/2" = 1'-0" 1-1/2" = 1'-0" scale deleted.
Enter option [?/Add/Delete/Reset/Exit] <Add>: _D Enter scale name to delete or 
* to delete all unused scales: 1" = 1'-0" 1" = 1'-0" scale deleted.
Enter option [?/Add/Delete/Reset/Exit] <Add>: _D Enter scale name to delete or 
* to delete all unused scales: 3/4" = 1'-0" 3/4" = 1'-0" scale deleted.
Enter option [?/Add/Delete/Reset/Exit] <Add>: _D Enter scale name to delete or 
* to delete all unused scales: 1/2" = 1'-0" 1/2" = 1'-0" scale deleted.
Enter option [?/Add/Delete/Reset/Exit] <Add>: _D Enter scale name to delete or 
* to delete all unused scales: 3/8" = 1'-0" 3/8" = 1'-0" scale deleted.
Enter option [?/Add/Delete/Reset/Exit] <Add>: _D Enter scale name to delete or 
* to delete all unused scales: 1/4" = 1'-0" 1/4" = 1'-0" scale deleted.
Enter option [?/Add/Delete/Reset/Exit] <Add>: _D Enter scale name to delete or 
* to delete all unused scales: 3/16" = 1'-0" 3/16" = 1'-0" scale deleted.
Enter option [?/Add/Delete/Reset/Exit] <Add>: _D Enter scale name to delete or 
* to delete all unused scales: 1/8" = 1'-0" 1/8" = 1'-0" scale deleted.
Enter option [?/Add/Delete/Reset/Exit] <Add>: _D Enter scale name to delete or 
* to delete all unused scales: 3/32" = 1'-0" 3/32" = 1'-0" scale deleted.
Enter option [?/Add/Delete/Reset/Exit] <Add>: _D Enter scale name to delete or 
* to delete all unused scales: 1/16" = 1'-0" 1/16" = 1'-0" scale deleted.
Enter option [?/Add/Delete/Reset/Exit] <Add>: _D Enter scale name to delete or 
* to delete all unused scales: 1/32" = 1'-0" 1/32" = 1'-0" scale deleted.
Enter option [?/Add/Delete/Reset/Exit] <Add>: _D Enter scale name to delete or 
* to delete all unused scales: 1/64" = 1'-0" 1/64" = 1'-0" scale deleted.
Enter option [?/Add/Delete/Reset/Exit] <Add>: _D Enter scale name to delete or 
* to delete all unused scales: 1/128" = 1'-0" 1/128" = 1'-0" scale deleted.
Enter option [?/Add/Delete/Reset/Exit] <Add>: _D Enter scale name to delete or 
* to delete all unused scales: 1:1 Scale list must contain at least one scale. 
1:1 not deleted.
Enter option [?/Add/Delete/Reset/Exit] <Add>: _E _.-scalelistedit Enter option 
[?/Add/Delete/Reset/Exit] <Add>: _Add Enter name for new scale: 1000 (1:1) 
Enter scale ratio: 1.0000:1.0000 Enter option [?/Add/Delete/Reset/Exit] <Add>: 
_Add Enter name for new scale: 2000 (1:2) Enter scale ratio: 1.0000:2.0000 
Enter option [?/Add/Delete/Reset/Exit] <Add>: _Add Enter name for new scale: 10 
000 (1:10) Enter scale ratio: 1.0000:10.0000 Enter option 
[?/Add/Delete/Reset/Exit] <Add>: _Add Enter name for new scale: 50 000 (1:50) 
Enter scale ratio: 1.0000:50.0000 Enter option [?/Add/Delete/Reset/Exit] <Add>: 
_Add Enter name for new scale: 100 000 (1:100) Enter scale ratio: 
1.0000:100.0000 Enter option [?/Add/Delete/Reset/Exit] <Add>: _Add Enter name 
for new scale: 200 000 (1:200) Enter scale ratio: 1.0000:200.0000 Enter option 
[?/Add/Delete/Reset/Exit] <Add>: _Add Enter name for new scale: 500 (2:1) Enter 
scale ratio: 2.0000:1.0000 Enter option [?/Add/Delete/Reset/Exit] <Add>: _Exit 
*Cancel*

Command:
и масштабы стали как надо
но когда просто запускаю лисп масштабы не меняются
Gotch вне форума  
 
Непрочитано 08.11.2011, 09:46
#97
VVA

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


Цитата:
Сообщение от Gotch Посмотреть сообщение
сегодня при открытии файла сработала вот такая вещь
Это сработала функция SETSCALE в твоем лиспе.

Цитата:
Сообщение от Gotch Посмотреть сообщение
именно просто при открытии, без запуска лиспа
Правильно, так как вызов функции идет самой последней сточкой, загружая свой лисп последней строкой запускаешь функцию (setscale) на выполнение.

Цитата:
Сообщение от Gotch Посмотреть сообщение
но когда просто запускаю лисп масштабы не меняются
И не будут. Так как надо перенести строчку (setscale) из конца файла в тело твоей функции test
Код:
[Выделить все]
(vl-load-com)
(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)))
 ...
 ...
 ...

;;; 1 пункт - лучше делать в конце
      (repeat 3 (vla-purgeall adoc))
      (princ "\nПроизведена очистка рисунка от неиспользуемых объектов")
    )
  )
(SetScale) ;_перенеси, например, сюда
  (vla-endundomark adoc)
  (princ "\nОбработка файла завершена")
  (princ)
)
Про DEFAULT ничего не понял
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Автор темы   Непрочитано 08.11.2011, 10:22
#98
Gotch


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


Цитата:
Сообщение от VVA Посмотреть сообщение
Правильно, так как вызов функции идет самой последней сточкой, загружая свой лисп последней строкой запускаешь функцию (setscale) на выполнение.

И не будут. Так как надо перенести строчку (setscale) из конца файла в тело твоей функции test
Код:
[Выделить все]
(vl-load-com)
(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)))
 ...
 ...
 ...

;;; 1 пункт - лучше делать в конце
      (repeat 3 (vla-purgeall adoc))
      (princ "\nПроизведена очистка рисунка от неиспользуемых объектов")
    )
  )
(SetScale) ;_перенеси, например, сюда
  (vla-endundomark adoc)
  (princ "\nОбработка файла завершена")
  (princ)
)
Про DEFAULT ничего не понял
сделал как ты описал но масштабы все равно не срабатывают
Код:
[Выделить все]
(vl-load-com)
(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 "И1 Рельеф Горизонтали основные утолщенные" 32)
	   (cons "И1 Рельеф Горизонтали основные" 32)
	   (cons "И1 Рельеф Контур рельеф" 92)
	   (cons "И1 Растительность Контур" 172)
	   (cons "И1 Текст" 7)
	   (cons "И1 Рельеф Обрыв" 32)
	   (cons "И1 Рельеф Откос" 32)
	   (cons "И1 Рельеф Отметки номера" 1)
	   (cons "И1 Рельеф Отметки" 5)
	   (cons "И1 Рельеф Точки СТ" 6)
	   (cons "И1 Рельеф Точки" 5)
	   (cons "И1 Координатная сетка" 94)
	   (cons "И1 Линии Ситуации" 7)
	   (cons "И1 Рельеф Поверхность" 132)
	   (cons "И1 Блоки Разные" 7)
	   (cons "И1 Блоки Растительности" 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 0.8))
	)
	((= reply 1000)
	 (progn (setq lw 0.5) (setq pt_size 0.5) (setq txt_height 1.6))
	)
	((= reply 2000)
	 (progn (setq lw 1.) (setq pt_size 1.) (setq txt_height 3.2))
	)
	(t (setq flag t))
  )
  (if flag
    (progn
      (alert "Масштаб съемки выбран неверно")
    )
    (progn
      (setvar "PDMODE" 32)
      (princ "\nУстановлено новое отображения точек\n")
      (setvar "PDSIZE" pt_size)
      (princ "\nУстановлен новый размер отображения точек")
      (setvar "LUNITS" 2)
      (setvar "LUPREC" 2)
      (setvar "AUNITS" 0)
      (setvar "AUPREC" 2)
      (setvar "INSUNITS" 4)
      (princ "\nУстановлены новые единицы")
      (setvar "PLINEGEN" 1)
      (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
	     '("И1 Растительность Контур"
	       "И1 Рельеф Отметки номера"
	       "И1 Рельеф Поверхность"
	       "И1 Рельеф Контур рельеф"
	      )
      )
      (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 . "И1 Рельеф Горизонтали*")))
	  )
	   (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 "И1 Блоки Колодцы" 7)
	       (cons "И1 Блоки Трасса" 5)
	       (cons "И1 Блоки Светофоры и указатели" 7)
	       (cons "И1 Блоки Объекты Пром и СХ" 7)
	       (cons "И1 Блоки Столбы и опоры" 7)
	       (cons "И1 Блоки Строения" 7)
	       (cons "И1 Блоки Растительности" 92)
	       (cons "И1 Блоки Переезды" 7)
	       (cons "И1 Блоки ГЕО пункты" 7)
	       (cons "И1 Блоки Гидрография" 7)
	       (cons "И1 Блоки Геология" 7)
	       (cons "И1 Блоки Аппликация" 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) "И1 Рельеф Горизонтали основные утолщенные")
	     (vla-put-ConstantWidth f_item lw)
	  )
	)
      )
      (princ "\nЗавершено расположение блоков на соответствующих слоях")
      (princ "\nТекстам присвоена новая высота, стиль new_style")
      (princ
	"\nПолилиниям на слое \"Рельеф Горизонтали основные утолщенные\" присоена глобальная ширина "
      )
      (princ lw)
;;; 1 пункт - лучше делать в конце
      (repeat 3 (vla-purgeall adoc))
      (princ "\nПроизведена очистка рисунка от неиспользуемых объектов")
    )
  )
(SetScale) ;
  (vla-endundomark adoc)
  (princ "\nОбработка файла завершена")
  (princ)
)

(defun SetScale( / lst pat tmp)
;;; pat - шаблон маштабов состоит из списков вида
;;;  (("имя в списке масштабов1" Масштаб_единицы_листа1 Масштаб_единицы_чертежа1)
;;;   ("имя в списке масштабов2"  Масштаб_единицы_листа2 Масштаб_единицы_чертежа2)
;;;   ...
;;;   )
  (setq pat '(("1000 (1:1)" 1 1)("2000 (1:2)" 1 2)("10 000 (1:10)" 1 10)
	      ("50 000 (1:50)" 1 50)("100 000 (1:100)" 1 100)("200 000 (1:200)" 1 200)
	      ("500 (2:1)" 2 1)))
  ;;;Удаляем не входящие в шаблон масштаб
  (setq tmp (mapcar 'car pat))
(if (GETCNAME "_SCALELISTEDIT")
  (progn
    (COMMAND "_-SCALELISTEDIT" "_R" "_Y" "_E")
    (setq lst nil)
    (foreach item (dictsearch (namedobjdict) "ACAD_SCALELIST")
      (if (= 350 (car item))
     (setq lst (cons (cdr(assoc 300 (entget(cdr item)))) lst))
    ) ;_ end of if
  )
  (while (> (getvar "CMDACTIVE") 0) (command))
    (command "_.-SCALELISTEDIT")
  (foreach item lst
    (command "_D" item)
    )
    (command "_E")
   (setq lst nil) 
  ;;;Список оставшихся масштабов
   (foreach item (dictsearch (namedobjdict) "ACAD_SCALELIST")
    (if	(= 350 (car item))
      (setq lst (cons (cdr(assoc 300 (entget (cdr item)))) lst))
    ) ;_ end of if
  ) ;_ end of foreach
)
  )
    
  ;;;Список не созданных масштабов из шаблона pat
   (if (and lst (setq pat (vl-remove-if '(lambda(x)(member (car x) lst)) pat)))
     (progn
       (while (> (getvar "CMDACTIVE") 0)(command))
       (command "_.-scalelistedit")
       (foreach item pat
	 (command "_Add" (car item) (strcat (rtos (cadr item)) ":" (rtos (caddr item))))
	 ) ;_ end of foreach
       (command "_Exit")
       (while (> (getvar "CMDACTIVE") 0)(command))
       )
     )
  (princ)
   )
(defun C:SetScale ()(SetScale))
про DEFAULT
смотри название слоя GOR_BDEFAULT будет переименовано с цветом 32 в (cons "И1 Рельеф Горизонтали основные утолщенные" 32)
если в названии слоя присутствует DEFAULT
то переименовывать как уже есть в лиспе
(cons "И1 Рельеф Горизонтали основные утолщенные" 32)
(cons "И1 Рельеф Горизонтали основные" 32)
(cons "И1 Рельеф Контур рельеф" 92)
(cons "И1 Растительность Контур" 172)
(cons "И1 Текст" 7)
(cons "И1 Рельеф Обрыв" 32)
(cons "И1 Рельеф Откос" 32)
(cons "И1 Рельеф Отметки номера" 1)
(cons "И1 Рельеф Отметки" 5)
(cons "И1 Рельеф Точки СТ" 6)
(cons "И1 Рельеф Точки" 5)
(cons "И1 Координатная сетка" 94)
(cons "И1 Линии Ситуации" 7)
(cons "И1 Рельеф Поверхность" 132)
(cons "И1 Блоки Разные" 7)
(cons "И1 Блоки Растительности" 92)
иначе (если заместо DEFAULT написано что либо другое) имя слоя И1 Рельеф Горизонтали основные утолщенные(пробел) и то что заместо DEFAULT

например
слой - GOR_B122-125
переименовывается в - И1 Рельеф Горизонтали основные утолщенные 122-125
а
слой - GOR_BDEFAULT
переименовывается в - И1 Рельеф Горизонтали основные утолщенные
Gotch вне форума  
Ответ
Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > LISP > ЛИСП слои цвета преобразование

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

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


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