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

tsetse · 05.03.2019, 08:40

Добрый день! Используя стандартную справку автокада и пример по activex у меня получилось создать свой стиль таблицы, добавить туда пользовательский стиль ячеек. Вопрос в том, как "вписать" в этот стиль ячеек стиль текста. Высота текста передается с помощью

Код:

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

 (vla-SetTextHeight2 customObj "Наименование" 2.5)

А вот с стилем текста проблемы. Пробовал так

Код:

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

 (vla-SetTextStyle customObj "Наименование" text-style-name)

Выдает ошибку ; error: lisp value has no coercion to VARIANT with this type: "!Форма_ГОСТ"
Пробовал так

Код:

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

 (vla-SetTextStyleid customObj "Наименование" text-style-name)

Результат аналогичный.
Вот полностью код

Код:

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

 (defun c:Example_CellStyle()
;; This example creates a TableStyle object and sets values for
;; the style name and formatting.
(vl-load-com)
(setq acadObj (vlax-get-acad-object))
(setq doc (vla-get-ActiveDocument acadObj)) ;указатель на активный документ
(setq text-style-name "!ГОСТ") ; Имя стиля текста таблицы
(setq keyName "Спецификация ЖБ") ;имя нового стия
(setq className "AcDbTableStyle") ;отметка класса объекта табличного стиля
; проверяем существование стиля keyName
; этот фрагмент взял тут http://forum.dwg.ru/showpost.php?p=295877&postcount=120 у VVA
(if
	(and
		(setq tb-dic (dictsearch (namedobjdict) "ACAD_TABLESTYLE"))
			(not
				(setq ret
					(member
						(strcase keyName)
						(mapcar 'strcase
							(mapcar 'cdr
								(vl-remove-if-not
									(function (lambda (x) (= (car x) 3)))
									tb-dic
								) ;end of vl-remove-if-not
							) ;end of mapcar
						) ;end of mapcar
					) ;end of member
				) ;end of setq
			) ;end of not
	) ;end of and
; если стиля таблицы keyName нет, то создаем его
	(progn
		(setq dictionaries (vla-get-Dictionaries doc)) ;загрузка библиотек
		(setq dictObj (vla-Item dictionaries "acad_tablestyle")) ;загрузка библиотеки табличных стилей
		(setq customObj (vla-AddObject dictObj keyName className))  ;добавление в библиотеку табличных стилей нового
   		(vla-put-Description customObj "Стиль спецификации армирования")  ;описание нового стиля
		(vla-put-BitFlags customObj 1) ; если не трудно поясните, что это означает
		(vla-SetTextStyle customObj (+ acDataRow acTitleRow acHeaderRow) text-style-name)  ;для стандартных стилей ячеек стиль устанавливается
		(vla-CreateCellStyle customObj "Наименование") ;добавление стиля ячеек
		(vla-SetCellClass customObj "Наименование" 4) ; я не понял, что эта функция делает, но в примере с установкой высоты текста она была
		(vla-SetTextHeight2 customObj "Наименование" 2.5) ;высота текста устанавливается
		(vla-SetTextStyleId customObj "Наименование" text-style-name) ; первый вариант
		;(vla-SetTextStyle customObj "Наименование" text-style-name)
		(vla-SetGridVisibility customObj (+ acHorzInside acHorzTop) (+ acDataRow acTitleRow acHeaderRow) :vlax-false)
    		(setq numOfStyles (vla-get-NumCellStyles customObj))
    		(alert (strcat "Number of Cell Styles = " (itoa numOfStyles)))
	) ;end of progn
(alert "Такой стиль уже есть!")
) ;end of if
)

----- добавлено через ~35 мин. -----
Выяснил проблему. В случае vla-SetTextStyleId нужно передавать не название текстового стиля, а его id.
Получилось так:

Код:

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

 (setq eeee (vla-GetTextStyleId customObj "Data"))
(vla-SetTextStyleId customObj "Наименование" eeee)

Текстовый стиль для data был задан ранее так

Код:

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

 (vla-SetTextStyle customObj (+ acDataRow acTitleRow acHeaderRow) text-style-name)

tsetse · 11.03.2019, 15:19

Вот, что получилось. Достаточно сложный стиль, надеюсь кому-то пригодится

