Почему не работает код для установки текущего размерного стиля на ЛИСП?

МишаИнженер · 06.12.2022, 08:23

В конце программы есть код для установки текущего размерного стиля путем назначения значения системной переменной "DIMSTYLE".
Но почему-то в эту переменную "DIMSTYLE" текущий размерный стиль не хочет записываться.
Почему это происходит и как это исправить?
(Для работы программы запустите её и выделите размер на экране)

Код:

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

 
(while (setq el (car (entsel "\n Выбери объект:")))
;entsel выдает имя объекта и все остальное, car - Извлекает первый элемент из списка: имя объекта
;команды которые должны выполняться в цикле пока не будет пустой ввод
  (setq dan (entget el));получает список с характеристиками примитива
  (setq name0 (assoc 0 dan)) ;получаем имя объекта
  (setq name (cdr name0))
  (princ name)
;;;  (alert (strcat "Был выбран " name))
  (princ (strcat "Был выбран " 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 StyleTable (vla-get-stylename (vlax-ename->vla-object el)))
		(setvar "CTABLESTYLE" StyleTable)
		(princ (strcat (chr 10) "Был назначен текущий стиль таблиц " (chr 34) StyleTable (chr 34)))
	)
	((eq TypeObj "MTEXT");Назначим текущий стиль текста
	 	(setq StyleTable (vla-get-stylename (vlax-ename->vla-object el)))
		(setvar "TEXTSTYLE" StyleTable)
		(princ (strcat (chr 10) "Был назначен текущий стиль текста " (chr 34) StyleTable (chr 34)))
	)
	((eq TypeObj "MULTILEADER");Назначим текущий стиль мультивыносок
	 	(setq StyleTable (vla-get-stylename (vlax-ename->vla-object el)))
		(setvar "CMLEADERSTYLE" StyleTable)
		(princ (strcat (chr 10) "Был назначен текущий стиль мультивыносок " (chr 34) StyleTable (chr 34)))
	)
	((eq TypeObj "MLINE");Назначим текущий стиль мультилинии
	 	(setq StyleTable (vla-get-stylename (vlax-ename->vla-object el)))
		(setvar "CMLSTYLE" StyleTable);CMLSCALE CMLJUST
		(princ (strcat (chr 10) "Был назначен текущий стиль мультилиний " (chr 34) StyleTable (chr 34)))
	)
	((eq TypeObj "DIMENSION");Назначим текущий стиль размеров
	 	(setq StyleTable (vla-get-stylename (vlax-ename->vla-object el)))
		(setvar "DIMSTYLE" StyleTable);Почему не работает код для установки текущего размерного стиля?
		(princ (strcat (chr 10) "Был назначен текущий стиль размеров " (chr 34) StyleTable (chr 34)))
	)

  )
)


;;;(vla-put-activedimstyle
;;;  (vla-get-activedocument (vlax-get-acad-object))
;;;  (vla-item
;;;    (vla-get-dimstyles
;;;      (vla-get-activedocument (vlax-get-acad-object))
;;;    )
;;;    (cdr (assoc 3 (entget (car (entsel)))))
;;;  ) ;_ end of vla-item
;;;) ;_ end of vla-put-ActiveDimStyle

Помогите назначить текущий размерный стиль.

===AAA=== · 06.12.2022, 08:56

Может быть потому, что переменная DIMSTYLE предназначена только для чтения?

Кулик Алексей aka kpblc · 06.12.2022, 09:10

Потому что справку надо внимательно читать:
https://knowledge.autodesk.com/suppo...9A112-htm.html

Цитата:

The DIMSTYLE system variable is read-only; to change the current dimension style, use the DIMSTYLE command.

Konstr_pgs · 06.12.2022, 09:54

Может отсюда взять, код 1958

Код:

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

 ;;;Установить размерный стиль текущим и продолжать им образмеривать
;;; http://geodesist.ru/members/1958.30261/
;;; 23 июня 2022г.
(defun c:ds (/)
 (vla-put-activedimstyle
  (vla-get-activedocument (vlax-get-acad-object))
  (vla-item (vla-get-dimstyles (vla-get-activedocument (vlax-get-acad-object)))
            (cdr (assoc 3 (entget (car (entsel)))))
  )
 )
)
 ;|«Visual LISP© Format Options»
(100 1 2 2 nil " " 80 60 0 0 0 nil nil nil T)
;*** НЕ добавляйте текст под комментариями! ***|;

МишаИнженер · 06.12.2022, 09:56

Цитата:

Сообщение от ===AAA===

Может быть потому, что переменная DIMSTYLE предназначена только для чтения?

Да, я читал про это в справке:

Цитата:

DIMSTYLE является, и командой и системной переменной. DIMSTYLE системная переменная показывает текущий размерный стиль. Чтобы показывать системную переменную DIMSTYLE , используется команда SETVAR. DIMSTYLE системная переменная только для чтения; Вы не можете изменять ее значение из командной строки. Чтобы изменять текущий размерный стиль, используйте команду DIMSTYLE.

В справке написано "Чтобы изменять текущий размерный стиль, используйте команду DIMSTYLE" и как это понимать?
http://www.cad.dp.ua/stats/cad2000-2.php#sec035

Кулик Алексей aka kpblc · 06.12.2022, 10:08

Понимать как требование вызова команды.

koMon · 06.12.2022, 10:09

(setq dimstyle (vla-get-stylename (vlax-ename->vla-object el)))
(command "_-dimstyle" "_r" dimstyle)

МишаИнженер · 06.12.2022, 10:25

Цитата:

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

(setq dimstyle (vla-get-stylename (vlax-ename->vla-object el)))
(command "_-dimstyle" "_r" dimstyle)

Да, так работает! Спасибо большое!

Код:

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

 
(while (setq el (car (entsel "\n Выбери объект:")))
;entsel выдает имя объекта и все остальное, car - Извлекает первый элемент из списка: имя объекта
;команды которые должны выполняться в цикле пока не будет пустой ввод
  (setq dan (entget el));получает список с характеристиками примитива
  (setq name0 (assoc 0 dan)) ;получаем имя объекта
  (setq name (cdr name0))
  (princ name)
;;;  (alert (strcat "Был выбран " name))
  (princ (strcat "Был выбран " 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)))
	)

  )
)

Похожие темы
Тема	Автор	Раздел	Ответов	Последнее сообщение
Почему появляется $0 в названии размерного стиля? Слетает аннотативность. AutoCAD 2016	Lana Colt	AutoCAD	4	12.02.2021 10:01
Почему некорректно работает координатный фильтр?	P_S	LISP	2	06.03.2017 10:24
Изменение настроек размерного стиля в AutoCAD в группе чертежей сразу	Shampun	AutoCAD	1	16.03.2015 20:54
Почему не работает entdel	hydushko	Программирование	1	18.04.2013 07:52
почему то не работает Лисп	Август	LISP	15	13.04.2011 09:42