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

Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > LISP > Почему функция error не обрабатывает появление ошибки при назначении системной переменной?

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

Ответ
Перейти к новому Перейти к новому  
Поиск в этой теме
Непрочитано 08.12.2022, 10:40 #1
Почему функция error не обрабатывает появление ошибки при назначении системной переменной?
МишаИнженер
 
Регистрация: 14.12.2008
Сообщений: 1,134
В данном коде стоит задача: при удачном назначении значения системной переменной HPNAME вывести сообщение об удачном присвоении значения системной переменной, при неудачном назначении (системная переменная HPNAME не поменяла свое значение) вывести сообщение об отсутствии шаблона штриховки в среде АвтоКад:
Код:
[Выделить все] 
 
		((eq TypeObj "HATCH");Назначим текущий стиль штриховки
			(setq StyleName (cdr (assoc 2 dan)))
		 	(if (ERROR (setvar "HPNAME" StyleName))
				(princ (strcat (chr 10) "Был назначен текущий стиль штриховки " (chr 34) StyleName (chr 34)))
			  	(princ (strcat (chr 10) "Штриховка " (chr 34) StyleName (chr 34) " ненайдена среди штриховок АвтоКада"))
			)
		)
Но функция ERROR выводит ошибку: ; ошибка: no function definition: ERROR
Хотя в интернете есть описание такой функции. Почему эта функция не работает?
Как сделать так чтобы этот код работал?
Просмотров: 2039
 
Непрочитано 08.12.2022, 10:51
#2
Кулик Алексей aka kpblc
Moderator

LISP, C# (ACAD 200[9,12,13,14])
 
Регистрация: 25.08.2003
С.-Петербург
Сообщений: 40,430

Цитата:
Сообщение от МишаИнженер Посмотреть сообщение
В данном коде стоит задача: при удачном назначении значения системной переменной HPNAME вывести сообщение об удачном присвоении значения системной переменной, при неудачном назначении (системная переменная HPNAME не поменяла свое значение) вывести сообщение об отсутствии шаблона штриховки в среде АвтоКад:
Код:
[Выделить все] 
 
		((eq TypeObj "HATCH");Назначим текущий стиль штриховки
			(setq StyleName (cdr (assoc 2 dan)))
		 	(if (ERROR (setvar "HPNAME" StyleName))
				(princ (strcat (chr 10) "Был назначен текущий стиль штриховки " (chr 34) StyleName (chr 34)))
			  	(princ (strcat (chr 10) "Штриховка " (chr 34) StyleName (chr 34) " ненайдена среди штриховок АвтоКада"))
			)
		)
Но функция ERROR выводит ошибку: ; ошибка: no function definition: ERROR
Хотя в интернете есть описание такой функции. Почему эта функция не работает?
Как сделать так чтобы этот код работал?
А где определение функции error? В коде ее нет

----- добавлено через 37 сек. -----
Цитата:
Сообщение от МишаИнженер Посмотреть сообщение
Хотя в интернете есть описание такой функции.
Ссылочку пжалста
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Автор темы   Непрочитано 08.12.2022, 11:28
#3
МишаИнженер


 
Регистрация: 14.12.2008
Сообщений: 1,134

Цитата:
Сообщение от Кулик Алексей aka kpblc Посмотреть сообщение
Ссылочку пжалста
Пожалуйста вот ссылка: http://infobase.athn.ru/program/2017...#_Toc465260995
Там написано вот это:
(*error* <строка>)
Это, определяемая пользователем функция, трактующая ошибки. Если она не nil, она выполняется как функция всякий раз, когда присутствует проверка ошибок AutoLISP. Она выдает один аргумент — строку, состоящую из описания ошибки.
Например:
Код:
[Выделить все] 
 (defun *error* (msg)
(princ «error:»)
(princ msg)
(terpri)
)
Эта функция будет делать то же самое, что и стандартная функция трактовки ошибок AutoLISP — печать «error:» и описание.
А какие ещё есть функции обработки ошибок чтобы решить мою задачу?
Добавил определение функции error:
Код:
[Выделить все] 
 
