Информационный портал для профессионалов в области САПР
Вы не вошли. Пожалуйста, войдите или зарегистрируйтесь.
Форумы CADUser → Программирование → LISP → Программное создание размерных стилей
Чтобы отправить ответ, вы должны войти или зарегистрироваться
> Jura
Я ведь только предполагал :) Впрочем, как мне кажется, я и не утверждал, что происходит нечто отличное от того, что опивываете вы. Мне тоже кажется, что "подстили вешаются на клон". Интерестно, что формальные имена у них не изменяются под новый стиль.
> kpblc
Я бы сделал так получил через entget список существующего стиля скопировал в буфер, загнал бы его в (enmake (list ....)) и ковырял бы по пунктам до получения результата.
Вот-вот, пробовал. Результат - эта тема ;)
Все равно спасибо за участие, погляжу дома, с утра будет результат (если будет).
Упробовался, если честно. Эффекта все равно нет. Все можно сделать - текстовый стиль, слой (просто уже специально опробовал), а вот размерный ни в какую. Подробно - что делал:
Создал размерный стиль (руками)
1. Для начала (entget (tblobjname "dimstyle" "kpblc")). Полученный список загнал в (entmake), заменив в группе 340 <Name> на (cons 340 (tblobjname "block" "_archtick")). Определение блока в чертеже гарантированно присутствует. (entmake) выдает nil.
2. Затем (tblnext "dimstyle") до момента получения описания "kpblc". Тоже в (entmake) с заменой соответствующих групп. Эффект - nil.
3. Создал полное описание стиля по DXF Reference, исключив неиспользуемые группы (5, 6, 7, 270, 287) и задав группу 340 аналогично п.1. Эффект - nil.
Т.е. проблема не решена. Что самое интересное, так это то, что через (vl-cmdf) и (setvar )все работает. Может, тогда как-то попробовать сделать стиль таким методом, а потом просто как-то создавать зависимые стили, уже с заменой некоторых групп? Или есть более простое решение?
340 указатель на текстовый стиль...
Ну это понятно, я там делал (cons 340 (tblobjname "style" "kpblc")). Стиль создан заранее и гарантированно присутствует в чертеже.
(setq a (entget (tblobjname "dimstyle" "kpblc")))
(setq a1 (subst (cons 2 "jjj") (assoc 2 a) a))
(setq a2 (cdr a1))
(entmake a2)
полный успех...
Jura, у меня ситуация другая - в "голом" чертеже через (entmake) делается текстовый стиль (свои настройки) и надо сделать дополнительно размерный. Вроде как чего-то нащупал, чичас пробовать дальше буду.
лучшее враг хорошего
можно делать как лучше
можно как удобней, если не мешает себе и окружающим...
Не вижу ничего зазорного в использовании :
(command ...
(vl-cmdf ...
разница в больших возможностях (vl-cmdf ... и кажись в (vl-cmdf ... была какая-то устойчивость к esc
Поэтому, если не нужны супер возможности (vl-cmdf ... и не требуется устойчивости, вполне и (command ... можно применять... Считай, что из AutoCAD и не "выходил"...
> kpblc
Попробуй такой код.
Делал в 2006-ом -
настройки с базового ISO-25 кроме:
стрелок - здесь "_Archtick";
текстового стиля - ставится текущий.
Что касается подстилей - надо думать дальше.
(entmake
(list
'(0 . "DIMSTYLE")
'(100 . "AcDbSymbolTableRecord")
'(100 . "AcDbDimStyleTableRecord")
'(2 . "ISO-25-1")
'(70 . 0)
'(40 . 1.0)
'(41 . 2.5)
'(42 . 0.625)
'(43 . 3.75)
'(44 . 1.25)
'(73 . 0)
'(74 . 0)
'(77 . 1)
'(78 . 8)
'(140 . 2.5)
'(141 . 2.5)
'(143 . 0.0393701)
'(147 . 0.625)
'(171 . 3)
'(172 . 1)
'(271 . 2)
'(272 . 2)
'(274 . 3)
'(278 . 44)
'(283 . 0)
'(284 . 8)
(cons 340 (tblobjname "style" (getvar "TextStyle")))
(cons 342
(cdr (assoc 330 (entget (tblobjname "block" "_Archtick"))))
)
)
)Забыл добавить, что "_Archtick" должен уже
присутствовать в документе.
> AY
С меня причитается. Все, теперь получилось. Подстили попробую самостоятельно. Догадываюсь, что для них придется менять имя (вычислить его не проблема) и, наверно, 70-ю группу - но это потом чуток.
Вопрос был в 342-й группе - я туда пробовал засунуть напрямую (tblobjname "block" "_archtick"), почему там требуется мягкий указатель, не очень въехал. Проблема была именно в ней.
Наличие блока проверяется предварительно через (tblsearch).
> Jura
Насчет что "враг" - согласен, но не в данном случае. Слишком большие тормоза будут.
> kpblc
С подстилями тоже несложно выходит.
Только аналогичное создание стиля
с добавкой к имени $x где х-
0 линейный
2 угловой
3 диаметр
4 радиальный
6 координатный
7 выноска
С отдельными настройками подстилей надо
разбираться, кажется они через разширенные
данные добавляются.
Спасибо, учту. Вчера не получилось по человечески посидеть. То, что получится (если получится), выкладывать для варианта "подправить"?
Конечно выкладывать :) интерестно же ...
Нда... маразм крепчал, деревья гнулись. Чего-то не получается по человечески: все, добил, но не делается этот размерный стиль активным. Чего ему еще надо? Перенос команды "_.-dimstyle" на "повыше" (перед foreach в главной функции) приводит к тому, что, во-первых, создается override-стиль, а, во-вторых, нормально стиль создается только со второй попытки.
Неужели надо еще раз вызывать _-dimstyle?
Помогите, кто может! Кто может, помогите!
;|=============================================================================
* Функция создания размерного стиля. Используется вариант (setvar) и
* (vl-cmdf)
* Параметры вызова:
* нет
* Примеры вызова:
(_kpblc-create-dimstyle)
=============================================================================|;
(defun kpblc-create-dimstyle (/ ent_list exist_style arrow_block)
;; Локальные функции
(defun _kpblc-create-sub-dimstyle (style-number / ent_list ent_name)
(setq ent_name (if style-number
(strcat "kpblc$" (itoa style-number))
"kpblc"
) ;_ end of if
ent_list
(list
(cons 0 "DIMSTYLE") ; @R@
(cons 100 "AcDbSymbolTableRecord") ; @R@
(cons 100 "AcDbDimStyleTableRecord") ; @R@
(cons 2 ent_name) ;dimsty @R@
(cons 70
(if (not style-number)
0
style-number
) ;_ end of if
) ; @R@
(cons 40 (getvar "dimscale")) ;dimscale @R@
(cons 41 2.5) ;dimsz @R@
(cons 42 0.625) ;dimexo @R@
(cons 43 3.75) ;dimdli @R@
(cons 44 1.25) ;dimexe @R@
(cons 45 0.5) ;dimrnd @R@
(cons 46 0.0) ;dimdle @R@
;; группы 47 (dimtp) и 48 (dimtm) не используются - отключена dimtol
;; и
;; dimlim
(cons 140 2.5) ;dimtxt @R@
(cons 141 -2.5) ;dimcen @R@
(cons 143 0.005) ;dimaltf @R@
(cons 144 1) ;dimlfac
(cons 145 0) ;dimtvp
(cons 147 0.5) ;dimgap @R@
;; группа 146 (dimtfac) не используется и не изменяется - отключены
;; альтернативные единицы
(cons 72 0) ;dimlim
;; Дополнительно, для гарантии, отключаем dimlim
(cons 73 0) ;dimtih @R@
(cons 74 0) ;dimtoh @R@
(cons 77 1) ;dimtad @R@
(cons 78 8) ;dimzin @R@
(cons 79 2) ;dimazin @R@
;; группа 71 (dimtol) - нет альтернативных единиц
(cons 170 0) ;dimalt
(cons 172 1) ;dimtofl @R@
(cons 173 0) ;dimsah @R@
(cons 174 0) ;dimtix
(cons 175 1) ;dimsoxd
(cons 176 0) ;dimclrd
(cons 177 0) ;dimclre
(cons 178 0) ;dimclrt
(cons 179 1) ;dimadec
;; группа 171 (dimaltd) не используется - нет альтернативных единиц
(cons 271 0) ;dimdec @R@
(cons 272 0) ;dimtdec @R@
(cons 275 1) ;dimaunit
(cons 277 2) ;dimlunit
(cons 278 44) ;dimdsep @R@
(cons 279 ;dimtmove
(cond
((not style-number) 0)
((= style-number 0) 1)
((= style-number 1) 1)
(t 1)
) ;_ end of cond
) ;_ end of cons
(cons 280 0) ;dimjust
(cons 281 0) ;dimsd1
(cons 282 0) ;dimsd2
(cons 283 0) ;dimtolj
(cons 284 8) ;dimtzin
;; группа 270 не используется - устарело. Вместо этого используется
;; назначение dimlunit и dimfrac
;; группа 287 (dimfit) не используется - устар. Вместо этого
;; используются
;; dimaltfit и dimtmove
(cons 288 0) ;dimupt
;; группы 273 (dimaltu), 274 (dimalttd), 285 (dimaltz), 286
;; (dimalttz)
;; не используются - нет альтернативных единиц
;; группа 276 (dimfrac) не устанавливается
(cons 340 (tblobjname "style" "kpblc")) ;dimtxtsty @R@
(cons 371 -2) ;dimlwd
(cons 372 -2) ;dimlwe
) ;_ end of list
) ;_ end of setq
(if (member style-number '(nil 0 1))
(progn
(setq ent_list
(reverse
(cons
(cons 342
(cdr
(assoc 330
(entget
(tblobjname "block" "_archtick")
) ;_ end of entget
) ;_ end of assoc
) ;_ end of cdr
) ;dimblk @R@
(reverse ent_list)
) ;_ end of cons
) ;_ end of reverse
) ;_ end of setq
(setq ent_list
(reverse
(cons
(cons 343
(cdr
(assoc 330
(entget
(tblobjname "block" "_archtick")
) ;_ end of entget
) ;_ end of assoc
) ;_ end of cdr
) ;dimblk1
(reverse ent_list)
) ;_ end of cons
) ;_ end of reverse
) ;_ end of setq
(setq ent_list
(reverse
(cons
(cons 344
(cdr
(assoc 330
(entget
(tblobjname "block" "_archtick")
) ;_ end of entget
) ;_ end of assoc
) ;_ end of cdr
) ;dimblk2
(reverse ent_list)
) ;_ end of cons
) ;_ end of reverse
) ;_ end of setq
) ;_ end of setq
) ;_ end of if
(if (setq exist_style (tblobjname "dimstyle" ent_name))
(foreach item ent_list
(_kpblc-ent-modify exist_style (car item) (cdr item))
) ;_ end of foreach
(entmake ent_list)
) ;_ end of if
) ;_ end of defun
;; Конец локальных функций
(_kpblc-create-textstyle)
(if (not (tblsearch "block" "_archtick"))
(progn
(setq _dimblk_ (getvar "dimblk"))
(setvar "dimblk" "_archtick")
(if (= _dimblk_ "")
(setvar "dimblk" ".")
(setvar "dimblk" _dimblk_)
) ;_ end of if
) ;_ end of progn
) ;_ end of if
(_kpblc-echo t)
(foreach item (list nil 0 2 3 4 7)
(_kpblc-create-sub-dimstyle item)
) ;_ end of foreach
[b];|
Вот кусок, который, как я подозреваю, надо активировать. Но где? Если здесь, то он теряет смысл, если выше - то проблемы я описал в самом начале.
(if (tblsearch "dimstyle" "kpblc")
(command "_.-dimstyle" "_Save" "kpblc" "_No")
(command "_.-dimstyle" "_Save" "kpblc")
) ;_ end of if
(while (/= (getvar "cmdactive") 0)
(command nil)
) ;_ end of while
(_kpblc-echo nil)
|;[/b]
(princ)
) ;_ end of defun
;|=======================================================================================
* Функция снятия / показа командного эха. В процессе работы используются глобальные
* переменные *kpblc-cmdecho* и *kpblc-nomutt*. Если они nil, то в них считываются значения
* cmdecho и nomutt. Если они не nil, то устанавливаются записанные в них значения.
* Параметры вызова:
* setecho - установить или возвратить обратно эхо. nil -> установить эхо; t -> снять
* Примеры вызова:
(_kpblc-echo t) ; снять эхо команд
(_kpblc-echo nil) ; установить это команд
=======================================================================================|;
(defun _kpblc-echo (setecho)
(if setecho
(mapcar
'setvar
(list "cmdecho" "nomutt")
(list 0 1)
) ;_ end of mapcar
(mapcar
'setvar
(list "cmdecho" "nomutt")
(list 1 0)
) ;_ end of mapcar
) ;_ end of if
(princ)
) ;_defun
;|=======================================================================================
* Функция создает текстовый стиль. Создание идет через (entmake).
* Созданный стиль делается активным
* Параметры вызова:
* нет
* Примеры вызова:
(_kpblc-create-textstyle)
=======================================================================================|;
(defun _kpblc-create-textstyle (/ ent_list font_filename exist_style)
(if (findfile "spds.shx")
(setq font_filename (strcat (vl-filename-base (findfile "spds.shx")) ".shx"))
(setq font_filename (strcat (vl-filename-base (findfile "simplex.shx")) ".shx"))
) ;_ end of if
(setq ent_list
(list
'(0 . "STYLE")
'(100 . "AcDbSymbolTableRecord")
'(100 . "AcDbTextStyleTableRecord")
'(2 . "kpblc") ; text style name
'(70 . 0) ;
'(40 . 0.0) ; text height
'(41 . 0.8) ; width factor
'(50 . 0.0) ; oblique angle
'(71 . 0) ; not backwatf, not upside down
'(42 . 2.5) ; last height used
(cons 3 font_filename) ; primary font file name
'(4 . "") ; big font file name
) ;_ end of list
) ;_ end of setq
;(entmake ent_list)
(if (setq exist_style (tblobjname "style" "kpblc"))
;; Стиль есть, возвращаем стандартный вид
(foreach item ent_list
(_kpblc-ent-modify exist_style (car item) (cdr item))
) ;_ end of foreach
;; Стиля нет, делаем его и нормализуем все примитивы
(entmake ent_list)
) ;_ end of if
(setvar "textstyle" "kpblc")
;(princ)
) ;_ end of defun
;|=======================================================================================
* Функция модификации указанного бита примитива
* Параметры вызова:
* entity - примитив, полученный через (entsel), (entlast) etc
* bit - dxf-код, значение которого надо установить
* value - новое значение
* Примеры вызова:
(_kpblc-ent-modify (entlast) 8 "0") ; перенести последний примитив на слой 0
(_kpblc-ent-modify (entsel) 62 10) ; установить выбранному примитиву цвет 10
* Возвращаемое значение:
* примитив с модифицированным dxf-списком. Примитив автоматически перерисовывается.
=======================================================================================|;
(defun _kpblc-ent-modify (ent bit value / ent_list old_dxf new_dxf)
(if (not
(and
(or
(= (cdr (assoc 0 (entget ent))) "STYLE")
(= (cdr (assoc 0 (entget ent))) "DIMSTYLE")
) ;_ end of or
(= bit 100)
) ;_ end of and
) ;_ end of not
(progn
(setq ent_list (entget ent)
new_dxf (cons bit
(if (and (= bit 62) (= (type value) 'str))
(if (= (strcase value) "BYLAYER")
256
0
) ;_ end of if
value
) ;_ end of if
) ;_ end of cons
) ;_ end of setq
(if (not (equal new_dxf (setq old_dxf (assoc bit ent_list))))
(progn (entmod (if old_dxf
(subst new_dxf old_dxf ent_list)
(append ent_list (list new_dxf))
) ;_ end of if
) ;_ end of entmod
(entupd ent)
(redraw ent)
) ;_ end of progn
) ;_ end of if
) ;_ end of progn
) ;_ end of if
ent
) ;_ end of defunПрофи, не дайте погибнуть!
мне интересно, хоть кто-нибудь до конца прочитал или нет?
Если надо полную картину, чего надо сделать, прошу в почту - пришлю файлик с настроенными (вручную) стилями.
шли
Да в принципе все уже, огромное спасибо всем подсказавшим. Код выше. Закомментированный кусок функции (kpblc-create-dimstyle) надо выкидывать нафиг и вместо него делать следующее:
(if (not *kpblc-activedoc*)
(setq *kpblc-activedoc* (vla-get-activedocument (vlax-get-acad-object)))
) ;_ end of if
(if (tblobjname "dimstyle" "SPDS")
(progn
(setq active_dimstyle (vlax-ename->vla-object (tblobjname "dimstyle" "SPDS")))
(vlax-put-property *kpblc-activedoc* "ActiveDimStyle" active_dimstyle)
) ;_ end of progn
(vl-cmdf "_.-dimstyle" "_Save" "SPDS")
) ;_ end of if
(_kpblc-echo nil)Дополнительно объявить actove_dimstyle как локальную переменную. *kpblc-activedoc* оставить в живых - может, еще где понадобится ;)
Я там упустил, что (_kpblc-echo nil) не надо было комментировать, но уже не страшно.
Проверено - работает, зараза! Я бьюсь в счастье! Сегодня можно не работать :)
Чтобы отправить ответ, вы должны войти или зарегистрироваться
Форумы CADUser → Программирование → LISP → Программное создание размерных стилей
Форум работает на PunBB, при поддержке Informer Technologies, Inc
