[DANZZ]

Вопрос первый:
Как программно сделать чтоб блоки создавались с разными именами, т.е имя блока изменялось на 1 (block1, block2, block3....)
(command "_block" "block???" p22 Choice "")
Второй вопрос:
Как при создании атрибута установить режимы так (Скрытый-Нет, Постоянный-Нет, Контролируемый-Да, Установленный-Да)

[DEM]

Молодца.
А то раньше напишите мне лисп, напишите.
1. Посмотри внимательно при вставке -INSERT можно менять атрибуты блоков.
2. Если у тебя автокад 2006 то там все просто в редакторе блоков.
Если более ранняя версия то при вставке атрибутов в блок (в отдельном файле создаешь свой блок и туда же вставляешь атрибуты)
Може чего не так сказал, старшаки под правят.
PS. Если будешь делать свою программу с вставкой блоков то обрати внимание, что если все сделано в 2006 то в 2004 скорее всего работать не будет придется переписыватьпод 2004. По крайней мере мне пришлось так делать. Хотя в каде 2006 намного удобнее все делается.

[DANZZ]

Сообщение от DEM 1. Посмотри внимательно при вставке -INSERT можно менять атрибуты блоков.

(command "_insert" "имя блока" Точка_вставки Масштаб_по_X Масштаб_по_Y Масштаб_по_Z)
или я чего-то не того делаю?
Как здесь поменять свойства атрибутов

[DEM]

Создаешь отдельный файл с описанием блока (чертеж твоего блока),
при этом не делаешь из него блок.
В этом же файле создаешь атрибуты команда _attdef (там все номано написано).
Сохраняешь файл в путях поддержки.

[DANZZ]

