[Gotch]

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


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


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


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

[SetQ]

1. на лиспе - можно, начинай - поможем ))
2. можно тупо в scr сделать - кто-нибудь помнит что это такое? )))

[SetQ]

создавай файл 1.scr
первая строчка
_-purge _all _n
и т.д... запускается командой _script

[Gotch]

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

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

[Makswell]

Пункты 1, 4 и 5. Может кто дальше продолжит...

Код:

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

(defun test (/ adoc name_old_lay_lst new_lay_lst tbl_ent n)
  (vl-load-com)
  (setq adoc (vla-get-activedocument (vlax-get-acad-object)))
  (repeat 2 (vla-purgeall adoc))
  (setq	name_old_lay_lst
	 '("GOR_BDEFAULT"	"GOR_DEFAULT"	     "KNT_RDEFAULT"
	   "KNT_SDEFAULT"	"NAD_MDEFAULT"	     "OBRIVDEFAULT"
	   "OTKOSDEFAULT"	"PI_NUDEFAULT"	     "PI_OTDEFAULT"
	   "PI_STDEFAULT"	"PI_TTDEFAULT"	     "SETKR"
	   "SIT_LDEFAULT"	"TREUGDEFAULT"	     "USLZNDEFAULT"
	   "ZAPSKDEFAULT"
	  )
  )

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

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

[SetQ]

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

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

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

так что надо покапаться, но это совсем не сложно..

[Gotch]

(repeat 2 (vla-purgeall adoc))

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


а остальные пункты с ними сложнее?

[Gotch]

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

Код:

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

