[Кулик Алексей aka kpblc]

Есть небольшая проблема: надо сделать размерный стиль, и внутри него дополнительные определения для размерных стилей на угловые размеры, радиусы и т.п. Через (tblobjname) получены списки настроек, имена, но сделать повторно через (entmake) - естественно, на новом файле, только имя стиля менял,- не получается - возвращается nil.
Я понимаю, что есть некоторые значения dxf-кодов, которые являются обязательными. Какие обязательные, какие нет, мне вычислить не удалось. Поэтому собственно вопрос(ы) - даю несколько, чтобы и мне было понятно, и сразу на ошибки указали:
1. Для задания кодов 5, 6 и 7 (соответствуют dimblk, dimblk1, dimblk2) требуется имя блока - как его получать / задавать? через tblobjname или assoc? Или проще сделать через (setvar)?
2. Для кодов 340, 341 (соответственно dimtxtsty, dimldrblk) требуются уже хэндлы блоков - а к ним как обращаться?
3. Для кодов 371, 372 (соответственно dimlwd, dimlwe) требуются lineweight enum value - а это что за чудо? Для значения "ByLayer" чего надо назначать? А для "ByBlock", 0.25 etc?
---
Идти через (setvar) в данном варианте у меня что-то не получается, подозреваю, что надо использовать ActiveX-функции, но там я как свинья в ананасах, хоть скажите, в какую сторону копать.

[Piton]

вопросы к Крыс:
1) В 2008 версии появилась новая возможность в текстовых и размерных стилях использовать свойство "Annotative", как добавить эту опцию к лиспу? Вроде переменна которая за это отвечает "DIMANNO", но она "только для чтения"
2) Есть чертеж с размерным стилем "М 1-1", я запускаю твой лисп (имя размерного стиля в лиспе я изменил на "M 1-1" и у меня появляются ДВА размерных стиля "М 1-1" (настройки стилей разные). Как сделать чтобо стиль создаваемый лиспом заменял существующий?
3) Засечки для радиусов диаметров... могут быть только "Closed filled" ?

[Кулик Алексей aka kpblc]

1. Annotative - посмотрю, может, чего и получится.
2. Вообще-то 2 размерных стиля с одинаковым именем не могут существовать. Может, раскладка не та? Потому как у меня такого не наблюдается.
3. Ага. Делал специально, для "подстилей".
---
Добавлено: Интересные вещи нарисовываются. В Annotative стиле присутствуют расширенные данные:

Код:

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

