Создание нового стиля таблиц AutoCAD 2006 (VL)

Дмитрий Голованов · 17.12.2009, 06:51

Помогите! Делаю так:

Код:

(defun C:CREATETABLESTYLE ()
  (vl-load-com)
  (setq acad_application (vlax-Get-Acad-Object))
  (setq active_document (vla-Get-ActiveDocument acad_application))
  (setq ts_dictionaries (vla-Get-Dictionaries active_document))
  (setq ts_dictionary (vla-Item ts_dictionaries "acad_tablestyle"))

  (setq	item (vla-AddObject
	       ts_dictionary
	       "NEWTABLE"
	       "AcDbTableStyle"
	     )
  )
  ; далее задание своиств стиля
)

В результате:

Цитата:

Команда: CREATETABLESTYLE
"Ошибка Automation. Отсутствует описание." ; ошибка: В функции *error* возникла ошибка:Настройка переменной AutoCAD отвергнута: "USERS2" nil

Где ошибка?

Do$ · 17.12.2009, 08:35

AutoCAD 2006 eng:

Код:

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

 
Command: CREATETABLESTYLE
#<VLA-OBJECT IAcadTableStyle 07bf0174>

Дмитрий Голованов · 17.12.2009, 08:52

У меня RU - версия, но думаю вряд ли из-за этого. Может это быть из-за надстроек типа СПДС?

Do$ · 17.12.2009, 08:58

Думаю, что проблема где-то тут

:

Цитата:

Сообщение от Дмитрий Голованов

; далее задание своиств стиля

В редакторе есть полезные функции по поиску ошибок, в частности, можно посмотреть в какой части кода произошла ошибка, вызвавшая остановку работы программы.
Тут про это поподробнее:
http://autolisp.ru/category/ide/

Дмитрий Голованов · 17.12.2009, 09:04

Цитата:

Сообщение от Do$

Думаю, что проблема где-то тут :

Точно нет. Далее всё закомментировано до конца функции. Если закоментить (setq ...), то функция выполняется без ошибок, результат - ссылка на объект-словаря:

Цитата:

#<VLA-OBJECT IAcadDictionary 05fb02c4>

PS: в стандартном редакторе есть средства отладки - трассировка, точки останова? Я ещё не освоился

Profan · 17.12.2009, 09:11

Цитата:

Команда: CREATETABLESTYLE
"Ошибка Automation. Отсутствует описание." ; ошибка: В функции *error* возникла ошибка:Настройка переменной AutoCAD отвергнута: "USERS2" nil

Но в приведенном коде переменная "USERS2" не упоминается.

Do$ · 17.12.2009, 09:12

Я тогда не понимаю, почему такое сообщение:

Цитата:

Сообщение от Дмитрий Голованов

ошибка: В функции *error* возникла ошибка:Настройка переменной AutoCAD отвергнута: "USERS2" nil

функция *error* переопределена чтоли?

Цитата:

Сообщение от Дмитрий Голованов

PS: в стандартном редакторе есть средства отладки - трассировка, точки останова? Я ещё не освоился

Трассировкой не пользуюсь, а вот точками останова - постоянно.
Вообще, там же (имею в виду ссылку) есть статья про создание табличного стиля, может поможет:
http://autolisp.ru/2009/11/23/tablestyle-create/

Дмитрий Голованов · 17.12.2009, 09:22

Цитата:

Сообщение от Do$

функция *error* переопределена чтоли?

Вполне возможно, только как это проверить?

Do$ · 17.12.2009, 09:26

Для стандартной функции:

Код:

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

 
Command: !*error*
#<SUBR @060d73fc *ERROR*>

Для переопределенной:

Код:

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

Command: !*error*
#<USUBR @074151e0 *ERROR*>

Дмитрий Голованов · 17.12.2009, 09:48

У меня:

Цитата:

Команда: !*error*
#<SUBR @0bf0c500 *ERROR*>

VVA · 17.12.2009, 10:12

Я поступил следующим образом:
Ручками создал и настроил нужный стиль таблицы
Потом из словаря "ACAD_TABLESTYLE" сохранил значения в списке
(нужно скопировать код в командную строку, затем нажать F2 и скопировать список. Вместо МИП впиши свое имя стиля)

Код:

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