(defun C:SetProp ()
	(while (setq el (car (entsel "\n Выбери объект:")))
	;entsel выдает имя объекта и все остальное, car - Извлекает первый элемент из списка: имя объекта
	;команды которые должны выполняться в цикле пока не будет пустой ввод
	  (setq dan (entget el));получает список с характеристиками примитива
	  (setq name0 (assoc 0 dan)) ;получаем имя объекта
	  (setq name (cdr name0))
	  (princ (strcat " " name))
;;;	  (alert (strcat "Был выбран " name))
	  (princ (strcat (chr 10) "========================================================="))
	  (princ (strcat (chr 10) "Был выбран " name))
	  (setq cLayer0 (assoc 8 dan)) ;получаем имя объекта
	  (setq cLayer (cdr cLayer0))
	  (setq cLWeight0 (assoc 370 dan)) ;получаем текущий вес линии
	  (setq cLWeight (cdr cLWeight0))
	  (setq cLType0 (assoc 6 dan)) ;получаем текущий тип линии
	  (setq cLType (cdr cLType0))  
	  (setq cLTypeScale0 (assoc 48 dan)) ;получаем текущий масштаб типа линии
	  (setq cLTypeScale (cdr cLTypeScale0))
	  (setq cColor0 (assoc 62 dan)) ;получаем текущий цвет
	  (setq cColor (cdr cColor0))
	  (setq cThick0 (assoc 39 dan)) ;получаем текующую толщину
	  (setq cThick (cdr cThick0))
	  
	;Назначим текущим слой выбранного объекта (setvar "clayer" <имя слоя>)
	  (setvar "clayer" cLayer)
	  (princ (strcat (chr 10) "Был назначен текущий слой " (chr 34) cLayer (chr 34)))
	;Назначим текущий вес линий
	  (cond ((eq cLWeight nil)
			(setvar "CELWEIGHT" -1)
			(princ (strcat (chr 10) "Был назначен текущий вес линий " (chr 34) "ПоСлою" (chr 34)))
			)
		((eq cLWeight -2)
			(setvar "CELWEIGHT" -2)
			(princ (strcat (chr 10) "Был назначен текущий вес линий " (chr 34) "ПоБлоку" (chr 34)))
			)
		((eq cLWeight -3)
			(setvar "CELWEIGHT" -3)
			(princ (strcat (chr 10) "Был назначен текущий вес линий " (chr 34) "ПоУмолчанию" (chr 34)))
			)
		(t 
			(setvar "CELWEIGHT" cLWeight)
			(princ (strcat (chr 10) "Был назначен текущий вес линий " (chr 34) (rtos (/ cLWeight 100.0)) (chr 34)))
		)
	   )
	;Назначим текущий тип линии
	  (cond ((eq cLType nil)
			(setvar "CELTYPE" "ByLayer")
			(princ (strcat (chr 10) "Был назначен текущий тип линий " (chr 34) "ПоСлою" (chr 34)))
			)
		(t 
			(setvar "CELTYPE" cLType)
			(princ (strcat (chr 10) "Был назначен текущий тип линий " (chr 34) cLType (chr 34)))
		)
	   )
	;Назначим текущий масштаб типа линии
	  (cond ((eq cLTypeScale nil)
			(setvar "CELTSCALE" 1)
			(princ (strcat (chr 10) "Был назначен текущий масштаб типа линий " (chr 34) "1" (chr 34)))
			)
		(t 
			(setvar "CELTSCALE" cLTypeScale)
			(princ (strcat (chr 10) "Был назначен текущий масштаб типа линий " (chr 34) (rtos cLTypeScale) (chr 34)))
		)
	   )
	;Назначим ткущий цвет чертежа
	  (cond ((eq cColor nil)
			(setvar "CECOLOR" "ByLayer")
			(princ (strcat (chr 10) "Был назначен текущий цвет " (chr 34) "ПоСлою" (chr 34)))
			)
		((eq cColor 0)
			(setvar "CECOLOR" "ByBlock")
			(princ (strcat (chr 10) "Был назначен текущий цвет " (chr 34) "ПоБлоку" (chr 34)))
			)
		(t 
			(setvar "CECOLOR" (rtos cColor))
			(princ (strcat (chr 10) "Был назначен текущий цвет " (chr 34) (rtos cColor) (chr 34)))
		)
	   )
	;Назначаем текущую толщину
	  (cond ((eq cThick nil)
			(setvar "THICKNESS" 0)
			(princ (strcat (chr 10) "Была назначена текущая толщина " (chr 34) "0" (chr 34)))
			)
		(t 
			(setvar "THICKNESS" cThick)
			(princ (strcat (chr 10) "Была назначена текущая толщина " (chr 34) (rtos cThick) (chr 34)))
		)
	   )
	;Назначим особые свойства для сложных объектов
	  (setq TypeObj (strcase name)) 
	  (cond 
		((eq TypeObj "ACAD_TABLE");Назначим текущий стиль таблиц
		 	(setq StyleName (vla-get-stylename (vlax-ename->vla-object el)))
			(setvar "CTABLESTYLE" StyleName)
			(princ (strcat (chr 10) "Был назначен текущий стиль таблиц " (chr 34) StyleName (chr 34)))
		)
		((eq TypeObj "MTEXT");Назначим текущий стиль текста
		 	(setq StyleName (vla-get-stylename (vlax-ename->vla-object el)))
			(setvar "TEXTSTYLE" StyleName)
			(princ (strcat (chr 10) "Был назначен текущий стиль текста " (chr 34) StyleName (chr 34)))
		)
		((eq TypeObj "MULTILEADER");Назначим текущий стиль мультивыносок
		 	(setq StyleName (vla-get-stylename (vlax-ename->vla-object el)))
			(setvar "CMLEADERSTYLE" StyleName)
			(princ (strcat (chr 10) "Был назначен текущий стиль мультивыносок " (chr 34) StyleName (chr 34)))
		)
		((eq TypeObj "MLINE");Назначим текущий стиль мультилинии
		 	(setq StyleName (vla-get-stylename (vlax-ename->vla-object el)))
			(setvar "CMLSTYLE" StyleName);CMLSCALE CMLJUST
			(princ (strcat (chr 10) "Был назначен текущий стиль мультилиний " (chr 34) StyleName (chr 34)))
		)
		((eq TypeObj "DIMENSION");Назначим текущий стиль размеров
		 	(setq StyleName (vla-get-stylename (vlax-ename->vla-object el)))
			(command "_-dimstyle" "_r" StyleName)
			(princ (strcat (chr 10) "Был назначен текущий стиль размеров " (chr 34) StyleName (chr 34)))
		)
		((eq TypeObj "HATCH");Назначим текущий стиль штриховки
			(setq StyleName (cdr (assoc 2 dan)))
		 	(if (ERROR (setvar "HPNAME" StyleName))
				(princ (strcat (chr 10) "Был назначен текущий стиль штриховки " (chr 34) StyleName (chr 34)))
			  	(princ (strcat (chr 10) "Штриховка " (chr 34) StyleName (chr 34) " не найдена среди штриховок АвтоКада"))
			)
		)
	  )
	)
)