Код:

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

 
; Тут создается стиль таблиц Спецификация_ЖБ при необходимости
(defun Create_Cell_Style ()
(vl-load-com)
(setq acadObj (vlax-get-acad-object))
(setq doc (vla-get-ActiveDocument acadObj)) ;указатель на активный документ
(setq text-style-name "!Форма_ГОСТ") ; Имя стиля текста таблицы
(setq text-font-file  "ISOCPEUR.TTF") ; Файл шрифта стиля текста таблицы
(text-style-make text-style-name text-font-file)
; Выбор цветов
(setq bcolor nil)
(setq bcolor
	(vla-GetInterfaceObject
  		(vlax-get-acad-object)
   		(strcat 
			"AutoCAD.AcCmColor." (substr (getvar "acadver") 1 2)
		)
	) ;end of vla-GetInterfaceObject
) ;end of setq

(setq bcolor1 nil)
(setq bcolor1
(vla-GetInterfaceObject
  	(vlax-get-acad-object)
   		(strcat 
			"AutoCAD.AcCmColor." (substr (getvar "acadver") 1 2)
		)
	) ;end of vla-GetInterfaceObject
) ;end of setq

(setq bcolor2 nil)
(setq bcolor2
(vla-GetInterfaceObject
	(vlax-get-acad-object)
	(strcat 
		"AutoCAD.AcCmColor." (substr (getvar "acadver") 1 2)
	)
	)
)
(vla-put-colorindex bcolor 2)
(vla-put-colorindex bcolor1 3)
(vla-put-colorindex bcolor2 255)
(setq keyName "Спецификация ЖБ") ;имя нового стия
(setq className "AcDbTableStyle") ;отметка класса объекта табличного стиля
; проверяем существование стиля keyName
(if
	(and
		(setq tb-dic (dictsearch (namedobjdict) "ACAD_TABLESTYLE"))
			(not
				(setq ret
					(member
						(strcase keyName)
						(mapcar 'strcase
							(mapcar 'cdr
								(vl-remove-if-not
									(function (lambda (x) (= (car x) 3)))
									tb-dic
								) ;end of vl-remove-if-not
							) ;end of mapcar
						) ;end of mapcar
					) ;end of member
				) ;end of setq
			) ;end of not
	) ;end of and
; если стиля таблицы keyName нет, то создаем его
	(progn
		(setq dictionaries (vla-get-Dictionaries doc)) ;загрузка библиотек
		(setq dictObj (vla-Item dictionaries "acad_tablestyle")) ;загрузка библиотеки табличных стилей
		(setq customObj (vla-AddObject dictObj keyName className))  ;добавление в библиотеку табличных стилей нового
   		(vla-put-Description customObj "Стиль спецификации армирования")  ;описание нового стиля
		(vla-put-BitFlags customObj 1)

		; настраиваем базовые стили ячеек
		(vla-SetTextStyle customObj (+ acTitleRow acHeaderRow acDataRow acUnknownRow) text-style-name) ;текстовый стиль
		(vla-SetTextHeight customObj (+ acTitleRow) 5) ;высота текста
		(vla-SetTextHeight customObj (+ acDataRow acHeaderRow acUnknownRow) 2.5) ;высота текста

		(vla-SetAlignment customObj (+ acTitleRow acHeaderRow acDataRow acUnknownRow) acMiddleCenter) ;выравнивание

		(vla-SetGridVisibility customObj
		(+ acHorzBottom acHorzInside acHorzTop acInvalidGridLine acVertInside acVertLeft acVertRight)	
		(+ acTitleRow acHeaderRow acDataRow acUnknownRow)
		:vlax-true)  ;включение всех границ

		(vla-SetGridLineWeight customObj
		(+ acHorzBottom acHorzInside acHorzTop acInvalidGridLine acVertInside acVertLeft acVertRight)
		(+ acTitleRow acHeaderRow acUnknownRow)
		acLnWt030)  ;установка толщины всех границ для header и title
		
		(vla-SetGridColor customObj
		(+ acHorzBottom acHorzInside acHorzTop acInvalidGridLine acVertInside acVertLeft acVertRight)
		(+ acTitleRow acHeaderRow acUnknownRow)
		bcolor)   ;установка цвета всех границ для header и title

		(vla-SetGridLineWeight customObj
		(+ acHorzBottom acHorzTop acInvalidGridLine acVertInside acVertLeft acVertRight)
		(+ acDataRow)
		acLnWt030)   ;установка толщины границ для data

		(vla-SetGridColor customObj
		(+ acHorzBottom acHorzTop acInvalidGridLine acVertInside acVertLeft acVertRight)
		(+ acDataRow)
		bcolor)   ;установка цвета границ для data

		(vla-SetGridLineWeight customObj
		(+ acHorzInside)
		(+ acDataRow)
		acLnWt015)   ;установка толщины границ для data


		(vla-SetGridColor customObj
		(+ acHorzInside)
		(+ acDataRow)
		bcolor1)   ;установка цвета границ для data

		(setq eeee (vla-GetTextStyleId customObj "Data")) ; читаем id текстового стиля из data

		(vla-CreateCellStyle customObj "Наименование") ;добавление стиля ячеек
		(vla-SetCellClass customObj "Наименование" 4) ;id стиля
		(vla-SetTextHeight2 customObj "Наименование" 2.5) ;высота текста
		(vla-SetTextStyleId customObj "Наименование" eeee) ;стиль текста
		(vla-SetAlignment2 customObj "Наименование" acMiddleCenter) ; выравнивание

		(vla-SetGridVisibility2 customObj "Наименование"
		(+ acHorzBottom acHorzInside acHorzTop acInvalidGridLine acVertLeft acVertRight)	
		:vlax-true)  ;включение всех границ

		(vla-SetGridVisibility2 customObj "Наименование"
		(+ acVertInside)	
		:vlax-false)  ;выключение вертикальны границ

		(vla-SetGridLineWeight2 customObj "Наименование"
		(+ acHorzBottom acHorzTop acInvalidGridLine acVertLeft acVertRight)
		acLnWt030)   ;установка цвета всех границ для header и title

		(vla-SetGridColor2 customObj "Наименование"
		(+ acHorzBottom acHorzTop acInvalidGridLine acVertLeft acVertRight)
		bcolor)   ;установка цвета всех границ для header и title

		(vla-SetGridLineWeight2 customObj "Наименование"
		(+ acHorzInside)
		acLnWt015)   ;установка цвета всех границ для header и title

		(vla-SetGridColor2 customObj "Наименование"
		(+ acHorzInside)
		bcolor1)   ;установка цвета всех границ для header и title


		(vla-CreateCellStyle customObj "Дополнительный") ;добавление стиля ячеек
		(vla-SetCellClass customObj "Дополнительный" 5) ;id стиля
		(vla-SetTextHeight2 customObj "Дополнительный" 1) ;высота текста
		(vla-SetTextStyleId customObj "Дополнительный" eeee) ;стиль текста
		(vla-SetAlignment2 customObj "Дополнительный" acMiddleCenter) ; выравнивание

		(vla-SetGridVisibility2 customObj "Дополнительный"
		(+ acHorzBottom acHorzInside acHorzTop acInvalidGridLine acVertInside acVertRight)	
		:vlax-false)  ;выключение всех границ

		(vla-SetGridVisibility2 customObj "Дополнительный"
		(+ acVertLeft)	
		:vlax-true)  ;включение левой границы

		(vla-SetGridLineWeight2 customObj "Дополнительный"
		(+ acVertLeft)	
		acLnWt030)  ;толщина левой границы

		(vla-SetGridColor2 customObj "Дополнительный"
		(+ acVertLeft)	
		bcolor)  ;цвет левой границы

		(vla-SetColor2 customObj "Дополнительный" bcolor2)
	) ;end of progn
) ;end of if
) ;end of defun