(setq ts(vl-remove-if '(lambda(x)(member (car x) '(-1 5 102 330)))(entget(cdr(cadr(member (cons 3 "МИП")(DICTSEARCH (NAMEDOBJDICT) "ACAD_TABLESTYLE")))))))

Затем проверяем и при необходимости создаем нужный стиль. Вместо МИП впиши свое имя стиля
Обрати внимание на красную строчку

Код:

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

(VL-CATCH-ALL-APPLY '(lambda( / tb tb-dic xr)
;;Добавляем стиль таблицы
(if (and (setq tb-dic(DICTSEARCH (NAMEDOBJDICT) "ACAD_TABLESTYLE"))
	 (not (member (cons 3 "МИП")(DICTSEARCH (NAMEDOBJDICT) "ACAD_TABLESTYLE"))))
  (progn
(setq tb (list
'(0 . "TABLESTYLE")
(cons 330 (CDR (ASSOC -1 tb-dic)))
'(100 . "AcDbTableStyle")
'(3 . "Standard")
'(70 . 0)
'(71 . 0)
'(40 . 1);Отступ
'(41 . 1);Отступ
'(280 . 0)
'(281 . 0)
'(7 . "МИП_ГОСТ")
'(140 . 2.5)
'(170 . 5)
'(62 . 256)
'(63 . 7)
'(283 . 0)
'(274 . -1)
'(284 . 1)
'(64 . 256)
'(275 . -1)
'(285 . 1)
'(65 . 256)
'(276 . -1)
'(286 . 1)
'(66 . 256)
'(277 . -1)
'(287 . 1)
'(67 . 256)
'(278 . -1)
'(288 . 1)
'(68 . 256)
'(279 . -1)
'(289 . 1)
'(69 . 256)
'(7 . "МИП_ГОСТ")
'(140 . 3.5)
'(170 . 5)
'(62 . 256)
'(63 . 256)
'(283 . 0)
'(274 . -2)
'(284 . 1)
'(64 . 0)
'(275 . -2)
'(285 . 1)
'(65 . 0)
'(276 . -2)
'(286 . 1)
'(66 . 0)
'(277 . -2)
'(287 . 1)
'(67 . 0)
'(278 . -2)
'(288 . 1)
'(68 . 0)
'(279 . -2)
'(289 . 1)
'(69 . 0)
'(7 . "МИП_ГОСТ")
'(140 . 3.0)
'(170 . 5)
'(62 . 256)
'(63 . 256)
'(283 . 0)
'(274 . -1)
'(284 . 1)
'(64 . 256)
'(275 . -1)
'(285 . 1)
'(65 . 256)
'(276 . -1)
'(286 . 1)
'(66 . 256)
'(277 . -1)
'(287 . 1)
'(67 . 256)
'(278 . -1)
'(288 . 1)
'(68 . 256)
'(279 . -1)
'(289 . 1)
'(69 . 256)
)
      )
(if (setq xr (entmakex tb))
(entmod (append tb-dic(list (cons 3 "МИП")(cons 350 xr)))))
(setq tb nil xr nil tb-dic nil )
))
))

Дмитрий Голованов · 17.12.2009, 10:42

Создаю стиль "СТИЛЬ1", основанный на "Standart". Затем в командной строке:

Код:

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

(setq ts(vl-remove-if '(lambda(x)(member (car x) '(-1 5 102 330)))(entget(cdr(cadr(member (cons 3 "СТИЛЬ1")(DICTSEARCH (NAMEDOBJDICT) "ACAD_TABLESTYLE")))))))

Результат:

Код:

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