(defun error (msg)
;;;	(princ «error:»)
;;;	(princ msg)
	(strlen msg)
;;;	(terpri)
)
При наличии штриховки в АвтоКаде ошибки не происходит и все работает. А если выделить штриховку шаблона которой нет в АвтоКаде (отсутствует файл *.pat в системных папках) тогда генерируется ошибка и не обрабатывается функцией error. Что это за встроенная функция Error которая не обрабатывает ошибки?
В ЛИСПЕ что, нет нормального механизма обработки ошибок?
Последний раз редактировалось МишаИнженер, 08.12.2022 в 11:42.
МишаИнженер вне форума  
 
Непрочитано 08.12.2022, 11:38
| 1 #4
Сергей812


 
Регистрация: 10.08.2013
Сообщений: 11,499

какие напишете, такие и будут) По ссылке, что давал Алексей вчера в теме обучения лиспу - явно не проходили.

Offtop: Зачем вообще в программирование полезли при такой нелюбви к чтению? Порой, чтобы найти несколько строчек для решения задачи - приходится десятки страниц справок и форумов просмотреть в инете. А вы лишь темы плодите самозабвенно)
Последний раз редактировалось Сергей812, 08.12.2022 в 11:43.
Сергей812 вне форума  
 
Автор темы   Непрочитано 08.12.2022, 11:45
#5
МишаИнженер


 
Регистрация: 14.12.2008
Сообщений: 1,134

Цитата:
Сообщение от Сергей812 Посмотреть сообщение
что давал Алексей вчера в теме обучения лиспу - явно не проходили.
Вчера я читал страницу с 4 функциями обработки ошибок на ЛИСП. Сегодня не могу найти эту страницу.
Можете дать ссылку на пост Алексея или на страницу?
МишаИнженер вне форума  
 
Непрочитано 08.12.2022, 12:30
#6
Кулик Алексей aka kpblc
Moderator

LISP, C# (ACAD 200[9,12,13,14])
 
Регистрация: 25.08.2003
С.-Петербург
Сообщений: 40,430

autolisp.ru -> поиск -> error
Если уж по своим собственным постам лень ходить - то это уже за гранью добра и зла...
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Последний раз редактировалось Кулик Алексей aka kpblc, 08.12.2022 в 12:45.
Кулик Алексей aka kpblc вне форума  
 
Непрочитано 08.12.2022, 12:40
#7
===AAA===


 
Регистрация: 15.08.2005
г. Норильск
Сообщений: 626

Я уже побаиваюсь писать - опять тему разделят...

а) Нужно не (error …), а (*error* …)
б) Ну хотя бы (princ msg) оставь - она же закомментирована у тебя.
Как ты поймешь, работает функция обработки ошибок или нет?
__________________
Счастливо, Алексей!
===AAA=== на форуме  
 