(cdr (assoc -3 (entget (tblobjname "dimstyle" "annotative") '("*"))))
(("AcadAnnotative" (1000 . "AnnotativeData") (1002 . "{") (1070 . 1) (1070 . 1) (1002 . "}")) ("ACAD_DSTYLE_DIMJAG" (1070 . 388) (1040 . 1.5)) ("ACAD_DSTYLE_DIMTALN" (1070 . 392) (1070 . 0)))

Соответственно с ними надо разбираться и пробовать присандаливать к стилю, одновременн проверяя версию.

[Piton]

2. Точно буква "М" была в разных раскладках.
3. Жаль что только "Closed filled" всегда пользовался "Open 30", но с этим можно жить.

Вопрос по текстовому стилю:
I) есть строчка которая отвечает за угол наклона
'(50 . 0) ; oblique angle
я хочу сделать угол наклона текста был 15 градусов, заменеяю "0" на "15"-> и получаю угол в свойсвах текста "-220.563". В каких единицах задается угол? (в справке дается значение от "-85" до "85")
II) Как добавить (добавь пожалуста ) еще 2 два текстовых стиля "ТЕКСТ", "ЗАГОЛОВОК" и сделать текущим слой "ТЕКСТ" после запуска лиспа.

[VVA]

>Piton Угол задается в радианах
15' ~ 0.261799 рад
Вот 2 ф-ции
Набери (dtr 15)

Код:

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

;;;Библиотечные функции 
;;;Ф-ция переводит градусы в радианы
;;;( dtr a)
(defun DTR (a)(* pi (/ a 180.0)))
;;;------------------------------------------------------------------------------- 
;;;Ф-ция переводит радианы в градусы
;;;( R2D a)
(defun RTD (a)(/ (* a 180.0) pi))

[Кулик Алексей aka kpblc]

Значится так
Для создания текстового стиля "как захочется" использовать можно такое:

Код:

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

(vl-load-com)
(setq *kpblc-activedoc* (vla-get-activedocument (vlax-get-acad-object)))

(defun _kpblc-style-create-textstyle-by-list (lst / res)
                                             ;|
*    Создание или перенастройка текстового стиля
*    Параметры вызова:
*	lst	список вида:
      '(("name" . <ИмяСтиля>)		; nil -> работа прекращается
	("height" . <ВысотаТекста>)	; nil или меньше 0 -> 0.
	("ang" . <УголНаклона, градусы>) ; nil -> 0.
	("font" . <ИмяФонта>)		; nil -> "simplex.shx"
	("width" . <КоэффициентШирины>)	; nil -> 1.
*    Примеры вызова:
(_kpblc-style-create-textstyle-by-list '(("name" . "test1") ("font" . "isosp.shx")))
(_kpblc-style-create-textstyle-by-list '(("name" . "test2") ("font" . "isosp.shx") ("ang" . 15.)))
|;
  (_kpblc-error-catch
    (function
      (lambda ()
        (if (cdr (assoc "name" lst))
          (progn
            (foreach item
                     (list (cons "height" 0.)
                           (cons "ang" 0.)
                           (cons "font"
                                 (cond
                                   ((findfile "simplex.shx"))
                                   ((findfile "txt.shx"))
                                   (vla-get-fontfile
                                    (vla-get-activetextstyle *kpblc-activedoc*)
                                    )
                                   ) ;_ end of cond
                                 ) ;_ end of cons
                           (cons "width" 1.)
                           ) ;_ end of list
              (if (not (assoc (car item) lst))
                (setq lst (cons item lst))
                ) ;_ end of if
              ) ;_ end of foreach
            (setq lst
                   (subst (cons "font"
                                (cond
                                  ((findfile (cdr (assoc "font" lst))))
                                  ((findfile "simplex.shx"))
                                  ((findfile "txt.shx"))
                                  (vla-get-fontfile
                                   (vla-get-activetextstyle *kpblc-activedoc*)
                                   )
                                  ) ;_ end of cond
                                ) ;_ end of cons
                          (assoc "font" lst)
                          lst
                          ) ;_ end of subst
                  ) ;_ end of setq
            (setq res (if (tblobjname "style" (cdr (assoc "name" lst)))
                        (vla-item (vla-get-textstyles *kpblc-activedoc*))
                        (vla-add (vla-get-textstyles *kpblc-activedoc*)
                                 (cdr (assoc "name" lst))
                                 ) ;_ end of vla-add
                        ) ;_ end of if
                  ) ;_ end of setq
            (vla-put-fontfile res (cdr (assoc "font" lst)))
            (vla-put-height res (cdr (assoc "height" lst)))
            (vla-put-obliqueangle res (/ (* (cdr (assoc "ang" lst)) pi) 180.))
            (vla-put-width res (cdr (assoc "width" lst)))
            (_kpblc-ent-modify-autoregen
              (vlax-vla-object->ename res)
              4
              ""
              t
              ) ;_ end of _kpblc-ent-modify-autoregen
            (_kpblc-ent-modify-autoregen
              (vlax-vla-object->ename res)
              71
              0
              t
              ) ;_ end of _kpblc-ent-modify-autoregen
            ) ;_ end of progn
          ) ;_ end of if
        ) ;_ end of lambda
      ) ;_ end of function
    '(lambda (x) (princ (strcat "\n _kpblc-style-create-textstyle ERROR : " x)))
    ) ;_ end of _kpblc-error-catch
  res
  ) ;_ end of defun

(defun _kpblc-error-catch (protected-function
                           on-error-function
                           /
                           catch_error_result
                           )
                          ;|
*** Функция взята из книжной версии ruCAD'a без каких бы то ни было переделок,
*** кроме переименования.
*    Оболочка отлова ошибок.
*    Параметры вызова:
*	protected-function	- "защищаемая" функция
*	on-error-function	- функция, выполняемая в случае ошибки
=============================================================================|;
  (setq catch_error_result (vl-catch-all-apply protected-function))
  (if (and (vl-catch-all-error-p catch_error_result)
           on-error-function
           ) ;_ end of and
    (apply on-error-function
           (list (vl-catch-all-error-message catch_error_result))
           ) ;_ end of apply
    catch_error_result
    ) ;_ end of if
  ) ;_ end of defun

(defun _kpblc-ent-modify-autoregen (ent        bit        value      ext_regen
                                    /          ent_list   old_dxf    new_dxf
                                    layer_dxf70
                                    )
                                   ;|
*    Функция модификации указанного бита примитива
*    Параметры вызова:
*	entity	- примитив, полученный через (entsel), (entlast) etc
*	bit	- dxf-код, значение которого надо установить
*	value	- новое значение
*	regen	- выполнять или нет регенерацию примитива сразу. t/ nil
*    Примеры вызова:
(_kpblc-ent-modify (entlast) 8 "0" t)	; перенести последний примитив на слой 0
(_kpblc-ent-modify (entsel) 62 10 nil)	; установить выбранному примитиву цвет 10
*    Возвращаемое значение:
*	примитив с модифицированным dxf-списком. Примитив перерисовывается в
* зависимости от значения ключа ext_regen
|;
  (setq ent (_kpblc-conv-ent-to-ename ent))
  (if (not
        (and
          (or
            (= (strcase (cdr (assoc 0 (entget ent))) nil) "STYLE")
            (= (strcase (cdr (assoc 0 (entget ent))) nil) "DIMSTYLE")
            (= (strcase (cdr (assoc 0 (entget ent))) nil) "LAYER")
            ) ;_ 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
          (if ent_regen
            (entupd ent)
            (redraw ent)
            ) ;_ end of if
          ) ;_ end of progn 
        ) ;_ end of if 
      ) ;_ end of progn 
    ) ;_ end of if 
  ent
  ) ;_ end of defun

Для настройки размерного стиля поменяй в нем 340 группу на примерно такое:

Код:

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

(cons 340 (tblobjname "style" (vla-get-name (_kpblc-style-create-textstyle-by-list '(("name" . "test1") ("font" . "isosp.shx"))))))

Для замены Fill на Open надо поковыряться с 342, 343, 344 группами.

[Piton]

-> VVA Спасибо ввел 0.261799 и угол наклона стал таким каким мне нужно.

Крыс
Лисп который создает текстовый стиль в ответ на

Код:

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

(_kpblc-style-create-textstyle-by-list '(("name" . "ТЕКСТ") ("font" . "mipgost.shx") ("ang" . 15.) ("width" . 0.8.)))

ругается

Код:

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

 _kpblc-style-create-textstyle ERROR : lisp value has no coercion to VARIANT 
with this type:  0#<VLA-OBJECT IAcadTextStyle 01fcb464>

:shock:
и как сделать текстовый стиль текущим?

P.S замена в лиспе размеров групп 342...344

Код:

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

(tblobjname "block" "_Oblique")

на

Код:

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

 (tblobjname "block" "_Open30")

результатов не принесла

[Кулик Алексей aka kpblc]

Во-первых, у тебя неправильный вызов. Надо так:

Код:

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

(_kpblc-style-create-textstyle-by-list '(("name" . "ТЕКСТ") ("font" . "mipgost.shx") ("ang" . 15.) ("width" . 0.8)))

(в последнем списке надо вбивать 0.8, а не 0.8.).
Сделать текущим:

Код:

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

(vla-put-ActiveTextStyle (vla-get-ActiveDocument (vlax-get-acad-object)) (_kpblc-style-create-textstyle-by-list '(("name" . "ТЕКСТ") ("font" . "mipgost.shx") ("ang" . 15.) ("width" . 0.8))))

Для создания размерного стиля текстовый стиль, который ему назначается, уже должен существовать в файле.

[Piton]

1)При добавлении в автозагрузку ругается

Код:

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

 _kpblc-style-create-textstyle ERROR : no function definition: 
_KPBLC-CONV-ENT-TO-ENAME

2)на ввод

Код:

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

(_kpblc-style-create-textstyle-by-list '(("name" . "ТЕКСТ") ("font" . "mipgost.shx") ("ang" . 15.) ("width" . 0.8)))

отвечает

Код:

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

_kpblc-style-create-textstyle ERROR : too few actual parametersnil

, но темнеменее стиль создается, если я его переопределяю ( например меняю угол наклона на 20), то стиль не переопределяестя.
3)замена в лиспе размеров групп 342, 343,344

Код:

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

(tblobjname "block" "_Oblique")

на

Код:

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

 (tblobjname "block" "_Open30")

не помогла
4)По поводу сделать текущим текстовый стиль - не понял куда вставлять и как запускать

Код:

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

(vla-put-ActiveTextStyle (vla-get-ActiveDocument (vlax-get-acad-object)) (_kpblc-style-create-textstyle-by-list '(("name" . "ТЕКСТ") ("font" . "mipgost.shx") ("ang" . 15.) ("width" . 0.8))))

[Кулик Алексей aka kpblc]

<...>Все снес, вот вроде как работающий вариант:

Код:

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

(defun _kpblc-style-create-dimstyle (/ lst dimstyle_name _dimblk_)
  (vl-load-com)
  (or *kpblc-activedoc*
      (setq *kpblc-activedoc* (vla-get-activedocument (vlax-get-acad-object)))
      ) ;_ end of or
  (vla-put-activetextstyle
    *kpblc-activedoc*
    (_kpblc-style-create-textstyle-by-list
      '(("name" . "ТЕКСТ")
        ("font" . "mipgost.shx")
        ("ang" . 15.)
        ("width" . 0.8)
        )
      ) ;_ end of _kpblc-style-create-textstyle-by-list
    ) ;_ end of vla-put-ActiveTextStyle
  ;; Определяется имя размерного стиля
  (setq dimstyle_name "SPDS"
        ;; Вот теперь здесь определяем виды блоков
        lst           (list (cons nil "_archtick")
                            (cons 0 "_archtick")
                            (cons 2 "_open30")
                            (cons 3 "_open30")
                            (cons 4 "_open30")
                            (cons 7 "_open30")
                            ) ;_ end of list
        ) ;_ end of setq
  (foreach item lst
    (if (not (tblobjname "block" (cdr item)))
      (progn
        (setq _dimblk_ (getvar "dimblk"))
        (setvar "dimblk" (cdr item))
        (setvar "dimblk" _dimblk_)
        ) ;_ end of progn
      ) ;_ end of if
    (_kpblc-style-create-dimstyle-sub (car item))
    ) ;_ end of foreach
  ) ;_ end of defun

(defun _kpblc-style-create-dimstyle-sub (style-number /)
                                        ;|
*    Функция создания размерного "под"стиля.
*    Параметры вызова:
*	style-number	номер создаваемого стиля.
|;
  (setq ent_name (if style-number
                   (strcat "SPDS$" (itoa style-number))
                   "SPDS"
                   ) ;_ 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
                         (if (not style-number)
                           0
                           1
                           ) ;_ end of if
                         ) ;_ 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" "SPDS")) ;dimtxtsty   @R@
                   (cons 340 (tblobjname "style" (getvar "textstyle")))
                   (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

(defun _kpblc-style-create-textstyle-by-list (lst / res)
                                             ;|
*    Создание или перенастройка текстового стиля
*    Параметры вызова:
*   lst   список вида:
      '(("name" . <ИмяСтиля>)      ; nil -> работа прекращается
   ("height" . <ВысотаТекста>)   ; nil или меньше 0 -> 0.
   ("ang" . <УголНаклона, градусы>) ; nil -> 0.
   ("font" . <ИмяФонта>)      ; nil -> "simplex.shx"
   ("width" . <КоэффициентШирины>)   ; nil -> 1.
*    Примеры вызова:
(_kpblc-style-create-textstyle-by-list '(("name" . "test1") ("font" . "isosp.shx")))
(_kpblc-style-create-textstyle-by-list '(("name" . "test2") ("font" . "isosp.shx") ("ang" . 15.)))
|;
  (_kpblc-error-catch
    (function
      (lambda ()
        (if (cdr (assoc "name" lst))
          (progn
            (foreach item
                     (list (cons "height" 0.)
                           (cons "ang" 0.)
                           (cons "font"
                                 (cond
                                   ((findfile "simplex.shx"))
                                   ((findfile "txt.shx"))
                                   (vla-get-fontfile
                                    (vla-get-activetextstyle *kpblc-activedoc*)
                                    )
                                   ) ;_ end of cond
                                 ) ;_ end of cons
                           (cons "width" 1.)
                           ) ;_ end of list
              (if (not (assoc (car item) lst))
                (setq lst (cons item lst))
                ) ;_ end of if
              ) ;_ end of foreach
            (setq lst
                   (subst (cons "font"
                                (cond
                                  ((findfile (cdr (assoc "font" lst))))
                                  ((findfile "simplex.shx"))
                                  ((findfile "txt.shx"))
                                  (vla-get-fontfile
                                   (vla-get-activetextstyle *kpblc-activedoc*)
                                   )
                                  ) ;_ end of cond
                                ) ;_ end of cons
                          (assoc "font" lst)
                          lst
                          ) ;_ end of subst
                  ) ;_ end of setq
            (setq res (if (tblobjname "style" (cdr (assoc "name" lst)))
                        (vla-item (vla-get-textstyles *kpblc-activedoc*)
                                  (cdr (assoc "name" lst))
                                  ) ;_ end of vla-item
                        (vla-add (vla-get-textstyles *kpblc-activedoc*)
                                 (cdr (assoc "name" lst))
                                 ) ;_ end of vla-add
                        ) ;_ end of if
                  ) ;_ end of setq
            (vla-put-fontfile res (cdr (assoc "font" lst)))
            (vla-put-height res (cdr (assoc "height" lst)))
            (vla-put-obliqueangle res (/ (* (cdr (assoc "ang" lst)) pi) 180.))
            (vla-put-width res (cdr (assoc "width" lst)))
            (_kpblc-ent-modify-autoregen
              (vlax-vla-object->ename res)
              4
              ""
              t
              ) ;_ end of _kpblc-ent-modify-autoregen
            (_kpblc-ent-modify-autoregen
              (vlax-vla-object->ename res)
              71
              0
              t
              ) ;_ end of _kpblc-ent-modify-autoregen
            ) ;_ end of progn
          ) ;_ end of if
        ) ;_ end of lambda
      ) ;_ end of function
    '(lambda (x) (princ (strcat "\n _kpblc-style-create-textstyle ERROR : " x)))
    ) ;_ end of _kpblc-error-catch
  res
  ) ;_ end of defun

(defun _kpblc-conv-ent-to-ename (ent_value / res)
                                ;|
*    Функция преобразования полученного значения в ename
*    Параметры вызова:
*   ent_value   значение, которое надо преобразовать в примитив. Может
*         быть именем примитива, vla-указателем или просто
*         списком.
*         Если не принадлежит ни одному из указанных типов,
*         возвращается nil
*    Примеры вызова:
(_kpblc-conv-ent-to-ename (entlast))
(_kpblc-conv-ent-to-ename (vlax-ename->vla-object (entlast)))
=============================================================================|;
  (_kpblc-error-catch
    '(lambda ()
       (setq res (cond
                   ((= (type ent_value) 'vla-object)
                    (vlax-vla-object->ename ent_value)
                    )
                   ((= (type ent_value) 'ename) ent_value)
                   ((= (type ent_value) 'str) (handent ent_value))
                   ((= (type ent_value) 'list) (cdr (assoc -1 ent_value)))
                   (t nil)
                   ) ;_ end of cond
             ) ;_ end of setq
       ) ;_ end of lambda
    '(lambda (x) (princ (strcat "\n _kpblc-conv-ent-to-ename ERROR : " x)))
    ) ;_ end of _kpblc-error-catch
  res
  ) ;_ end of defun

(defun _kpblc-ent-modify-autoregen (ent        bit        value      ext_regen
                                    /          ent_list   old_dxf    new_dxf
                                    layer_dxf70
                                    )
                                   ;|
*    Функция модификации указанного бита примитива
*    Параметры вызова:
*   entity   - примитив, полученный через (entsel), (entlast) etc
*   bit   - dxf-код, значение которого надо установить
*   value   - новое значение
*   regen   - выполнять или нет регенерацию примитива сразу. t/ nil
*    Примеры вызова:
(_kpblc-ent-modify (entlast) 8 "0" t)   ; перенести последний примитив на слой 0
(_kpblc-ent-modify (entsel) 62 10 nil)   ; установить выбранному примитиву цвет 10
*    Возвращаемое значение:
*   примитив с модифицированным dxf-списком. Примитив перерисовывается в
* зависимости от значения ключа ext_regen
|;
  (setq ent (_kpblc-conv-ent-to-ename ent))
  (if (not
        (and
          (or
            (= (strcase (cdr (assoc 0 (entget ent))) nil) "STYLE")
            (= (strcase (cdr (assoc 0 (entget ent))) nil) "DIMSTYLE")
            (= (strcase (cdr (assoc 0 (entget ent))) nil) "LAYER")
            ) ;_ 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
          (if ent_regen
            (entupd ent)
            (redraw ent)
            ) ;_ end of if
          ) ;_ end of progn
        ) ;_ end of if
      ) ;_ end of progn
    ) ;_ end of if
  ent
  ) ;_ end of defun

(defun _kpblc-error-catch (protected-function
                           on-error-function
                           /
                           catch_error_result
                           )
                          ;|
*** Функция взята из книжной версии ruCAD'a без каких бы то ни было переделок,
*** кроме переименования.
*    Оболочка отлова ошибок.
*    Параметры вызова:
*   protected-function   - "защищаемая" функция
*   on-error-function   - функция, выполняемая в случае ошибки
=============================================================================|;
  (setq catch_error_result (vl-catch-all-apply protected-function))
  (if (and (vl-catch-all-error-p catch_error_result)
           on-error-function
           ) ;_ end of and
    (apply on-error-function
           (list (vl-catch-all-error-message catch_error_result))
           ) ;_ end of apply
    catch_error_result
    ) ;_ end of if
  ) ;_ end of defun

[Piton]

Крыс спасибо. Но я не могу сообразить
Объясни порядок работы (в моем понимании)
1)создаем текстовые стиль(у меня их 3 "ТЕКСТ", "РАЗМЕР", "ЗАГОЛОВОК") командой

Код:

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

(_kpblc-style-create-textstyle-by-list '(("name" . "ЗАГОЛОВОК") ("font" . "mipgost.shx") ("ang" . 15.)))

У меня ругается

Код:

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

_kpblc-style-create-textstyle ERROR : bad argument type: VLA-OBJECT nilnil

2)Текстовый стиль "ТЕКСТ" надо сделать текущим. Какую команду ввести?
3)Создаем размерный стиль ("М 1-1"). Какую команду ввести?
4)Создать макрос, чтоб автоматизировать пункты 1),2),3)

[Кулик Алексей aka kpblc]

Вот переделанный код (как говорится, найди отличия)

Код:

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

(vl-load-com)
(or *kpblc-activedoc*
    (setq *kpblc-activedoc* (vla-get-activedocument (vlax-get-acad-object)))
    ) ;_ end of or

(defun _kpblc-style-create-dimstyle
       (name textstyle / lst dimstyle_name _dimblk_)
       ;|
*    Функция создания размерного стиля.
*    Параметры вызова:
*	name		имя создаваемого размерного стиля
*	textstyle	Указатель на используемый TextStyle для этого размерного стиля
*    Примеры вызова:
(_kpblc-style-create-dimstyle "M1_1"(_kpblc-style-create-textstyle-by-list
    '(("name" . "ТЕКСТ")
      ("font" . "mipgost.shx")
      ("ang" . 15.)
      ("width" . 0.8)
      )
    ))
|;
  ;; Определяется имя размерного стиля
  (setq dimstyle_name name
        ;; Вот теперь здесь определяем виды блоков
        lst           (list (cons nil "_archtick")
                            (cons 0 "_archtick")
                            (cons 2 "_open30")
                            (cons 3 "_open30")
                            (cons 4 "_open30")
                            (cons 7 "_open30")
                            ) ;_ end of list
        ) ;_ end of setq
  (foreach item lst
    (if (not (tblobjname "block" (cdr item)))
      (progn
        (setq _dimblk_ (getvar "dimblk"))
        (setvar "dimblk" (cdr item))
        (setvar "dimblk"
                (if (= _dimblk_ "")
                  "."
                  _dimblk_
                  ) ;_ end of if
                ) ;_ end of setvar
        ) ;_ end of progn
      ) ;_ end of if
    (_kpblc-style-create-dimstyle-sub
      name
      (vla-get-name textstyle)
      (car item)
      (cdr item)
      ) ;_ end of _kpblc-style-create-dimstyle-sub
    ) ;_ end of foreach
  (if (tblobjname "dimstyle" name)
    (vla-item (vla-get-dimstyles *kpblc-activedoc*) name)
    ) ;_ end of if
  ) ;_ end of defun

(defun _kpblc-style-create-dimstyle-sub
       (name textstyle style-number style-blk /)
       ;|
*    Функция создания размерного "под"стиля.
*    Параметры вызова:
*	name		имя стиля
*	textstyle	Имя используемого текстового стиля. Стиль должен уже
		; существовать в файле. Проверка не производится.
*	style-number   	номер создаваемого стиля.
*	style-blk	имя блока, используемого в создаваемом подстиле
|;
  (setq ent_name (if style-number
                   (strcat name "$" (itoa style-number))
                   name
                   ) ;_ 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
                         (if (not style-number)
                           0
                           1
                           ) ;_ end of if
                         ) ;_ 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" "SPDS")) ;dimtxtsty   @R@
                   (cons 340 (tblobjname "style" textstyle))
                   (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" style-blk)
                                  ) ;_ 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" style-blk)
                                  ) ;_ 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" style-blk)
                                  ) ;_ 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-autoregen exist_style (car item) (cdr item) t)
      ) ;_ end of foreach
    (entmake ent_list)
    ) ;_ end of if
  ) ;_ end of defun

(defun _kpblc-style-create-textstyle-by-list (lst / res)
                                             ;|
*    Создание или перенастройка текстового стиля
*    Параметры вызова:
*   lst   список вида:
      '(("name" . <ИмяСтиля>)      ; nil -> работа прекращается
   ("height" . <ВысотаТекста>)   ; nil или меньше 0 -> 0.
   ("ang" . <УголНаклона, градусы>) ; nil -> 0.
   ("font" . <ИмяФонта>)      ; nil -> "simplex.shx"
   ("width" . <КоэффициентШирины>)   ; nil -> 1.
*    Примеры вызова:
(_kpblc-style-create-textstyle-by-list '(("name" . "test1") ("font" . "isosp.shx")))
(_kpblc-style-create-textstyle-by-list '(("name" . "test2") ("font" . "isosp.shx") ("ang" . 15.)))
|;
  (_kpblc-error-catch
    (function
      (lambda ()
        (if (cdr (assoc "name" lst))
          (progn
            (foreach item
                     (list (cons "height" 0.)
                           (cons "ang" 0.)
                           (cons "font"
                                 (cond
                                   ((findfile "simplex.shx"))
                                   ((findfile "txt.shx"))
                                   (vla-get-fontfile
                                    (vla-get-activetextstyle *kpblc-activedoc*)
                                    )
                                   ) ;_ end of cond
                                 ) ;_ end of cons
                           (cons "width" 1.)
                           ) ;_ end of list
              (if (not (assoc (car item) lst))
                (setq lst (cons item lst))
                ) ;_ end of if
              ) ;_ end of foreach
            (setq lst
                   (subst (cons "font"
                                (cond
                                  ((findfile (cdr (assoc "font" lst))))
                                  ((findfile "simplex.shx"))
                                  ((findfile "txt.shx"))
                                  (vla-get-fontfile
                                   (vla-get-activetextstyle *kpblc-activedoc*)
                                   )
                                  ) ;_ end of cond
                                ) ;_ end of cons
                          (assoc "font" lst)
                          lst
                          ) ;_ end of subst
                  ) ;_ end of setq
            (setq res (if (tblobjname "style" (cdr (assoc "name" lst)))
                        (vla-item (vla-get-textstyles *kpblc-activedoc*)
                                  (cdr (assoc "name" lst))
                                  ) ;_ end of vla-item
                        (vla-add (vla-get-textstyles *kpblc-activedoc*)
                                 (cdr (assoc "name" lst))
                                 ) ;_ end of vla-add
                        ) ;_ end of if
                  ) ;_ end of setq
            (vla-put-fontfile res (cdr (assoc "font" lst)))
            (vla-put-height res (cdr (assoc "height" lst)))
            (vla-put-obliqueangle res (/ (* (cdr (assoc "ang" lst)) pi) 180.))
            (vla-put-width res (cdr (assoc "width" lst)))
            (_kpblc-ent-modify-autoregen
              (vlax-vla-object->ename res)
              4
              ""
              t
              ) ;_ end of _kpblc-ent-modify-autoregen
            (_kpblc-ent-modify-autoregen
              (vlax-vla-object->ename res)
              71
              0
              t
              ) ;_ end of _kpblc-ent-modify-autoregen
            ) ;_ end of progn
          ) ;_ end of if
        ) ;_ end of lambda
      ) ;_ end of function
    '(lambda (x) (princ (strcat "\n _kpblc-style-create-textstyle ERROR : " x)))
    ) ;_ end of _kpblc-error-catch
  res
  ) ;_ end of defun

(defun _kpblc-conv-ent-to-ename (ent_value / res)
                                ;|
*    Функция преобразования полученного значения в ename
*    Параметры вызова:
*   ent_value   значение, которое надо преобразовать в примитив. Может
*         быть именем примитива, vla-указателем или просто
*         списком.
*         Если не принадлежит ни одному из указанных типов,
*         возвращается nil
*    Примеры вызова:
(_kpblc-conv-ent-to-ename (entlast))
(_kpblc-conv-ent-to-ename (vlax-ename->vla-object (entlast)))
=============================================================================|;
  (_kpblc-error-catch
    '(lambda ()
       (setq res (cond
                   ((= (type ent_value) 'vla-object)
                    (vlax-vla-object->ename ent_value)
                    )
                   ((= (type ent_value) 'ename) ent_value)
                   ((= (type ent_value) 'str) (handent ent_value))
                   ((= (type ent_value) 'list) (cdr (assoc -1 ent_value)))
                   (t nil)
                   ) ;_ end of cond
             ) ;_ end of setq
       ) ;_ end of lambda
    '(lambda (x) (princ (strcat "\n _kpblc-conv-ent-to-ename ERROR : " x)))
    ) ;_ end of _kpblc-error-catch
  res
  ) ;_ end of defun

(defun _kpblc-ent-modify-autoregen (ent        bit        value      ext_regen
                                    /          ent_list   old_dxf    new_dxf
                                    layer_dxf70
                                    )
                                   ;|
*    Функция модификации указанного бита примитива
*    Параметры вызова:
*   entity   - примитив, полученный через (entsel), (entlast) etc
*   bit   - dxf-код, значение которого надо установить
*   value   - новое значение
*   regen   - выполнять или нет регенерацию примитива сразу. t/ nil
*    Примеры вызова:
(_kpblc-ent-modify (entlast) 8 "0" t)   ; перенести последний примитив на слой 0
(_kpblc-ent-modify (entsel) 62 10 nil)   ; установить выбранному примитиву цвет 10
*    Возвращаемое значение:
*   примитив с модифицированным dxf-списком. Примитив перерисовывается в
* зависимости от значения ключа ext_regen
|;
  (setq ent (_kpblc-conv-ent-to-ename ent))
  (if (not
        (and
          (or
            (= (strcase (cdr (assoc 0 (entget ent))) nil) "STYLE")
            (= (strcase (cdr (assoc 0 (entget ent))) nil) "DIMSTYLE")
            (= (strcase (cdr (assoc 0 (entget ent))) nil) "LAYER")
            ) ;_ 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
          (if ent_regen
            (entupd ent)
            (redraw ent)
            ) ;_ end of if
          ) ;_ end of progn
        ) ;_ end of if
      ) ;_ end of progn
    ) ;_ end of if
  ent
  ) ;_ end of defun

(defun _kpblc-error-catch (protected-function
                           on-error-function
                           /
                           catch_error_result
                           )
                          ;|
*** Функция взята из книжной версии ruCAD'a без каких бы то ни было переделок,
*** кроме переименования.
*    Оболочка отлова ошибок.
*    Параметры вызова:
*   protected-function   - "защищаемая" функция
*   on-error-function   - функция, выполняемая в случае ошибки
=============================================================================|;
  (setq catch_error_result (vl-catch-all-apply protected-function))
  (if (and (vl-catch-all-error-p catch_error_result)
           on-error-function
           ) ;_ end of and
    (apply on-error-function
           (list (vl-catch-all-error-message catch_error_result))
           ) ;_ end of apply
    catch_error_result
    ) ;_ end of if
  ) ;_ end of defun

Для того, чтобы сразу создать стиль, да еще его и активировать, спробуй такое:

Код:

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

(vla-put-ActiveDimStyle (vla-get-ActiveDocument(vlax-get-acad-object)) (_kpblc-style-create-dimstyle "M1_10"(_kpblc-style-create-textstyle-by-list
    '(("name" . "ТЕКСТ")
      ("font" . "mipgost.shx")
      ("ang" . 15.)
      ("width" . 0.8)
      )
    )))

[Holon]

Сообщение от Кулик Алексей aka kpblc Всем откликнувшимся - огромное человеческое спасибо. Лентяю - отдельный земной поклон за книгу. Alaspher - за иллюстрации. Проблема решена. Если интересно, код: Код: [Выделить все] ;|============================================================================= * Функция создания размерного стиля. Используется вариант (setvar) и * (vl-cmdf) * Параметры вызова: * нет * Примеры вызова: (_kpblc-create-dimstyle) =============================================================================|; (defun _kpblc-create-dimstyle (/ ent_list exist_style arrow_block active_dimstyle) ;; Локальные функции (defun _kpblc-create-sub-dimstyle (style-number / ent_list ent_name) (setq ent_name (if style-number (strcat "SPDS$" (itoa style-number)) "SPDS" ) ;_ 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" "SPDS")) ;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 (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) (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 . "SPDS") ; 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" "SPDS")) ;; Стиль есть, возвращаем стандартный вид (foreach item ent_list (_kpblc-ent-modify exist_style (car item) (cdr item)) ) ;_ end of foreach ;; Стиля нет, делаем его и нормализуем все примитивы (entmake ent_list) ) ;_ end of if (setvar "textstyle" "SPDS") ;(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 В коде используется немного переработанная функция из ruCAD (ru-ent-mod) для обработки записей таблиц STYLE и DIMSTYLE. Мало ли, может, кому и пригодится...

Есть вопрос если я использую языки с обратным написанием (иврит) в 71 коде на что мне надо поменять значение,
что-бы подключить "обратнописание" , пробовал поменять "0" на "1" непомогает

Код:

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

 '(71 . 1)			; not backwatf, not upside

[Holon]

Все разобрался, для создания текстового стиля с "обратнописанием" нужно в коде писать "2"

Код:

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

'(71 . 2)			; not backwatf, not upside down

[VVA]

РАз уж тема поднялась, добавлю еще одну ссылочку на программное создание размерных стилей
http://www.theswamp.org/index.php?topic=23586.0

[skkkk]

Мне часто бывают нужны размерные линии с одной стрелкой и с масштабом размерного значения 0,5. Я создаю новый стиль на основе ISO-25, в настройках убираю выносные линии, одну стрелку (первую привык) и выставляю масштаб (остальное - по умолчанию. Естественно, в каждом файле надо это делать, либо копировать такую стрелку из другого файла....
kpblc, можно ли с помощью твоего лиспа сделать это?? В идеале хотелось бы так:
1.Жму кнопку на панели
2.Создается вышеописанный размерный стиль, сразу же включается, и система предлагает кликнуть первую, затем вторую точки размерной линии.
3.Вот линия на месте, включается обратно ранее установленный размерный стиль
4.При нажатии правой кнопки мыши - повтор команды, т.е., видимо, не макрос это должен быть и не функция....Может, я не все понимаю


А вообще, считаю, что лиспик очень серьезен

[Кулик Алексей aka kpblc]

Ну а почему бы нет? Есть вопрос: а этот "собственный" стиль относиться будет к каким размерам (линейный? выравненный? угловой?); верно ли я понял, что стрелка, остающаяся "на месте" - это заполненная?
Попробую сегодня на обеде (если не загрузят по самое не хочу)...

[skkkk]

В основном пользуюсь параллельным. Стрелка, да, заполненная

[Кулик Алексей aka kpblc]

Чего-то никак не получается победить "отсутствие" размерной стрелки. Должно быть просто до безобразия, ан никак
Еще вечером попробую глянуть.

[Sleekka]

Чего-то никак не получается победить "отсутствие" размерной стрелки. Должно быть просто до безобразия, ан никак Еще вечером попробую глянуть.

Я не очень понял чего не получается, поясните плиз.
ЗЫ:Эх. А как узнать dxf код соответствующий переменной dimtfill?

[Кулик Алексей aka kpblc]

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