Команда: (setq ts(vl-remove-if '(lambda(x)(member (car x) '(-1 5 102 
330)))(entget(cdr(cadr(member (cons 3 "СТИЛЬ1")(DICTSEARCH (NAMEDOBJDICT) 
"ACAD_TABLESTYLE")))))))
((0 . "TABLESTYLE") (100 . "AcDbTableStyle") (3 . "Standard") (70 . 0) (71 . 0) 
(40 . 0.06) (41 . 0.06) (280 . 0) (281 . 0) (7 . "STANDARD") (140 . 0.18) (170 
. 2) (62 . 0) (63 . 7) (283 . 0) (274 . -2) (284 . 1) (64 . 0) (275 . -2) (285 
. 1) (65 . 0) (276 . -2) (286 . 1) (66 . 0) (277 . -2) (287 . 1) (67 . 0) (278 
. -2) (288 . 1) (68 . 0) (279 . -2) (289 . 1) (69 . 0) (7 . "STANDARD") (140 . 
0.25) (170 . 5) (62 . 0) (63 . 7) (283 . 0) (274 . -2) (284 . 1) (64 . 0) (275 
. -2) (285 . 1) (65 . 0) (276 . -2) (286 . 1) (66 . 0) (277 . -2) (287 . 1) (67 
. 0) (278 . -2) (288 . 1) (68 . 0) (279 . -2) (289 . 1) (69 . 0) (7 . 
"STANDARD") (140 . 0.18) (170 . 5) (62 . 0) (63 . 7) (283 . 0) (274 . -2) (284 
. 1) (64 . 0) (275 . -2) (285 . 1) (65 . 0) (276 . -2) (286 . 1) (66 . 0) (277 
. -2) (287 . 1) (67 . 0) (278 . -2) (288 . 1) (68 . 0) (279 . -2) (289 . 1) (69 
. 0))

По трём упоминаниям стиля STANDARD вместо одного вижу, что это близко не то, что у вас. А на третьем компьютере будет что-то третье. Это не есть хорошо.

Do$ · 17.12.2009, 10:52

Почему "близко не то"? (7 . "МИП_ГОСТ") тоже три раза повторяется.
Способ железный

Дмитрий Голованов · 17.12.2009, 13:13

Вообще-то да, я не понял просто, что это название шрифта. А где-нибудь узнать можно, что означают остальные букафки?

...

Так, букафки найдены:

0
Object name (TABLESTYLE)

5
Handle

102
Start of persistent reactors group; always “{ACAD_REACTORS” (The persistent reactors group appears in all dictionaries except the main dictionary.)

330
Soft-pointer ID/handle to owner dictionary. For TABLESTYLE objects this code is always the ACAD_TABLESTYLE entry of the named object dictionary

102
End of persistent reactors group, always “}”

100
Subclass marker (AcDbTableStyle)

3
Table style description (string; 255 characters maximum)

70
FlowDirection (integer):

0 = Down

1 = Up

71
Flags (bit-coded)

40
Horizontal cell margin (real; default = 0.06)

41
Vertical cell margin (real; default = 0.06)

280
Flag for whether the title is suppressed:

0 = Not suppressed

1 = Suppressed

281
Flag for whether the column heading is suppressed:

0 = Not suppressed

1 = Suppressed

7
Text style name (string; default = STANDARD)

140
Text height (real)

170
Cell alignment (integer)

62
Text color (integer; default = BYBLOCK)

63
Cell fill color (integer; default = 7)

283
Flag for whether background color is enabled (default = 0):

0 = Disabled

1 = Enabled

274-279
Lineweight associated with each border type of the cell (default = kLnWtByBlock)

284-289
Flag for visibility associated with each border type of the cell (default = 1):

0 = Invisible

1 = Visible

64-69
Color value associated with each border type of the cell (default = BYBLOCK)

так что вариант VVA можно использовать.

Но всё-таки почему-то не работает vla-вариант??? Попробовал на VBA (факт - намного удобнее, мож потому, что привычнее и редактор получше):

Код:

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

Private Sub CreateTableStyle()
    Dim NewTableStyle As AcadTableStyle
    Dim TableStyleDictionary As AcadDictionary
    Set TableStyleDictionary = ThisDrawing.Dictionaries.Item("ACAD_TABLESTYLE")
    Dim TableStyleName As String
    TableStyleName = "NewTableStyle"
    Set NewTableStyle = TableStyleDictionary.AddObject(TableStyleName, "AcDbTableStyle")    
End Sub

В на последней строке ошибка:

Цитата:

Run-time error '-2147024770 (8007007e)':
Method 'AddObject' of object 'IAcadDictionary' failed

Please, help me!

