[tolapap]

При использовании функции Autocad зависает!
В чом ошибка ?

Код:

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

(defun prof ( / dcl_id all dx dy) 
(alert "\nЖдите..  Программа загружается …") 
(setq dcl_id (load_dialog "C:\\Program Files\\AutoCAD 2009\\AcadLsp\\St_prof\\prof.dcl")) 
(new_dialog "prof" dcl_id) 
(action_tile "cancel" "(done_dialog 0)") 
(action_tile "accept" "( insertprof)") 
; Имена изображений 
(setq all 
  (list "001" "002" )) 
(start_list "names") 
(mapcar 'add_list all) 
(end_list) 
; Отметка первого в списке имени 
(set_tile "names" "0") 
; Размеры левого графического элемента 
(setq dx (dimx_tile "sld1") dy (dimy_tile "sld1")) 
; Загрузка первого слайда 
(start_image "sld1") 
(slide_image 0 0 dx dy "My(001)") 
(end_image) 
; Обработка выбора имени в списке 
(action_tile "names" "(change_s $value all dx dy)") 
(start_dialog) 
(unload_dialog dcl_id) 
); defun slide 
; Функция при нажатии на ОК! 
(defun insertprof() 
(alert "Кнопка ОК!") 
(setvar "CMDECHO" 0) 
(setq old_osmode (getvar "OSMODE")) 
(setvar "OSMODE" 0) 
(command "_-INSERT" "C:\\Program Files\AutoCAD 2009\AcadLsp\St_prof\Block\001") 
(alert "Фнкция вставки") 
(done_dialog 0) 
); 
; Функция смены слайда 
(defun change_s (sn nlist x y / i name) 
  (setq i (atoi sn) name (nth i nlist)) 
  ; Замена слайда 
  (start_image "sld1") 
  (fill_image 0 0 x y -2) 
  (slide_image 0 0 x y (strcat "My(" name ")")) 
  (end_image) 
);

[skkkk]

Спасибо, Vildar, похоже, что так оно и есть. Я видел эту галочку в интерактивном режиме (_block), но сначала забыл, что блоки в каждом из файлов создал по-своему. Что же тогда получается, что при создании блока в прозрачном режиме (_-block) опции Одинаковый масштаб нет? Или это системная переменная?

[Vildar]

Проверис сис. переменные, до и после. интересующих различий не нашел (проверял с помощью експрессов и екселя).
Но галочка "Одинакового масштаба" действительно где-то хранится. Потому что, сохраниет свое состояние после закрытия окна создания блока, и более того, между сеансами акада. Реестр нужно дампнуть. Где-то была утилита.

Есть контакт.
[HKEY_CURRENT_USER\Software\Autodesk\AutoCAD\R17.1\ACAD-6001:419\Profiles\Autocad\Dialogs\block_definition_dialog]
"ScaleUniform"=dword:00000001 - галка стоит
"ScaleUniform"=dword:00000000 - галка лежит

В описании блока этот параметр тоже хранится. Где?

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

Теоретически она хранится в описании блока.

Код:

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

(vl-load-com)

(defun scaleable-blocks (make / adoc)
  ;; make -> делать блоки только с одинаковым масштабом (t) или нет (nil)
  (vla-startundomark
    (setq adoc (vla-get-activedocument (vlax-get-acad-object)))
    ) ;_ end of vla-StartUndoMark
  (setq make (if make
               1
               0
               ) ;_ end of if
        ) ;_ end of setq
  (vlax-for blk_def (vla-get-blocks adoc)
    (if (and (not (equal blk_def (vla-get-modelspace adoc)))
             (equal (vla-get-islayout blk_def) :vlax-false)
             ) ;_ end of and
      (vla-put-blockscaling blk_def make)
      ) ;_ end of if
    ) ;_ end of vlax-for
  (vla-endundomark adoc)
  (princ)
  ) ;_ end of defun

[Vildar]

Ага, для вба значица:

BlockScaling AcBlockScaling enum; read-write acAny acUniform

Лень просто одолела.