Автор темы   Непрочитано 08.12.2022, 13:18
#8
МишаИнженер


 
Регистрация: 14.12.2008
Сообщений: 1,134

Цитата:
Сообщение от Кулик Алексей aka kpblc Посмотреть сообщение
autolisp.ru -> поиск -> error
Не помогает. Там ничего нет на эту тему. Посмотрите принтскрин

----- добавлено через ~11 мин. -----
Цитата:
Сообщение от ===AAA=== Посмотреть сообщение
Нужно не (error …), а (*error* …)
Сделал как вы сказали:
Код:
[Выделить все] 
 
(defun C:SetProp ()
	(while (setq el (car (entsel "\n Выбери объект:")))
	;entsel выдает имя объекта и все остальное, car - Извлекает первый элемент из списка: имя объекта
	;команды которые должны выполняться в цикле пока не будет пустой ввод
	  (setq dan (entget el));получает список с характеристиками примитива
	  (setq name0 (assoc 0 dan)) ;получаем имя объекта
	  (setq name (cdr name0))
	  (princ (strcat " " name))
;;;	  (alert (strcat "Был выбран " name))
	  (princ (strcat (chr 10) "========================================================="))
	  (princ (strcat (chr 10) "Был выбран " name))
	  (setq cLayer0 (assoc 8 dan)) ;получаем имя объекта
	  (setq cLayer (cdr cLayer0))
	  (setq cLWeight0 (assoc 370 dan)) ;получаем текущий вес линии
	  (setq cLWeight (cdr cLWeight0))
	  (setq cLType0 (assoc 6 dan)) ;получаем текущий тип линии
	  (setq cLType (cdr cLType0))  
	  (setq cLTypeScale0 (assoc 48 dan)) ;получаем текущий масштаб типа линии
	  (setq cLTypeScale (cdr cLTypeScale0))
	  (setq cColor0 (assoc 62 dan)) ;получаем текущий цвет
	  (setq cColor (cdr cColor0))
	  (setq cThick0 (assoc 39 dan)) ;получаем текующую толщину
	  (setq cThick (cdr cThick0))
	  
	;Назначим текущим слой выбранного объекта (setvar "clayer" <имя слоя>)
	  (setvar "clayer" cLayer)
	  (princ (strcat (chr 10) "Был назначен текущий слой " (chr 34) cLayer (chr 34)))
	;Назначим текущий вес линий
	  (cond ((eq cLWeight nil)
			(setvar "CELWEIGHT" -1)
			(princ (strcat (chr 10) "Был назначен текущий вес линий " (chr 34) "ПоСлою" (chr 34)))
			)
		((eq cLWeight -2)
			(setvar "CELWEIGHT" -2)
			(princ (strcat (chr 10) "Был назначен текущий вес линий " (chr 34) "ПоБлоку" (chr 34)))
			)
		((eq cLWeight -3)
			(setvar "CELWEIGHT" -3)
			(princ (strcat (chr 10) "Был назначен текущий вес линий " (chr 34) "ПоУмолчанию" (chr 34)))
			)
		(t 
			(setvar "CELWEIGHT" cLWeight)
			(princ (strcat (chr 10) "Был назначен текущий вес линий " (chr 34) (rtos (/ cLWeight 100.0)) (chr 34)))
		)
	   )
	;Назначим текущий тип линии
	  (cond ((eq cLType nil)
			(setvar "CELTYPE" "ByLayer")
			(princ (strcat (chr 10) "Был назначен текущий тип линий " (chr 34) "ПоСлою" (chr 34)))
			)
		(t 
			(setvar "CELTYPE" cLType)
			(princ (strcat (chr 10) "Был назначен текущий тип линий " (chr 34) cLType (chr 34)))
		)
	   )
	;Назначим текущий масштаб типа линии
	  (cond ((eq cLTypeScale nil)
			(setvar "CELTSCALE" 1)
			(princ (strcat (chr 10) "Был назначен текущий масштаб типа линий " (chr 34) "1" (chr 34)))
			)
		(t 
			(setvar "CELTSCALE" cLTypeScale)
			(princ (strcat (chr 10) "Был назначен текущий масштаб типа линий " (chr 34) (rtos cLTypeScale) (chr 34)))
		)
	   )
	;Назначим ткущий цвет чертежа
	  (cond ((eq cColor nil)
			(setvar "CECOLOR" "ByLayer")
			(princ (strcat (chr 10) "Был назначен текущий цвет " (chr 34) "ПоСлою" (chr 34)))
			)
		((eq cColor 0)
			(setvar "CECOLOR" "ByBlock")
			(princ (strcat (chr 10) "Был назначен текущий цвет " (chr 34) "ПоБлоку" (chr 34)))
			)
		(t 
			(setvar "CECOLOR" (rtos cColor))
			(princ (strcat (chr 10) "Был назначен текущий цвет " (chr 34) (rtos cColor) (chr 34)))
		)
	   )
	;Назначаем текущую толщину
	  (cond ((eq cThick nil)
			(setvar "THICKNESS" 0)
			(princ (strcat (chr 10) "Была назначена текущая толщина " (chr 34) "0" (chr 34)))
			)
		(t 
			(setvar "THICKNESS" cThick)
			(princ (strcat (chr 10) "Была назначена текущая толщина " (chr 34) (rtos cThick) (chr 34)))
		)
	   )
	;Назначим особые свойства для сложных объектов
	  (setq TypeObj (strcase name)) 
	  (cond 
		((eq TypeObj "ACAD_TABLE");Назначим текущий стиль таблиц
		 	(setq StyleName (vla-get-stylename (vlax-ename->vla-object el)))
			(setvar "CTABLESTYLE" StyleName)
			(princ (strcat (chr 10) "Был назначен текущий стиль таблиц " (chr 34) StyleName (chr 34)))
		)
		((eq TypeObj "MTEXT");Назначим текущий стиль текста
		 	(setq StyleName (vla-get-stylename (vlax-ename->vla-object el)))
			(setvar "TEXTSTYLE" StyleName)
			(princ (strcat (chr 10) "Был назначен текущий стиль текста " (chr 34) StyleName (chr 34)))
		)
		((eq TypeObj "MULTILEADER");Назначим текущий стиль мультивыносок
		 	(setq StyleName (vla-get-stylename (vlax-ename->vla-object el)))
			(setvar "CMLEADERSTYLE" StyleName)
			(princ (strcat (chr 10) "Был назначен текущий стиль мультивыносок " (chr 34) StyleName (chr 34)))
		)
		((eq TypeObj "MLINE") ;Назначим текущий стиль мультилинии
		 	(setq StyleName (vla-get-stylename (vlax-ename->vla-object el)))
			(setvar "CMLSTYLE" StyleName)
			(princ (strcat (chr 10) "Был назначен текущий стиль мультилиний " (chr 34) StyleName (chr 34)))
		 	(setq ScaleMLine (cdr (assoc 40 dan))) ;получаем масштаб мультилинии
			(setvar "CMLSCALE" ScaleMLine)
			(princ (strcat (chr 10) "Был назначен текущий масштаб мультилиний " (chr 34) (rtos ScaleMLine) (chr 34)))
		 	(setq JustMLine (cdr (assoc 70 dan))) ;получаем выравнивание мультилинии
			(setvar "CMLJUST" JustMLine)
			(princ (strcat (chr 10) "Был назначено текущее выравнивание мультилиний " (chr 34) (rtos JustMLine) (chr 34)))
	 
		)
		((eq TypeObj "POLYLINE") ;Назначим текущий стиль 3D полилиний
		 	(setq WidthPLine (cdr (assoc 40 dan))) ;получаем ширину полилинии
			(setvar "PLINEWID" WidthPLine)
			(princ (strcat (chr 10) "Была назначена текущая ширина полилиний " (chr 34) (rtos WidthPLine) (chr 34)))
		 	(setq SmusPLine (cdr (assoc 75 dan))) ;получаем тип сглаживания полилинии
			(setvar "SPLINETYPE" SmusPLine)
			(princ (strcat (chr 10) "Была назначена текущий тип сглаживания полилиний " (chr 34) (rtos SmusPLine) (chr 34)))
		)
		((eq TypeObj "LWPOLYLINE") ;Назначим текущий стиль 2D полилиний
		 	(setq WidthPLine (cdr (assoc 40 dan))) ;получаем ширину полилинии
			(setvar "PLINEWID" WidthPLine)
			(princ (strcat (chr 10) "Была назначена текущая ширина полилиний " (chr 34) (rtos WidthPLine) (chr 34)))
		 	(setq GenPLine (cdr (assoc 70 dan))) ;получаем тип генерации полилинии
			(setvar "PLINEGEN" GenPLine)
			(princ (strcat (chr 10) "Была назначена текущий тип генерации полилиний " (chr 34) (rtos GenPLine) (chr 34)))
		)
		((eq TypeObj "DIMENSION") ;Назначим текущий стиль размеров
		 	(setq StyleName (vla-get-stylename (vlax-ename->vla-object el)))
			(command "_-dimstyle" "_r" StyleName)
			(princ (strcat (chr 10) "Был назначен текущий стиль размеров " (chr 34) StyleName (chr 34)))
		)
		((eq TypeObj "HATCH") ;Назначим текущий стиль штриховки
			(setq StyleName (cdr (assoc 2 dan)))
		 	(if (*error* (setvar "HPNAME" StyleName))
				(princ (strcat (chr 10) "Был назначен текущий стиль штриховки " (chr 34) StyleName (chr 34)))
			  	(princ (strcat (chr 10) "Штриховка " (chr 34) StyleName (chr 34) " не найдена среди штриховок АвтоКада"))
			)
		)
	  )
	  (princ (strcat (chr 10) "========================================================="))
	)
)