PS: кстати, если например в AddObject написать "AcсссссDbTableStyle", то ошибка уже другая, а-ля, "Элемент AcRxClassName нет в системном реестре". То есть вроде как AddObject начинает выполняться, но никак не может дойти до конца (

Кулик Алексей aka kpblc · 17.12.2009, 18:40

Посмотри ссылку из #7 - я перед публикацией на сайте коды свои проверял. Так что там все работает.

Дмитрий Голованов · 18.12.2009, 06:21

Алексей, я смотрел уже и запускал. Вылетает та же самая ошибка

Do$ · 18.12.2009, 09:35

Цитата:

Сообщение от Дмитрий Голованов

Run-time error '-2147024770 (8007007e)': Method 'AddObject' of object 'IAcadDictionary' failed

Чудеса...
А что выдаст такой код?

Код:

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

 
(vl-load-com)
(setq acad_application (vlax-Get-Acad-Object)
      active_document  (vla-Get-ActiveDocument acad_application)
      ts_dictionaries  (vla-Get-Dictionaries active_document)
      ts_dictionary    (vla-Item ts_dictionaries "acad_tablestyle")
) ;_ end of setq
(vlax-dump-Object ts_dictionary T)

Дмитрий Голованов · 18.12.2009, 10:38

Код:

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

(setq acad_application (vlax-Get-Acad-Object)
(_>       active_document  (vla-Get-ActiveDocument acad_application)
(_>       ts_dictionaries  (vla-Get-Dictionaries active_document)
(_>       ts_dictionary    (vla-Item ts_dictionaries "acad_tablestyle")
(_> ) ;_ end of setq
#<VLA-OBJECT IAcadDictionary 19af2da4>
Команда: (vlax-dump-Object ts_dictionary T)
; IAcadDictionary: Объект-контейнер для хранения и получения других объектов.
; Значения свойств:
;   Application (RO) = #<VLA-OBJECT IAcadApplication 00c2eb8c>
;   Count (RO) = 4
;   Document (RO) = #<VLA-OBJECT IAcadDocument 0cb24904>
;   Handle (RO) = "33FFC"
;   HasExtensionDictionary (RO) = 0
;   Name = "ACAD_TABLESTYLE"
;   ObjectID (RO) = 2130488544
;   ObjectName (RO) = "AcDbDictionary"
;   OwnerID (RO) = 2130517088
; Поддерживаемые методы:
;   AddObject (2)
;   AddXRecord (1)
;   Delete ()
;   GetExtensionDictionary ()
;   GetName (1)
;   GetObject (1)
;   GetXData (3)
;   Item (1)
;   Remove (1)
;   Rename (2)
;   Replace (2)
;   SetXData (2)
T

Do$ · 18.12.2009, 11:19

Код:

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

; Поддерживаемые методы:
;   AddObject (2)
;   AddXRecord (1)
;   Delete ()
;   GetExtensionDictionary ()
;   GetName (1)
;   GetObject (1)
;   GetXData (3)
;   Item (1)
;   Remove (1)
;   Rename (2)
;   Replace (2)
;   SetXData (2)

Ну ведь поддерживается этот метод...
Может в самом AutoCAD'е проблема? Криво установлен или побит вирусами/сбоями.

Дмитрий Голованов · 18.12.2009, 12:00

Код:

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

Команда: (setq acad_application (vlax-Get-Acad-Object))
#<VLA-OBJECT IAcadApplication 00c2eb8c>
Команда: (setq active_document (vla-Get-ActiveDocument acad_application))
#<VLA-OBJECT IAcadDocument 11db7a74>
Команда: (setq ts_dictionaries (vla-Get-Dictionaries active_document))
#<VLA-OBJECT IAcadDictionaries 13d5ccc4>
Команда: (setq ts_dictionary (vla-Item ts_dictionaries "acad_tablestyle"))
#<VLA-OBJECT IAcadDictionary 13d5cbe4>
Команда: (vlax-method-applicable-p ts_dictionary 'addobject)
T

Похожие темы
Тема	Автор	Раздел	Ответов	Последнее сообщение
Видеоуроки AutoCAD	kosmax	AutoCAD	173	17.02.2017 15:08
Создание пользовательских кнопок в AutoCAD 2006	Shoorup	AutoCAD	54	02.02.2014 21:50
Информация по идентификационным кодам программ в сетевых лицензиях Autodesk	KSI	AutoCAD	1	14.09.2009 15:59
AUTOCAD 2006	Aragorn	AutoCAD	14	01.04.2005 00:55
Вчера AutoDesk объявила о выходе нового AutoCAD 2006!!!!!!!!	URKA	AutoCAD	9	01.04.2004 20:06

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

	Реклама i