(defun c:poly3dto2d (/             adoc       selset 
           3dpoly          counter       2dpoly 
           coord          coord_lst 
           _kpblc-conv-pointlist-to-variant 
           ) 

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

  (vl-load-com) 
  (setq adoc (vla-get-activedocument (vlax-get-acad-object))) 
  (vla-startundomark adoc) 
  (if (setq selset (ssget "_:L" '((0 . "POLYLINE") (410 . "Model")))) 
    (progn 
      (foreach 3dpoly (vl-remove-if 'listp (mapcar 'cadr (ssnamex selset))) 
   (setq 3dpoly  (vlax-ename->vla-object 3dpoly) 
         counter 0 
         ) ;_ end of setq 
   (while 
     (not (vl-catch-all-error-p 
       (vl-catch-all-apply 'vla-get-coordinate (list 3dpoly counter)) 
       ) ;_ end of VL-CATCH-ALL-ERROR-P 
          ) ;_ end of not 
      (setq coord_lst (append coord_lst 
               (list (vlax-safearray->list 
                  (vlax-variant-value 
                    (vla-get-coordinate 3dpoly counter) 
                    ) ;_ end of vlax-variant-value 
                  ) ;_ end of vlax-safearray->list 
                ) ;_ end of list 
               ) ;_ end of append 
       counter   (1+ counter) 
       ) ;_ end of setq 
      ) ;_ end of while 
   (setq 
     2dpoly 
      (vla-addlightweightpolyline 
        (vla-get-modelspace adoc) 
        (_kpblc-conv-pointlist-to-variant 
          (apply 
       'append 
       (mapcar '(lambda (x) (list (car x) (cadr x))) coord_lst) 
       ) ;_ end of apply 
          ) ;_ end of _kpblc-conv-pointlist-to-variant 
        ) ;_ end of vla-AddLightWeightPolyline 
     ) ;_ end of setq 
   (vla-put-elevation 2dpoly (caddar coord_lst)) 
   (setq coord_lst nil) 
   ) ;_ end of foreach 
      (while (and selset (> (sslength selset) 0)) 
   (setq 3dpoly (ssname selset 0)) 
   (ssdel 3dpoly selset) 
   (entdel 3dpoly) 
   ) ;_ end of while 
      ) ;_ end of progn 
    ) ;_ end of if 
  (vla-endundomark adoc) 
  (princ) 
  ) ;_ end of defun

[Makswell]

Сообщение от Gotch (repeat 2 (vla-purgeall adoc)) Makswell как я понимаю это первый пункт смотри а если он за один роход все очищает то небудет ошибки что во второй раз чистить нечего?

Ошибки не будет

Сообщение от Gotch а остальные пункты с ними сложнее?

По-разному, но всё решаемо. Если выложишь образец файла, то будет проще.

[Makswell]

Давай по порядку:
п.2 Тексты или ещё МТексты?
п.3 Слои удаляешь LAYDEL'ем? Значит на них ещё что-то находится?

[Gotch]

вот вложил

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

п.3
да они не пустые
но все что в них мне ненужно

[Makswell]

Код из поста №5 не работал. Сейчас исправлено.

[VVA]

По п.7 могу предложить использовать ConvTo2d -Преобразование линейных объектов в 2D полилинии. Тогда фрагмент кода может выглядеть так:

Код:

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

(if (setq ss (ssget "_X" '((0 . "POLYLINE")(8 . "GOR_*"))))
  (progn
    (SSSETFIRST ss ss)
    (C:ConvTO2D)
    )
  )

3D полилинии должны быть в одной плоскости

[SetQ]

п. 2

Код:

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

  (If (SetQ ss (ssget "x" '((0 . "TEXT") (8 . "DEFAULT"))))
    (Command "_change" ss "" "_p" "_la" "NAD_MDEFAULT" "")
  )

[Makswell]

Решены пункты 1,2,3,4,5,6,6.1(см. пост 24),7,8:

Код:

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

(defun test (/		    selset	   ent_txt_lst	  txt_ent
	     tmp_lst	    adoc	   name_old_lay_lst
	     new_lay_lst    tbl_ent	   n		  tmp_ent
	     freez_lay_lst  lay_fam	   blk_name_lst	  blk_lay_lst
	     vla_ModelSpace blk_name
	    )
  (vl-load-com)
  (setq adoc (vla-get-activedocument (vlax-get-acad-object)))
  (setq	name_old_lay_lst
	 '("GOR_BDEFAULT"	"GORIZDEFAULT"	     "KNT_RDEFAULT"
	   "KNT_SDEFAULT"	"NAD_MDEFAULT"	     "OBRIVDEFAULT"
	   "OTKOSDEFAULT"	"PI_NUDEFAULT"	     "PI_OTDEFAULT"
	   "PI_STDEFAULT"	"PI_TTDEFAULT"	     "SETKR"
	   "SIT_LDEFAULT"	"TREUGDEFAULT"	     "USLZNDEFAULT"
	   "ZAPSKDEFAULT"
	  )
  )

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

[dkite]

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

[Gotch]

Код:

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

	 '("GOR_BDEFAULT"	"GOR_DEFAULT"	     "KNT_RDEFAULT"
	   "KNT_SDEFAULT"	"NAD_MDEFAULT"	     "OBRIVDEFAULT"
	   "OTKOSDEFAULT"	"PI_NUDEFAULT"	     "PI_OTDEFAULT"
	   "PI_STDEFAULT"	"PI_TTDEFAULT"	     "SETKR"
	   "SIT_LDEFAULT"	"TREUGDEFAULT"	     "USLZNDEFAULT"
	   "ZAPSKDEFAULT"
	  )
  )

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

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

да?

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

и так же задание цвета

[Gotch]

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

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

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

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

только одно убивет хотел CIVIL 2008 но не смог найти
придется работать с 2009

[Makswell]

Сообщение от Gotch в этом коде я так понимаю прописано сопоставление слоев так сказать типа - "GOR_BDEFAULT" = (cons "Рельеф Горизонтали основные утолщенные" 32) да? т.е. если что то у меня в дальнейшем меняется я могу спокойно тут добавить или наоборот убрать и это как либо плохо неповлияет? и так же задание цвета

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

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

[Gotch]

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

Opening a Release 12 DXF file.
Regenerating model.

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

AutoCAD menu utilities loaded.*Cancel*

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

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

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


что то либо я не так запускаю, или она нехочет запускатья...

[dkite]

Сообщение от Gotch Opening a Release 12 DXF file. что то либо я не так запускаю, или она нехочет запускатья...

Надо
Command: (test)

[Gotch]

Сообщение от Makswell Решены пункты 1,2,3,4,5:

да работает
одна небольшая поправка из-за моей ошибки
это легко в коде правится
слой GOR_DEFAULT - на самом деле называется GORIZDEFAULT
подправил

Код:

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

(defun test (/		  selset       ent_txt_lst  txt_ent	 tmp_lst
	     adoc	  name_old_lay_lst	    new_lay_lst	 tbl_ent
	     n
	    )
  (vl-load-com)
  (setq adoc (vla-get-activedocument (vlax-get-acad-object)))
  (setq	name_old_lay_lst
	 '("GOR_BDEFAULT"	"GORIZDEFAULT"	     "KNT_RDEFAULT"
	   "KNT_SDEFAULT"	"NAD_MDEFAULT"	     "OBRIVDEFAULT"
	   "OTKOSDEFAULT"	"PI_NUDEFAULT"	     "PI_OTDEFAULT"
	   "PI_STDEFAULT"	"PI_TTDEFAULT"	     "SETKR"
	   "SIT_LDEFAULT"	"TREUGDEFAULT"	     "USLZNDEFAULT"
	   "ZAPSKDEFAULT"
	  )
  )

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

;;; 2 пункт
  (setq selset (ssget "_X" '((0 . "TEXT") (8 . "DEFAULT"))))
  (if selset
    (progn
      (setq ent_txt_lst (mapcar 'cadr (ssnamex selset)))
    )
  )
  (foreach item	ent_txt_lst
    (setq txt_ent (entget item))
    (setq txt_ent (subst (cons 8 "NAD_MDEFAULT") (assoc 8 txt_ent) txt_ent))
    (entmod txt_ent)
  )
;;; 3 пункт
  (setq	selset (ssget "_X"
		      '((-4 . "<OR")
			(8 . "PI_DTDEFAULT")
			(8 . "SETLN")
			(8 . "STR_LDEFAULT")
			(-4 . "OR>")
		       )
	       )
  )
  (if selset
    (progn
      (setq tmp_lst (mapcar 'cadr (ssnamex selset)))
    )
  )
  (foreach item	tmp_lst
    (entdel item)
  )
;;; 4,5 пункт
  (setq n 0)
  (foreach item	name_old_lay_lst
    (if	(tblsearch "LAYER" item)
      (progn
	(setq tbl_ent (entget (tblobjname "LAYER" item)))
	(setq tbl_ent (subst (cons 2 (car (nth n new_lay_lst)))
			     (assoc 2 tbl_ent)
			     tbl_ent
		      )
	)
	(setq tbl_ent (subst (cons 62 (cdr (nth n new_lay_lst)))
			     (assoc 62 tbl_ent)
			     tbl_ent
		      )
	)
	(entmod tbl_ent)
      )
    )
    (setq n (1+ n))
  )
;;; 1 пункт - лучше делать в конце
  (repeat 3 (vla-purgeall adoc))
  (princ)
)

[Makswell]

Подправил код в посте №15.
Добавил решение пункта 6.

[Gotch]

Сообщение от Makswell Подправил код в посте №15. Добавил решение пункта 6.

работает!
клева!!!


а в 6 пункте если не трудно можно пожалуйста добавить что бы слои
Растительность Контур
Рельеф Отметки номера
Рельеф Поверхность
Рельеф Контур рельеф
оказались потом замороженные?

[Gotch]

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

VVA что то не работает, он выделяет полилинии и все останавливается

[Makswell]

Сообщение от Gotch а в 6 пункте если не трудно можно пожалуйста добавить что бы слои Растительность Контур Рельеф Отметки номера Рельеф Поверхность Рельеф Контур рельеф оказались потом замороженные?

Исправил код в посте 15.

[Gotch]

Сообщение от Makswell Исправил код в посте 15.

ЛИСП это сила!!!
все займусь изучением
уже заказал книги которые советовал Алексей
как только придут сразу вплотную займусь

спасибо большое!!!

[VVA]

Сообщение от Gotch VVA что то не работает, он выделяет полилинии и все останавливается

3D полилинии должны быть в одной плоскости (координата Z всех вершин одинакова). Ну и предварительно нужно загрузить pltools.fas
(load "pltools")

[Gotch]

а с послденими двумя пунктами?

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

если я не сильно усложню задачу по 7му пункту
можно что бы после преобразования в 2D выдавался запрос
- Толщина утолщенных горизонталей
там у нас будет 3 варианта -
- 0.3
- 0.5
- 1
и задавалась толщина полилиниям находящимся в слое -
GOR_BDEFAULT - Рельеф Горизонтали основные утолщенные - 32

а дальше так же 8 пункт

[Gotch]

Сообщение от VVA 3D полилинии должны быть в одной плоскости (координата Z всех вершин одинакова). Ну и предварительно нужно загрузить pltools.fas (load "pltools")

т..е одна полилиния должна находится на одиновой высоте?
у нас так и есть одна полилиния находится на одной высоте,


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

что бы все было в одном?

[Makswell]

Подправил код в посте №15.
Добавил решение пункта 7.

[VVA]

Так я про это и говорю. Файл pltools.fas должен быть в путях поиска (см. readme.txt)
Фрагмент кода

Код:

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

(if (null C:ConvTO2D)(load "pltools.fas")) ;_ грузим pltools
(if (setq ss (ssget "_X" '((0 . "POLYLINE")(8 . "GOR*"))))
  (progn
    (SSSETFIRST ss ss)
    (C:ConvTO2D)
    )
  )

Ну и в соответствии с #22 подкорректировал шаблон (выделено красным)

[Gotch]

Сообщение от VVA Так я про это и говорю. Файл pltools.fas должен быть в путях поиска (см. readme.txt) Фрагмент кода Код: [Выделить все] (if (null C:ConvTO2D)(load "pltools.fas")) ;_ грузим pltools (if (setq ss (ssget "_X" '((0 . "POLYLINE")(8 . "GOR*")))) (progn (SSSETFIRST ss ss) (C:ConvTO2D) ) ) Ну и в соответствии с #22 подкорректировал шаблон (выделено красным)

но мне будет неособо удобно использовать два файла основной лисп с pltools.fas
в плане переноса на другие компы недобно
а так что бы все пункты по возможности решались внутри одного лиспа

[Makswell]

По пункту 8.
Напиши, какие блоки нужно перекинуть на слой "Блоки Трасса", какие на "Блоки Растительности" и т.д.
Имена блоков напиши в кавычках и через пробел, типа такого: "BL_1001" "BL_1003" и т.п.
Так будет проще перенести это в лисп.

[VVA]

Gotch, Переноси не файлы а папки
Там (когда скачаешь) есть файл pltools.lsp.
Можень объединить со своим или выбрать нужное.

[Gotch]

Сообщение от Makswell По пункту 8. Напиши, какие блоки нужно перекинуть на слой "Блоки Трасса", какие на "Блоки Растительности" и т.д. Имена блоков напиши в кавычках и через пробел, типа такого: "BL_1001" "BL_1003" и т.п. Так будет проще перенести это в лисп.

тут

[Makswell]

Подправил код в посте №15.
Добавил решение пункта 8.

[Gotch]

Сообщение от Makswell Подправил код в посте №15. Добавил решение пункта 8.

СПАСИБО БОЛЬШОЕ!!!!!!!!!
как я могу отблагодарить?

[Gotch]

можно ещё попросить
что бы в самом начале лиспа был вопрос -
Какой масштаб съемки?

три варината ответа
- 500
- 1000
- 2000

если 500 то что бы задавалась толщина всех полилиний находящихся в слое - Рельеф Горизонтали основные утолщенные - толщина равная 0.2 и задавался стиль отображения точки(Point style) круглешок с точкой в центре in Absolute units = 0.3 и высота всех текстов = 1

для 1000 толщина равная 0.5 и задавался стиль отображения точки(Point style) круглешок с точкой в центре in Absolute units = 0.5 и высота всех текстов = 2

и для 2000 толщина равная 1 и задавался стиль отображения точки(Point style) круглешок с точкой в центре in Absolute units = 1 и высота всех текстов = 4


создался стиль текста - new_style
Font name - Arial
и применить его ко всем текстам в проекте

возможно пожалуйста такое сделать?

__ а?

[VVA]

Сообщение от Gotch создался стиль текста - new_style Font name - Arial и применить его ко всем текстам в проекте

LISP. Замена текстового стиля

[Makswell]

Решены пункты 1,2,3,4,5,6,6.1(см. пост 24),7,8,9(см. пост 39) и ещё немного (см. пост 57):

Код:

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

(defun test (/		   reply	 txt_height    selset
	     ent_txt_lst   txt_ent	 tmp_lst       adoc
	     name_old_lay_lst		 new_lay_lst   tbl_ent
	     n		   tmp_ent	 freez_lay_lst lay_fam
	     blk_name_lst  blk_lay_lst	 vla_ModelSpace
	     blk_name	   lw		 pt_size       flag
	     o_angle	   width
	    )
  (vl-load-com)
  (setq	width	1.
	o_angle	(/ pi 30.)
  )
  (setq adoc (vla-get-activedocument (vlax-get-acad-object)))
  (setq	name_old_lay_lst
	 '("GOR_BDEFAULT"	"GORIZDEFAULT"	     "KNT_RDEFAULT"
	   "KNT_SDEFAULT"	"NAD_MDEFAULT"	     "OBRIVDEFAULT"
	   "OTKOSDEFAULT"	"PI_NUDEFAULT"	     "PI_OTDEFAULT"
	   "PI_STDEFAULT"	"PI_TTDEFAULT"	     "SETKR"
	   "SIT_LDEFAULT"	"TREUGDEFAULT"	     "USLZNDEFAULT"
	   "ZAPSKDEFAULT"
	  )
  )
  (setq	new_lay_lst
	 (list
	   (cons "Рельеф Горизонтали основные утолщенные" 32)
	   (cons "Рельеф Горизонтали основные" 32)
	   (cons "Рельеф Контур рельеф" 92)
	   (cons "Растительность Контур" 172)
	   (cons "Текст" 7)
	   (cons "Рельеф Обрыв" 32)
	   (cons "Рельеф Откос" 32)
	   (cons "Рельеф Отметки номера" 1)
	   (cons "Рельеф Отметки" 5)
	   (cons "Рельеф Точки СТ" 6)
	   (cons "Рельеф Точки" 5)
	   (cons "Координатная сетка" 94)
	   (cons "Линии Ситуации" 7)
	   (cons "Рельеф Поверхность" 132)
	   (cons "Блоки Разные" 7)
	   (cons "Блоки Растительности" 92)
	 )
  )
  (vla-startundomark adoc)
;;; 9 пункт - начало
  (initget 6)
  (setq	reply (getint
		"Масштаб съемки [500/1000/2000] <500>: "
	      )
  )
  (if (not reply)
    (setq reply 500)
  )
  (cond	((= reply 500)
	 (progn (setq lw 0.2) (setq pt_size 0.3) (setq txt_height 1))
	)
	((= reply 1000)
	 (progn (setq lw 0.5) (setq pt_size 0.5) (setq txt_height 2))
	)
	((= reply 2000)
	 (progn (setq lw 1.) (setq pt_size 1.) (setq txt_height 4))
	)
	(t (setq flag t))
  )
  (if flag
    (progn
      (alert "Масштаб съемки выбран неверно")
    )
    (progn
      (setvar "PDMODE" 32)
      (princ "\nУстановлено новое отображения точек\n")
      (setvar "PDSIZE" pt_size)
      (princ "\nУстановлен новый размер отображения точек")
;;;**************************************************************** 
      (defun create-textstyle
			      (name	    font_filename
			       height	    width	 o_angle
			       /	    ent_list	 font_filename
			       exist_style
			      )
	(setq ent_list
	       (list
		 (cons 0 "STYLE")
		 (cons 100 "AcDbSymbolTableRecord")
		 (cons 100 "AcDbTextStyleTableRecord")
		 (cons 2 name)		; имя стиля
		 (cons 70 0)		;
		 (cons 40 height)	; высота
		 (cons 41 width)	; width factor
		 (cons 50 o_angle)	; oblique angle
		 (cons 71 0)		; not backwatf, not upside down
		 (cons 42 2.5)		; last height used
		 (cons 3 font_filename)	; primary font file name
		 (cons 4 "")		; big font file name
	       )
	)
	(entmake ent_list)
	(setvar "textstyle" name)
      )
;;;****************************************************************
      (create-textstyle "new_style" "Arial.ttf" 0 1 0)
      (princ "\nСоздан текстовый стиль new_style")

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

[Gotch]

после выбора масштаба лисп останавливается
точки он сделал как надо
а больше ничего

Command: (load "test")
TEST

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

[Makswell]

Немного подправил код в посте 41.
Попробуй ещё раз.

Лог консоли должен выглядеть примерно так:

Команда: (test) Масштаб съемки [500/1000/2000] <500>: Выполняется регенерация модели. Выполняется регенерация модели.

[Gotch]

Сообщение от Makswell Немного подправил код в посте 41. Попробуй ещё раз. Лог консоли должен выглядеть примерно так:

что то неполучается
снова останавливается после преобразования вида точек

Command: (load "test")
TEST

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

[Makswell]

Сообщение от Gotch что то неполучается снова "останавливается" после преобразования вида точек

В смысле "останавливается"? Зависает что ли? Или всё таки заканчивает работу?
Сейчас специально добавил в код в посте №41 строчку (princ "\nОбработка файла завершена")
Попробуй ещё раз.

[Gotch]

Сообщение от Makswell В смысле "останавливается"? Зависает что ли? Или всё таки заканчивает работу? Сейчас специально добавил в код в посте №41 строчку (princ "\nОбработка файла завершена") Попробуй ещё раз.

он не зависает просто прекращается выполнение лиспа
Command: (load "test")
TEST

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

и все
ждет дальнейших комманд

[Makswell]

Попробуй ещё раз код из №41
Сейчас что пишет?

[Gotch]

Command: (load "test")
TEST

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

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

Установлен новый размер отображения точек



как я понимаю он функцию с текстовым стилем не продолжает делать

[Makswell]

Вот! Нашёл в чём дело. Просто досадная описка.
Давай, пробуй ещё, чего уж там

[Gotch]

Сообщение от Makswell Вот! Нашёл в чём дело. Просто досадная описка. Давай, пробуй ещё, чего уж там

да теперь работает только

Код:

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

  (cond	((= reply 500)
	 (progn (setq lw 20) (setq pt_size 0.3) (setq txt_height 1))
	)
	((= reply 1000)
	 (progn (setq lw 50) (setq pt_size 0.5) (setq txt_height 2))
	)
	((= reply 2000)
	 (progn (setq lw 1.) (setq pt_size 1.) (setq txt_height 4))
	)
	(t (setq flag t))

в этом коде он выходит для всех всех всех полилиний присваивает толщину 0.2, 0.5 или 1?
но толщина линий все равно не задается
и нужно что бы не для всех полилиний а для тех которые находятся в слое - Рельеф Горизонтали основные утолщенные

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

попытался добавить сам что бы width = 1 и o_angle = 6
вот сюда -

Код:

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

	 (progn (setq lw 20) (setq pt_size 0.3) (setq txt_height 1 width 1 o_angle 6))
	)
	((= reply 1000)
	 (progn (setq lw 50) (setq pt_size 0.5) (setq txt_height 2 width 1 o_angle 6))
	)
	((= reply 2000)
	 (progn (setq lw 1.) (setq pt_size 1.) (setq txt_height 4 width 1 o_angle 6))
	)
	(t (setq flag t))

но неполучается
что я не так сделал?

[Makswell]

Опять подравил код.
Вес полилиний присваивался всё-таки не всем полилиниям, а только тем, что на слое "Рельеф Горизонтали основные" (просто моя невнимательность) - заменил на "Рельеф Горизонтали основные утолщенные".

Я так понял, ты хочешь сделать коэффициент сжатия всех текстов 1 и угол наклона 6?
В ветвлении cond это делать излишне, т.к. у тебя эти переменные принимают только 1 значение.
Поэтому, значения присваиваешь им один раз (например, в начале программы)

Код:

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

(setq width 1 o_angle (/ pi 30.))

Ну и потом находишь в коде приведённый ниже фрагмент и добавляешь такие строчки (выделено красным):

Код:

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

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

[Gotch]

аа...
нет оказывается он задавал но не для того слоя
он задавал для слоя - Рельеф Горизонтали основные
а надо для слоя - Рельеф Горизонтали основные утолщенные

лисп выходит задвал Lineweight
это не совсем то
лучше если бы задавал параметр в Global width

но что бы этот параметр задать выходит что нужно что бы сперва произошло преобразование в 2D а после задание толщины

[Makswell]

Ну вот - опять путаница в понятиях. Ты написал про толщину. Я понял это как "вес". А ты имел ввиду ширину. Ведь у полилинии нет толщины - есть именно ширина и вес...

Что, переделать на изменение ширины?

[Gotch]

Сообщение от Makswell Я так понял, ты хочешь сделать коэффициент сжатия всех текстов 1 и угол наклона 6? В ветвлении cond это делать излишне, т.к. у тебя эти переменные принимают только 1 значение. Поэтому, значения присваиваешь им один раз (например, в начале программы) Код: [Выделить все] (setq width 1 o_angle (/ pi 30.))

т.е. выходит вот эту часть кода -

Код:

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

(setq width 1 o_angle (/ pi 30.))

я вставляю сюда -

Код:

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

	 (progn (setq lw 20) (setq pt_size 0.3) (setq txt_height 1) (setq width 1 o_angle (/ pi 30.)))
	)
	((= reply 1000)
	 (progn (setq lw 50) (setq pt_size 0.5) (setq txt_height 2) (setq width 1 o_angle (/ pi 30.)))
	)
	((= reply 2000)
	 (progn (setq lw 100) (setq pt_size 1.) (setq txt_height 4) (setq width 1 o_angle (/ pi 30.)))

или нет?

а это - (/ pi 30.) - что значит?

[Gotch]

Сообщение от Makswell Ну вот - опять путаница в понятиях. Ты написал про толщину. Я понял это как "вес". А ты имел ввиду ширину. Ведь у полилинии нет толщины - есть именно ширина и вес... Что, переделать на изменение ширины?

да прости я неправильно выразился
подскажи а что есть разница между Global width и Lineweight?
по сути выходит одно и тоже как мне кажется задается толщина линии какой она будет при печати

только для наших планов Global width нагляднее и лучше смотрится

[Makswell]

Сообщение от Gotch а это - (/ pi 30.) - что значит?

Перевод в радианы.
180 градусов = Пи радиан
6 градусов = (180 градусов)/30 = Пи/30 радиан

По остальному. Знаешь, просто нет времени (да и признаюсь - желания особого) что-то объяснять. Давай просто изменю код, как тебе надо - лады?

Напиши, что ещё ты хочешь, и закончим на этом.

[Gotch]

- сжатия всех текстов 1 и угол наклона 6
- Global width = 0.2, 0.5 и 1

[Makswell]

Подправил код в посте 41.
Сейчас всё нормально?

[Gotch]

AutoCAD 2009 вот так возмутился

Command: (load "test")
TEST

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

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

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


завтра проверю на 2006-2008

[Makswell]

Нет, нет. Это опять мой косяк. Исправлено.

[Gotch]

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

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

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

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

[Makswell]

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

[Gotch]

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

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

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

[Makswell]

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

[Gotch]

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

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

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

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

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

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

[Makswell]

Вот новая версия. А то что-то надоело всё время в к 41-му посту возвращаться.

Код:

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

(defun test (/		   reply	 txt_height    selset
	     ent_txt_lst   txt_ent	 tmp_lst       adoc
	     name_old_lay_lst		 new_lay_lst   tbl_ent
	     n		   tmp_ent	 freez_lay_lst lay_fam
	     blk_name_lst  blk_lay_lst	 vla_ModelSpace
	     blk_name	   lw		 pt_size       flag
	     o_angle	   width
	    )
  (vl-load-com)
  (setq	width	1.
	o_angle	(/ pi 30.)
  )
  (setq adoc (vla-get-activedocument (vlax-get-acad-object)))
  (setq	name_old_lay_lst
	 '("GOR_BDEFAULT"	"GORIZDEFAULT"	     "KNT_RDEFAULT"
	   "KNT_SDEFAULT"	"NAD_MDEFAULT"	     "OBRIVDEFAULT"
	   "OTKOSDEFAULT"	"PI_NUDEFAULT"	     "PI_OTDEFAULT"
	   "PI_STDEFAULT"	"PI_TTDEFAULT"	     "SETKR"
	   "SIT_LDEFAULT"	"TREUGDEFAULT"	     "USLZNDEFAULT"
	   "ZAPSKDEFAULT"
	  )
  )
  (setq	new_lay_lst
	 (list
	   (cons "Рельеф Горизонтали основные утолщенные" 32)
	   (cons "Рельеф Горизонтали основные" 32)
	   (cons "Рельеф Контур рельеф" 92)
	   (cons "Растительность Контур" 172)
	   (cons "Текст" 7)
	   (cons "Рельеф Обрыв" 32)
	   (cons "Рельеф Откос" 32)
	   (cons "Рельеф Отметки номера" 1)
	   (cons "Рельеф Отметки" 5)
	   (cons "Рельеф Точки СТ" 6)
	   (cons "Рельеф Точки" 5)
	   (cons "Координатная сетка" 94)
	   (cons "Линии Ситуации" 7)
	   (cons "Рельеф Поверхность" 132)
	   (cons "Блоки Разные" 7)
	   (cons "Блоки Растительности" 92)
	 )
  )
  (vla-startundomark adoc)
;;; 9 пункт - начало
  (initget 6)
  (setq	reply (getint
		"Масштаб съемки [500/1000/2000] <500>: "
	      )
  )
  (if (not reply)
    (setq reply 500)
  )
  (cond	((= reply 500)
	 (progn (setq lw 0.2) (setq pt_size 0.3) (setq txt_height 1))
	)
	((= reply 1000)
	 (progn (setq lw 0.5) (setq pt_size 0.5) (setq txt_height 2))
	)
	((= reply 2000)
	 (progn (setq lw 1.) (setq pt_size 1.) (setq txt_height 4))
	)
	(t (setq flag t))
  )
  (if flag
    (progn
      (alert "Масштаб съемки выбран неверно")
    )
    (progn
      (setvar "PDMODE" 32)
      (princ "\nУстановлено новое отображения точек\n")
      (setvar "PDSIZE" pt_size)
      (princ "\nУстановлен новый размер отображения точек")
;;;**************************************************************** 
      (defun create-textstyle
			      (name	    font_filename
			       height	    width	 o_angle
			       /	    ent_list	 font_filename
			       exist_style
			      )
	(setq ent_list
	       (list
		 (cons 0 "STYLE")
		 (cons 100 "AcDbSymbolTableRecord")
		 (cons 100 "AcDbTextStyleTableRecord")
		 (cons 2 name)		; имя стиля
		 (cons 70 0)		;
		 (cons 40 height)	; высота
		 (cons 41 width)	; width factor
		 (cons 50 o_angle)	; oblique angle
		 (cons 71 0)		; not backwatf, not upside down
		 (cons 42 2.5)		; last height used
		 (cons 3 font_filename)	; primary font file name
		 (cons 4 "")		; big font file name
	       )
	)
	(entmake ent_list)
	(setvar "textstyle" name)
      )
;;;****************************************************************
      (create-textstyle "new_style" "Arial.ttf" 0 1 0)
      (princ "\nСоздан текстовый стиль new_style")

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

[Gotch]

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

[Makswell]

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

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

[Gotch]

Сообщение от Makswell Конечно! С тебя 1000 баксов. Шутка... Желаю удачи в дальнейшем.

Makswell прости что снова беспкою но ту снова бывает возникает ошибка

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

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

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


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

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

[Makswell]

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

[Gotch]

Сообщение от Makswell Приложи файл, где так происходит.

вот тут

[Makswell]

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

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

[Gotch]

Код:

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

(defun test (/		   reply	 txt_height    selset
	     ent_txt_lst   txt_ent	 tmp_lst       adoc
	     name_old_lay_lst		 new_lay_lst   tbl_ent
	     n		   tmp_ent	 freez_lay_lst lay_fam
	     blk_name_lst  blk_lay_lst	 vla_ModelSpace
	     blk_name	   lw		 pt_size       flag
	     o_angle	   width
	    )
  (vl-load-com)
  (setq	width	1.
	o_angle	(/ pi 30.)
  )
  (setq adoc (vla-get-activedocument (vlax-get-acad-object)))
  (setq	name_old_lay_lst
	 '("GOR_BDEFAULT"	"GORIZDEFAULT"	     "KNT_RDEFAULT"
	   "KNT_SDEFAULT"	"NAD_MDEFAULT"	     "OBRIVDEFAULT"
	   "OTKOSDEFAULT"	"PI_NUDEFAULT"	     "PI_OTDEFAULT"
	   "PI_STDEFAULT"	"PI_TTDEFAULT"	     "SETKR"
	   "SIT_LDEFAULT"	"TREUGDEFAULT"	     "USLZNDEFAULT"
	   "ZAPSKDEFAULT"
	  )
  )
  (setq	new_lay_lst
	 (list
	   (cons "Горизонтали утолщенные" 30)
	   (cons "Горизонтали основные" 32)
	   (cons "Граница рельефа" 92)
	   (cons "Граница растительности" 100)
	   (cons "Подписи и выноски" 7)
	   (cons "Обрыв" 32)
	   (cons "Откос" 32)
	   (cons "Отметки номера" 1)
	   (cons "Отметки" 7)
	   (cons "Пикеты СТ" 7)
	   (cons "Пикеты" 7)
	   (cons "Координатная сетка" 84)
	   (cons "Здания и сооружения" 7)
	   (cons "Рельеф поверхность" 132)
	   (cons "Блоки Разные" 7)
	   (cons "Растительность" 100)
	 )
  )
  (vla-startundomark adoc)
;;; 9 пункт - начало
  (initget 6)
  (setq	reply (getint
		"Масштаб съемки [500/1000/2000] <500>: "
	      )
  )
  (if (not reply)
    (setq reply 500)
  )
  (cond	((= reply 500)
	 (progn (setq lw 0.25) (setq pt_size 0.3) (setq txt_height 1))
	)
	((= reply 1000)
	 (progn (setq lw 0.5) (setq pt_size 0.5) (setq txt_height 2))
	)
	((= reply 2000)
	 (progn (setq lw 1.) (setq pt_size 1.) (setq txt_height 4))
	)
	(t (setq flag t))
  )
  (if flag
    (progn
      (alert "Масштаб съемки выбран неверно")
    )
    (progn
      (setvar "PDMODE" 32)
      (princ "\nУстановлено новое отображения точек\n")
      (setvar "PDSIZE" pt_size)
      (princ "\nУстановлен новый размер отображения точек")
;;;**************************************************************** 
      (defun create-textstyle
			      (name	    font_filename
			       height	    width	 o_angle
			       /	    ent_list	 font_filename
			       exist_style
			      )
	(setq ent_list
	       (list
		 (cons 0 "STYLE")
		 (cons 100 "AcDbSymbolTableRecord")
		 (cons 100 "AcDbTextStyleTableRecord")
		 (cons 2 name)		; имя стиля
		 (cons 70 0)		;
		 (cons 40 height)	; высота
		 (cons 41 width)	; width factor
		 (cons 50 o_angle)	; oblique angle
		 (cons 71 0)		; not backwatf, not upside down
		 (cons 42 2.5)		; last height used
		 (cons 3 font_filename)	; primary font file name
		 (cons 4 "")		; big font file name
	       )
	)
	(entmake ent_list)
	(setvar "textstyle" name)
      )
;;;****************************************************************
      (create-textstyle "new_style" "Arial.ttf" 0 1 0)
      (princ "\nСоздан текстовый стиль new_style")

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

для линий находящихся в этих слоях

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

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

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

[Makswell]

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

[Gotch]

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

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

[Makswell]

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

Код:

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

(defun test (/		   reply	 txt_height    selset
	     ent_txt_lst   txt_ent	 tmp_lst       adoc
	     name_old_lay_lst		 new_lay_lst   tbl_ent
	     n		   tmp_ent	 freez_lay_lst lay_fam
	     blk_name_lst  blk_lay_lst	 vla_ModelSpace
	     blk_name	   lw		 pt_size       flag
	     o_angle	   width
	    )
  (vl-load-com)
  (setq	width	1.
	o_angle	(/ pi 30.)
  )
  (setq adoc (vla-get-activedocument (vlax-get-acad-object)))
  (setq	name_old_lay_lst
	 '("GOR_BDEFAULT"	"GORIZDEFAULT"	     "KNT_RDEFAULT"
	   "KNT_SDEFAULT"	"NAD_MDEFAULT"	     "OBRIVDEFAULT"
	   "OTKOSDEFAULT"	"PI_NUDEFAULT"	     "PI_OTDEFAULT"
	   "PI_STDEFAULT"	"PI_TTDEFAULT"	     "SETKR"
	   "SIT_LDEFAULT"	"TREUGDEFAULT"	     "USLZNDEFAULT"
	   "ZAPSKDEFAULT"
	  )
  )
  (setq	new_lay_lst
	 (list
	   (cons "Горизонтали утолщенные" 30)
	   (cons "Горизонтали основные" 32)
	   (cons "Граница рельефа" 92)
	   (cons "Граница растительности" 100)
	   (cons "Подписи и выноски" 7)
	   (cons "Обрыв" 32)
	   (cons "Откос" 32)
	   (cons "Отметки номера" 1)
	   (cons "Отметки" 7)
	   (cons "Пикеты СТ" 7)
	   (cons "Пикеты" 7)
	   (cons "Координатная сетка" 84)
	   (cons "Здания и сооружения" 7)
	   (cons "Рельеф поверхность" 132)
	   (cons "Блоки Разные" 7)
	   (cons "Растительность" 100)
	 )
  )
  (vla-startundomark adoc)
;;; 9 пункт - начало
  (initget 6)
  (setq	reply (getint
		"Масштаб съемки [500/1000/2000] <500>: "
	      )
  )
  (if (not reply)
    (setq reply 500)
  )
  (cond	((= reply 500)
	 (progn (setq lw 0.25) (setq pt_size 0.3) (setq txt_height 1))
	)
	((= reply 1000)
	 (progn (setq lw 0.5) (setq pt_size 0.5) (setq txt_height 2))
	)
	((= reply 2000)
	 (progn (setq lw 1.) (setq pt_size 1.) (setq txt_height 4))
	)
	(t (setq flag t))
  )
  (if flag
    (progn
      (alert "Масштаб съемки выбран неверно")
    )
    (progn
      (setvar "PDMODE" 32)
      (princ "\nУстановлено новое отображения точек\n")
      (setvar "PDSIZE" pt_size)
      (princ "\nУстановлен новый размер отображения точек")
;;;**************************************************************** 
      (defun create-textstyle
			      (name	    font_filename
			       height	    width	 o_angle
			       /	    ent_list	 font_filename
			       exist_style
			      )
	(setq ent_list
	       (list
		 (cons 0 "STYLE")
		 (cons 100 "AcDbSymbolTableRecord")
		 (cons 100 "AcDbTextStyleTableRecord")
		 (cons 2 name)		; имя стиля
		 (cons 70 0)		;
		 (cons 40 height)	; высота
		 (cons 41 width)	; width factor
		 (cons 50 o_angle)	; oblique angle
		 (cons 71 0)		; not backwatf, not upside down
		 (cons 42 2.5)		; last height used
		 (cons 3 font_filename)	; primary font file name
		 (cons 4 "")		; big font file name
	       )
	)
	(entmake ent_list)
	(setvar "textstyle" name)
      )
;;;****************************************************************
      (create-textstyle "new_style" "Arial.ttf" 0 1 0)
      (princ "\nСоздан текстовый стиль new_style")

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

	)
      )
      (princ "\nЗавершено расположение блоков на соответствующих слоях")
      (princ "\nТекстам присвоена новая высота, стиль new_style")
;;;      (princ
;;;	"\nПолилиниям на слое \"Горизонтали утолщенные\" присоена глобальная ширина "
;;;      )
;;;      (princ lw)
;;; 1 пункт - лучше делать в конце
      (repeat 3 (vla-purgeall adoc))
      (princ "\nПроизведена очистка рисунка от неиспользуемых объектов")
    )
  )
  (vla-endundomark adoc)
  (princ "\nОбработка файла завершена")
  (princ)
)

[Gotch]

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

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

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

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

[Makswell]

Так?

[Gotch]

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

[Makswell]

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

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

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

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

[Gotch]

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

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

так сможешь?

[Gotch]

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

Код:

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

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

[Makswell]

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

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

[VVA]

1.

Код:

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

(setvar "LUNITS" 2)
(setvar "LUPREC" 2)
(setvar "AUNITS" 1)
(setvar "AUPREC" 3)
(setvar "INSUNITS" 4)

[Gotch]

Сообщение от 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

[VVA]

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

Сообщение от Gotch Command: ; error: misplaced dot on input

Перевод-> ошибка: неверно расположенная точка на входе
Найди строчку (setq txt_height .8) замени на
(setq txt_height 0.8)

[Gotch]

Сообщение от VVA Перевод-> ошибка: неверно расположенная точка на входе Найди строчку (setq txt_height .8) замени на (setq txt_height 0.8)

спасибо VVA
а с 3им пунктом поможешь?

[Gotch]

Сообщение от 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

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

[VVA]

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

Создание размерного стиля
Программное создание размерных стилей

Сообщение от Gotch и хотел попросить помочь с сбросом масштабов

Не выполняется копирование объектов между файлами через буфер обмена
Еще посмотри ссылку в конце варианта №1:

Дополнительный программный вариант решения проблемы, без применения командных методов ...

[Gotch]

Сообщение от VVA Создание размерного стиля Программное создание размерных стилей Не выполняется копирование объектов между файлами через буфер обмена Еще посмотри ссылку в конце варианта №1:

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

добавил в конце сброс масштабов

а в итоге при вызове списка масштабов в акаде
меня выбивает из акада с фатальной ошибкой

[VVA]

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

[Gotch]

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

попробовал второй вариант что то тоже не помог
масштабы в списке масштабов не очистились и не появились

я правильно понимаю что я просто этот лисп вставляю в конце того длинного лиспа и все?

[VVA]

Сообщение от Gotch я правильно понимаю что я просто этот лисп вставляю в конце того длинного лиспа и все?

Нет Нужно добавить в самом низу еще одну строчку:

Код:

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

(SetScale)

[Gotch]

не что то все равно не работает

[VVA]

я сейчас в отпуске, подними эту тему после 4 июля, разберемся

[Gotch]

Сообщение от 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:

и масштабы стали как надо
но когда просто запускаю лисп масштабы не меняются

[VVA]

Сообщение от 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 ничего не понял

[Gotch]

Сообщение от 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 Рельеф Горизонтали основные утолщенные