(defun *error* (msg)
;;;	(princ «error:»)
	(princ msg)
	(strlen msg)
;;;	(terpri)
)
Теперь функция стала более вежливо вылетать и уже из подпрограммы (defun *error*
Выводит при этом сообщение: Настройка переменной AutoCAD отвергнута: "HPNAME" "CONSIST"; выход после ошибки
Как можно отключить этот "выход после ошибки", (сделать "обнуление ошибок") и продолжить выполнение программы?
Миниатюры
Нажмите на изображение для увеличения Название: AutoLispRU_Поиск_Error.png Просмотров: 11 Размер: 183.4 Кб ID: 251827  
МишаИнженер вне форума  
 
Непрочитано 08.12.2022, 13:34
1 | #9
===AAA===


 
Регистрация: 15.08.2005
г. Норильск
Сообщений: 626

Тогда или анализируй каждую переменную перед использованием
(в данном случае, перед тем, как скармливать её функции setvar)
или смотри в сторону функции vl-catch-all-apply.
__________________
Счастливо, Алексей!
===AAA=== на форуме  
 
Непрочитано 08.12.2022, 13:38
1 | #10
Кулик Алексей aka kpblc
Moderator

LISP, C# (ACAD 200[9,12,13,14])
 
Регистрация: 25.08.2003
С.-Петербург
Сообщений: 40,430

МишаИнженер, не помешает нажать кнопку "Найти" и полистать страницу.

----- добавлено через ~10 мин. -----
Сильно подозреваю, что ТС не хватит терпения прочитать на сайте. И не хватит времени пройтись по собственным темам. Ну да, ну да, остальным-то делать нечего...
Лови в очередной раз : https://autolisp.ru/2009/09/13/error-catch/
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Непрочитано 08.12.2022, 13:52
1 | #11
koMon


 
Блог
 
Регистрация: 26.09.2017
Сообщений: 1,814

переназначать встроенную функцию *error* это как-то неправильно, имхо
м.б. лучше так
Код:
[Выделить все] 
 (if (null (vl-catch-all-error-p (vl-catch-all-apply 'setvar (list 'hpname StyleName))))
	(princ (strcat (chr 10) "Был назначен текущий стиль штриховки " (chr 34) StyleName (chr 34)))
        (princ (strcat (chr 10) "Штриховка " (chr 34) StyleName (chr 34) " не найдена среди штриховок АвтоКада"))
)
__________________
K Lisp
koMon вне форума  
 