после (command "_attdef"
Введите название изменяемого режима
[Скрытый/Постоянный/Контролируемый/Установленный/Фиксированное положение]
<готово>: С
Текущие режимы атрибута:
Скрытый=Н Постоянный=Н Контролируемый=Д Установленный=Д

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

[DEM]

Кад 2006 вот ответ на твои вопросы юный Джедай.

[DEM]

Кад 2006 вот ответ на твои вопросы юный Джедай.

[DANZZ]

Это значит никак не узнать?

[DANZZ]

Это значит никак не узнать?

[KAI]

Код:

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

(defun CREATE_BL_COLLAR (name_bl / ss am cc)   (setq am (getvar "AFLAGS"));
  (setq cc (getvar "CECOLOR"))
  (setvar "CECOLOR" "BYBLOCK")
  (setq ss (ssadd))
  (setvar "clayer" "0")
  (command "._CIRCLE" '(0 0 0) "0.5"); создаем нужные объекты далее
  (setq ss (ssadd (entlast) ss))
  (command "._DONUT" "0" "0.7" '(0 0 0) "")
  (setq ss (ssadd (entlast) ss))
  ;
;;;  (SETLAYER (strcat geo_laydh_colattr- )); если атрибуты следует располагать на конкретном слое
  (setvar "CECOLOR" "BYLAYER")
  (setvar "AFLAGS" 0);см пояснения внизу (в данном случае - видимые)
  (command "._-ATTDEF" "" "HOLE_ID" "HOLE_ID" "" "_J" "_ML" '(0.8 0 0) "0.8" "0"); а далее нужные атрибуты
  (setq ss (ssadd (entlast) ss))
  (command "._-ATTDEF" "" "HOLE_ELEV" "HOLE_ELEV" "" "_J" "_ML" '(0.8 -1.2 0) "0.8" "0")
  (setq ss (ssadd (entlast) ss))
  ;
  (setvar "clayer" "0")
  (command "._-BLOCK" name_bl '(0 0 0) ss "")
  (setvar "ATTMODE" am); возвращаем значения сист.переменных
  (setvar "CECOLOR" cc)
;;;  (princ (strcat "\n" (MES 404);404="Created default block" ;сообщение о создании блока, если необходимо
;;;                 " '" name_bl "' " (MES 405)));405="for COLLARS."
);end of **********CREATE_BL_COLLAR***********
;

Из справки по AFLAGS:
AFLAGS System Variable
Type: Integer
Saved in: Not-saved
Initial value: 16
Sets options for attributes. The value is the sum of the following:
0 No attribute mode selected
1 Invisible
2 Constant
4 Verify
8 Preset
16 Lock position in block

Ну а имя блока увеличить на 1 не сложно.
p.s. обычно лучше создавать блоки единичного размера, на слое 0 и цветом ByLayer, а уж вставлять по -Insert в нужном масштабе, цвете и др.

[Лентяй]

Вот, наваял от безделья.

Код:

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

;MkBlkAttr (C) Лентяй 2006
;Добавляет контролируемые предустановленные атрибуты в существующие блоки и cоздает новые блоки,
;состоящие из одних контролируемых предустановленных атрибутов. 
(defun C:MkBlkAttr ( / adoc lyrs lay ats strs opt ht prm ip tg val) 
  (setq adoc (vla-get-ActiveDocument (vlax-get-acad-object)))
  (mapcar '(lambda (x y) (set x (vlax-get-property adoc y))) '(lyrs bks util) '(Layers Blocks Utility))
  (setq bnm (vla-getString util :vlax-false "Введите имя блока: "))
  (if (vl-catch-all-error-p (vl-catch-all-apply 'vla-item (list bks bnm)))
    (progn (vla-add bks bnm) (setq blk (vla-item bks bnm))
      (vla-put-InsertionPoint blk (vla-getPoint util nil "Укажите точку вставки блока: ")))
    (setq blk (vla-item bks bnm));if
  (setq ats (while (= opt "Да") (cons (list              
               (setq ht (vla-getReal util "Введите высоту текста атрибута <" (if (null ht0) "" (rtos ht0 2 1)) "> :")
                     strs (mapcar '(lambda (a0 a x) (if (null a0) (setq a0 ""))
                                     (setq a (vla-getString util :vlax-true (strcat "Введите " x "атрибута: <" a0 ">")))
                                     (if (= a "") (setq a a0) (setq a0 a)))
                            (list tg0 prm0 val0 lay0) '(tg prm val lay) '("ярлык" "текст приглашения" "значение" "имя слоя"))
                     ip (vla-getPoint util nil "Укажите точку вставки атрибута в блок: "))
               (vla-InitializeUserInput util 128 "Да Нет")
               (setq opt (vla-getKeyword util "Определить новый атрибут [Да/Нет]: ?<Да>"))
               (if (= opt "") (setq opt "Да"))) ats)));setq
  (foreach at ats (vla-addAttribute blk ht acAttributeModeVerify acAttributeModePreset ht prm ip tg val))
  (setq ats (vlax-safearray->list (vlax-variant-value (vla-getAttributes blk))))
  (foreach at ats (foreach str strs (if (member str (vla-get-Tagstring at)) (progn
     (if (vl-catch-all-error-p (vl-catch-all-apply 'vla-item (list lyrs lay))) (vla-add lyrs lay))
       (vla-put-layer (cadr at) (last str))))));foreach
);end

Пжалста, доложьте о результатах, т.к. мне проверять было лень

[fixo]

Попробуй попроще:

Код:

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

(command "-insert" "MyBlock" (getpoint) 1 1 0)
(initdia)
(command "attedit" "L")

Fatty

~'J'~

[DANZZ]

Сообщение от Лентяй Пжалста, доложьте о результатах, т.к. мне проверять было лень

выдает ошибку "Неверно сформированный список на выходе".
AFLAGS то что надо!!!

[Лентяй]

Держите отрихтованную прогу. На этот раз проверял, все работает.

Код:

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

;MkBlkAttr (C) Лентяй 2006 
;;;Добавляет контролируемые предустановленные атрибуты в существующие блоки и cоздает новые блоки, 
;;;состоящие из одних контролируемых предустановленных атрибутов. 
;;;
(defun C:MkBlkAttr ( / adoc lyrs bks util bnm blk ats opt ht ht0) 
  (setq adoc (vla-get-ActiveDocument (vlax-get-acad-object))) 
  (mapcar '(lambda (x y) (set x (vlax-get-property adoc y))) '(lyrs bks util) '(Layers Blocks Utility)) 
  (setq bnm (vla-getString util :vlax-false "Введите имя блока: ")) 
  (setq blk (if (vl-catch-all-error-p (vl-catch-all-apply 'vla-item (list bks bnm)))
              (vla-add bks (vla-getPoint util nil "Укажите точку вставки блока: ") bnm)
              (vla-item bks bnm))
        opt (if (null opt) "Да"));setq
  (while (= opt "Да")
    (setq ht (if (vl-catch-all-error-p (vl-catch-all-apply '(lambda ()
                   (setq ht (vla-getReal util (strcat "Введите высоту текста атрибута <" (if (null ht0) "" (rtos ht0 2 3)) ">: "))))))
               ht0 ht) ht0 ht
          ats (cons (cons ht (cons (vla-getPoint util nil "Укажите точку вставки атрибута в блок: ")
                                   (mapcar '(lambda (x) (vla-getString util :vlax-true (strcat "Введите " x " атрибута: ")))
                                     '("ярлык" "текст приглашения" "значение" "имя слоя")))) ats));setq
    (vla-InitializeUserInput util 128 "Да Нет")
    (setq opt (vla-getKeyword util "Определить новый атрибут [Да/Нет]? <Да>"))
    (if (= opt "") (setq opt "Да")));while
  (foreach at (reverse ats) (vla-addAttribute blk (nth 0 at) 12 (nth 3 at) (nth 1 at) (nth 2 at) (nth 4 at)))
  (vlax-for at blk
    (if (= (vla-get-objectname at) "AcDbAttributeDefinition")
      (foreach el ats (if (member (vla-get-Tagstring at) el)
          (progn (if (vl-catch-all-error-p (vl-catch-all-apply 'vla-item (list lyrs (last el)))) (vla-add lyrs (last el)))
            (vla-put-layer at (last el)))))));vlax-for
);end

[DANZZ]

Все работает, спасибо