; _____________________________________________________________________
; Тут создается текстовый стиль при необходимости спасибо VVA http://forum.dwg.ru
(defun text-style-make (text-style-name text-font-file / text_style)
	(if (not (tblsearch "STYLE" text-style-name))
		(progn
			(setq text_style  (vla-add (vla-get-textstyles (vla-get-activedocument (vlax-get-acad-object))) text-style-name))
			(setq currFontFile (findfile (strcat (getenv "WinDir") "\\Fonts\\" text-font-file)))
			(vla-put-fontfile text_style currFontFile) ; Файл шрифта текстового стиля
			(vla-put-height text_style 0.0) ;Высота шрифта
			(vla-put-width text_style 1.0);Степень сжатия/растяжения
		) ;end of progn
	)
)

Присвоение таблице стиля как-то так

Код:

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

 	
		(vla-put-StyleName arm_table "Спецификация ЖБ")

(repeat (+ nlines_stergni nlines_element )
			(vla-setRowHeight arm_table (+ i 2) 6)
			(vla-SetCellStyle arm_table (+ i 2) 0 "Data")
			(vla-SetCellStyle arm_table (+ i 2) 1 "Наименование")
			(vla-SetCellStyle arm_table (+ i 2) 2 "Наименование")
			(vla-SetCellStyle arm_table (+ i 2) 3 "Наименование")
			(vla-SetCellStyle arm_table (+ i 2) 4 "Наименование")
			(vla-SetCellStyle arm_table (+ i 2) 5 "Наименование")
			(vla-SetCellStyle arm_table (+ i 2) 6 "Data")
			(vla-SetCellStyle arm_table (+ i 2) 7 "Data")
			(vla-SetCellStyle arm_table (+ i 2) 8 "Data")
			(vla-SetCellStyle arm_table (+ i 2) 9 "Data")
			(vla-SetCellStyle arm_table (+ i 2) 10 "Дополнительный")
			(setq i (1+ i))
		) ;end of repeat

Похожие темы
Тема	Автор	Раздел	Ответов	Последнее сообщение
Как вывести максимальное\минимальное значение из интервала ячеек таблицы	Blastoderm	AutoCAD	8	07.06.2017 18:14
Одна из ячеек таблицы не сохраняет свое форматирование.	Domnika	AutoCAD	6	08.05.2014 11:35
вставка таблицы из MS Excell	baaba	Готовые программы	23	11.03.2014 19:47
как с помощью vba начертить линию	vasyavip	Программирование	77	09.10.2008 23:17
Специикация сэнвич-панелей. формат таблицы	Bubblegum	Поиск литературы, чертежей, моделей и прочих материалов	2	26.08.2008 14:25