Непрочитано 08.12.2022, 14:08
#12
Кулик Алексей aka kpblc
Moderator

LISP, C# (ACAD 200[9,12,13,14])
 
Регистрация: 25.08.2003
С.-Петербург
Сообщений: 40,430

ТС подправил код, так что неактуально
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Непрочитано 08.12.2022, 14:15
#13
koMon


 
Блог
 
Регистрация: 26.09.2017
Сообщений: 1,814

не следил
__________________
K Lisp
koMon вне форума  
 
Автор темы   Непрочитано 08.12.2022, 16:26
#14
МишаИнженер


 
Регистрация: 14.12.2008
Сообщений: 1,134

Цитата:
Сообщение от koMon Посмотреть сообщение
м.б. лучше так
Круто! Все работает! Спасибо большое!
Код:
[Выделить все] 
 
(defun C:SetProp ()
	(while (setq el (car (entsel "\n Выбери объект:")))
	;entsel выдает имя объекта и все остальное, car - Извлекает первый элемент из списка: имя объекта
	;команды которые должны выполняться в цикле пока не будет пустой ввод
	  (setq dan (entget el));получает список с характеристиками примитива
	  (setq name0 (assoc 0 dan)) ;получаем имя объекта
	  (setq name (cdr name0))
	  (princ (strcat " " name))
;;;	  (alert (strcat "Был выбран " name))
	  (princ (strcat (chr 10) "========================================================="))
	  (princ (strcat (chr 10) "Был выбран " name))
	  (setq cLayer0 (assoc 8 dan)) ;получаем имя объекта
	  (setq cLayer (cdr cLayer0))
	  (setq cLWeight0 (assoc 370 dan)) ;получаем текущий вес линии
	  (setq cLWeight (cdr cLWeight0))
	  (setq cLType0 (assoc 6 dan)) ;получаем текущий тип линии
	  (setq cLType (cdr cLType0))  
	  (setq cLTypeScale0 (assoc 48 dan)) ;получаем текущий масштаб типа линии
	  (setq cLTypeScale (cdr cLTypeScale0))
	  (setq cColor0 (assoc 62 dan)) ;получаем текущий цвет
	  (setq cColor (cdr cColor0))
	  (setq cThick0 (assoc 39 dan)) ;получаем текующую толщину
	  (setq cThick (cdr cThick0))
	  
	;Назначим текущим слой выбранного объекта (setvar "clayer" <имя слоя>)
	  (setvar "clayer" cLayer)
	  (princ (strcat (chr 10) "Был назначен текущий слой " (chr 34) cLayer (chr 34)))
	;Назначим текущий вес линий
	  (cond ((eq cLWeight nil)
			(setvar "CELWEIGHT" -1)
			(princ (strcat (chr 10) "Был назначен текущий вес линий " (chr 34) "ПоСлою" (chr 34)))
			)
		((eq cLWeight -2)
			(setvar "CELWEIGHT" -2)
			(princ (strcat (chr 10) "Был назначен текущий вес линий " (chr 34) "ПоБлоку" (chr 34)))
			)
		((eq cLWeight -3)
			(setvar "CELWEIGHT" -3)
			(princ (strcat (chr 10) "Был назначен текущий вес линий " (chr 34) "ПоУмолчанию" (chr 34)))
			)
		(t 
			(setvar "CELWEIGHT" cLWeight)
			(princ (strcat (chr 10) "Был назначен текущий вес линий " (chr 34) (rtos (/ cLWeight 100.0)) (chr 34)))
		)
	   )
	;Назначим текущий тип линии
	  (cond ((eq cLType nil)
			(setvar "CELTYPE" "ByLayer")
			(princ (strcat (chr 10) "Был назначен текущий тип линий " (chr 34) "ПоСлою" (chr 34)))
			)
		(t 
			(setvar "CELTYPE" cLType)
			(princ (strcat (chr 10) "Был назначен текущий тип линий " (chr 34) cLType (chr 34)))
		)
	   )
	;Назначим текущий масштаб типа линии
	  (cond ((eq cLTypeScale nil)
			(setvar "CELTSCALE" 1)
			(princ (strcat (chr 10) "Был назначен текущий масштаб типа линий " (chr 34) "1" (chr 34)))
			)
		(t 
			(setvar "CELTSCALE" cLTypeScale)
			(princ (strcat (chr 10) "Был назначен текущий масштаб типа линий " (chr 34) (rtos cLTypeScale) (chr 34)))
		)
	   )
	;Назначим ткущий цвет чертежа
	  (cond ((eq cColor nil)
			(setvar "CECOLOR" "ByLayer")
			(princ (strcat (chr 10) "Был назначен текущий цвет " (chr 34) "ПоСлою" (chr 34)))
			)
		((eq cColor 0)
			(setvar "CECOLOR" "ByBlock")
			(princ (strcat (chr 10) "Был назначен текущий цвет " (chr 34) "ПоБлоку" (chr 34)))
			)
		(t 
			(setvar "CECOLOR" (rtos cColor))
			(princ (strcat (chr 10) "Был назначен текущий цвет " (chr 34) (rtos cColor) (chr 34)))
		)
	   )
	;Назначаем текущую толщину
	  (cond ((eq cThick nil)
			(setvar "THICKNESS" 0)
			(princ (strcat (chr 10) "Была назначена текущая толщина " (chr 34) "0" (chr 34)))
			)
		(t 
			(setvar "THICKNESS" cThick)
			(princ (strcat (chr 10) "Была назначена текущая толщина " (chr 34) (rtos cThick) (chr 34)))
		)
	   )
	;Назначим особые свойства для сложных объектов
	  (setq TypeObj (strcase name)) 
	  (cond 
		((eq TypeObj "ACAD_TABLE");Назначим текущий стиль таблиц
		 	(setq StyleName (vla-get-stylename (vlax-ename->vla-object el)))
			(setvar "CTABLESTYLE" StyleName)
			(princ (strcat (chr 10) "Был назначен текущий стиль таблиц " (chr 34) StyleName (chr 34)))
		)
		((eq TypeObj "MTEXT");Назначим текущий стиль текста
		 	(setq StyleName (vla-get-stylename (vlax-ename->vla-object el)))
			(setvar "TEXTSTYLE" StyleName)
			(princ (strcat (chr 10) "Был назначен текущий стиль текста " (chr 34) StyleName (chr 34)))
		)
		((eq TypeObj "MULTILEADER");Назначим текущий стиль мультивыносок
		 	(setq StyleName (vla-get-stylename (vlax-ename->vla-object el)))
			(setvar "CMLEADERSTYLE" StyleName)
			(princ (strcat (chr 10) "Был назначен текущий стиль мультивыносок " (chr 34) StyleName (chr 34)))
		)
		((eq TypeObj "MLINE") ;Назначим текущий стиль мультилинии
		 	(setq StyleName (vla-get-stylename (vlax-ename->vla-object el)))
			(setvar "CMLSTYLE" StyleName)
			(princ (strcat (chr 10) "Был назначен текущий стиль мультилиний " (chr 34) StyleName (chr 34)))
		 	(setq ScaleMLine (cdr (assoc 40 dan))) ;получаем масштаб мультилинии
			(setvar "CMLSCALE" ScaleMLine)
			(princ (strcat (chr 10) "Был назначен текущий масштаб мультилиний " (chr 34) (rtos ScaleMLine) (chr 34)))
		 	(setq JustMLine (cdr (assoc 70 dan))) ;получаем выравнивание мультилинии
			(setvar "CMLJUST" JustMLine)
			(princ (strcat (chr 10) "Был назначено текущее выравнивание мультилиний " (chr 34) (rtos JustMLine) (chr 34)))
	 
		)
		((eq TypeObj "POLYLINE") ;Назначим текущий стиль 3D полилиний
		 	(setq WidthPLine (cdr (assoc 40 dan))) ;получаем ширину полилинии
			(setvar "PLINEWID" WidthPLine)
			(princ (strcat (chr 10) "Была назначена текущая ширина полилиний " (chr 34) (rtos WidthPLine) (chr 34)))
		 	(setq SmusPLine (cdr (assoc 75 dan))) ;получаем тип сглаживания полилинии
			(setvar "SPLINETYPE" SmusPLine)
			(princ (strcat (chr 10) "Была назначена текущий тип сглаживания полилиний " (chr 34) (rtos SmusPLine) (chr 34)))
		)
		((eq TypeObj "LWPOLYLINE") ;Назначим текущий стиль 2D полилиний
		 	(setq WidthPLine (cdr (assoc 40 dan))) ;получаем ширину полилинии
			(setvar "PLINEWID" WidthPLine)
			(princ (strcat (chr 10) "Была назначена текущая ширина полилиний " (chr 34) (rtos WidthPLine) (chr 34)))
		 	(setq GenPLine (cdr (assoc 70 dan))) ;получаем тип генерации полилинии
			(setvar "PLINEGEN" GenPLine)
			(princ (strcat (chr 10) "Была назначена текущий тип генерации полилиний " (chr 34) (rtos GenPLine) (chr 34)))
		)
		((eq TypeObj "DIMENSION") ;Назначим текущий стиль размеров
		 	(setq StyleName (vla-get-stylename (vlax-ename->vla-object el)))
			(command "_-dimstyle" "_r" StyleName)
			(princ (strcat (chr 10) "Был назначен текущий стиль размеров " (chr 34) StyleName (chr 34)))
		)
		((eq TypeObj "HATCH") ;Назначим текущий стиль штриховки
			(setq StyleName (cdr (assoc 2 dan)))
			(if (null (vl-catch-all-error-p (vl-catch-all-apply 'setvar (list 'hpname StyleName))))
				(princ (strcat (chr 10) "Был назначен текущий стиль штриховки " (chr 34) StyleName (chr 34)))
			    (princ (strcat (chr 10) "Штриховка " (chr 34) StyleName (chr 34) " не найдена среди штриховок АвтоКада"))
			)
		)
	  )
	  (princ (strcat (chr 10) "========================================================="))
	)
)
МишаИнженер вне форума  
Ответ
Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > LISP > Почему функция error не обрабатывает появление ошибки при назначении системной переменной?



Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Не вычисляется функция и не строится график из-за ошибки в MATHCAD aborigen1 Прочее. Программное обеспечение 3 11.01.2016 15:11
AutoCAD 2013 Rus SP2 СПДС при проверке _audit находит и исправляет ошибки но, повторная проверка опять указывает на тоже zoro ПО от CSoft 10 06.08.2013 00:33
Почему если верхний предел интегрирования указан переменной z0 то интеграл НЕ вычисляется МишаИнженер Прочее. Программное обеспечение 6 06.01.2011 05:47
Ошибки в сортаментах (покушение на основы) IBZ Разное 18 02.09.2008 13:03
Функция rem Владимир М Программирование 5 20.12.2005 17:13

Обратная связь - Вверх