Как взорвать все блоки на листах разом.

zmejsan · 08.11.2014, 21:48

Дорогие знатоки случилась вот такая штука с которой я не смог справиться самостоятельно:
В модели работаю с блоками (обычными, динамическими) с таблицами и расчетами в них. А в листах имеются таблицы ссылающиеся на таблицы в модели и денамические блоки. С этим со всем работать умею только я. И в компании требуют это все взрывать перед сдачей. Работа трудоемкая и долгая. Нужно сделать так чтобы при нажатии 1 кнопки запустился процесс поиска и взрыва. Причем не просто взорвать блоки динамические командой автокада а командой экспрестулса. т.е. все отребуты при это перевести в текст.
Надеюсь будут хоть какие нибудь идеи для сокращения моего времени. Все заранее спасибо!!!

posetitel · 24.05.2023, 14:54

Цитата:

Сообщение от VVA

Как-то так. Без проверки

Код:

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

(defun C:ARMAGEDON ()
;;;BGTOOLS и ALLSPACESBURST должны быть загружены
;;; http://forum.dwg.ru/showthread.php?p=1671168#post1671168
(vl-load-com)
(VL-CATCH-ALL-APPLY
  '(lambda( / lay)
     (if(setq lay(mydcl "Выберите слой для удаления" (acad_strlsort(vl-remove "0"(tablelist "LAYER")))))
       (progn
         (if (= (getvar "CLAYER") lay)(setvar "CLAYER" "0"))
         (bg:layer-status-save)
         (vla-put-Freeze (vla-item (vla-get-Layers (vla-get-ActiveDocument(vlax-get-acad-object))) lay) :vlax-true)
         (bg:delete-from-layer)
         (bg:layer-status-restore)
         )
       )
     )
  )  
(bg:progress-clear)
(bg:progress-init "Работаю..." 6)
(bg:progress 1)
(ConvField->Text nil) ;_(C:BGCFT) Без запроса
(bg:progress 2)
(C:BGBLALLDYN2S)
(bg:progress 3)
(bg:blfix (cons 49444 (tablelist "BLOCK"))) ;_устанавливаем у всех блоков разрешить расчленение - Да
(bg:progress 4) 
(C:ALLSPACESBURST)
(bg:progress 5)  
(repeat 3 (vla-purgeall (vla-get-activedocument (vlax-get-acad-object))))
(bg:progress 6)

(vla-SaveAs
  (vla-get-activedocument (vlax-get-acad-object))
  (strcat
    (getvar "DWGPREFIX")
    (vl-filename-base(getvar "DWGNAME"))
    "_взорв"
    (vl-filename-extension(getvar "DWGNAME"))
    )
    acNative
  )
)
(defun mydcl (zagl info-list / fl ret dcl_id)
      ;;;Use
      ;;;(mydcl "Test" '("1" "2" "3" "4"))
      (vl-load-com)
      (if (null zagl)
        (setq zagl "Выбор")
      ) ;_ end of if
      (setq fl (vl-filename-mktemp "mip" nil ".dcl"))
      (setq ret (open fl "w"))
      (mapcar
        '(lambda (x) (write-line x ret))
        (list "mip_msg : dialog { "
              (strcat "label=\"" zagl "\";")
              " :list_box {"
              "alignment=top ;"
              "width=51 ;"
              "allow_accept = true;"
              "tabs = \"16 32\";"
              "tab_truncate = true;"
              (if (> (length info-list) 26)
                "height= 26 ;"
                (strcat "height= " (itoa (+ 3 (length info-list))) ";")
              ) ;_ end of if
              "is_tab_stop = false ;"
              "key = \"info\";}"
              "ok_cancel;}"
        ) ;_ end of list
      ) ;_ end of mapcar
      (setq ret (close ret))
      (if (and (not (minusp (setq dcl_id (load_dialog fl))))
               (new_dialog "mip_msg" dcl_id)
          ) ;_ end of and
        (progn
          (start_list "info")
          (mapcar 'add_list info-list)
          (end_list)
          (set_tile "info" "0")
          (setq ret (car info-list))
          (action_tile
            "info"
            "(setq ret (nth (atoi $value) info-list))"
          ) ;_ end of action_tile
          (action_tile
            "cancel"
            "(progn(setq ret nil)(done_dialog 0))"
          ) ;_ end of action_tile
          (action_tile "accept" "(done_dialog 1)")
          (start_dialog)
        ) ;_ end of progn
      ) ;_ end of if
      (unload_dialog dcl_id)
      (vl-file-delete fl)
      ret
    ) ;_ end of defun

А можно сюда дописать еще команду, чтобы созданный чертеж (тот чертеж, который получился путем выполнения лиспа, с именем DWGNAME_взорв.dwg) закрылся и открылся исходный, в котором остались невзорванные блоки, неудаленные слои, ну т.е. изначальный чертеж DWGNAME.dwg ?

VVA · 30.05.2023, 13:20

Цитата:

Сообщение от posetitel

А можно сюда дописать еще команду, чтобы созданный чертеж (тот чертеж, который получился путем выполнения лиспа, с именем DWGNAME_взорв.dwg) закрылся и открылся исходный, в котором остались невзорванные блоки, неудаленные слои, ну т.е. изначальный чертеж DWGNAME.dwg ?

Без проверки. Добавленные строки помечены ;_Add 2023_05_30

Код:

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

(defun C:ARMAGEDON ( / o_dwg)
;;;BGTOOLS и ALLSPACESBURST должны быть загружены
;;; http://forum.dwg.ru/showthread.php?p=1671168#post1671168
(vl-load-com)
(VL-CATCH-ALL-APPLY
  '(lambda( / lay)
     (if(setq lay(mydcl "Выберите слой для удаления" (acad_strlsort(vl-remove "0"(tablelist "LAYER")))))
       (progn
         (if (= (getvar "CLAYER") lay)(setvar "CLAYER" "0"))
         (bg:layer-status-save)
         (vla-put-Freeze (vla-item (vla-get-Layers (vla-get-ActiveDocument(vlax-get-acad-object))) lay) :vlax-true)
         (bg:delete-from-layer)
         (bg:layer-status-restore)
         )
       )
     )
  )  
(bg:progress-clear)
(bg:progress-init "Работаю..." 6)
(bg:progress 1)
(ConvField->Text nil) ;_(C:BGCFT) Без запроса
(bg:progress 2)
(C:BGBLALLDYN2S)
(bg:progress 3)
(bg:blfix (cons 49444 (tablelist "BLOCK"))) ;_устанавливаем у всех блоков разрешить расчленение - Да
(bg:progress 4) 
(C:ALLSPACESBURST)
(bg:progress 5)  
(repeat 3 (vla-purgeall (vla-get-activedocument (vlax-get-acad-object))))
(bg:progress 6)
(setq o_dwg (strcat(getvar "DWGPREFIX")(getvar "DWGNAME"))) ;_Add 2023_05_30
(vla-SaveAs
  (vla-get-activedocument (vlax-get-acad-object))
  (strcat
    (getvar "DWGPREFIX")
    (vl-filename-base(getvar "DWGNAME"))
    "_взорв"
    (vl-filename-extension(getvar "DWGNAME"))
    )
    acNative
  )
 (vla-activate(vla-open (vla-get-documents (vlax-get-acad-object))(findfile o_dwg) :vlax-false)) ;_Add 2023_05_30
 )
(defun mydcl (zagl info-list / fl ret dcl_id)
      ;;;Use
      ;;;(mydcl "Test" '("1" "2" "3" "4"))
      (vl-load-com)
      (if (null zagl)
        (setq zagl "Выбор")
      ) ;_ end of if
      (setq fl (vl-filename-mktemp "mip" nil ".dcl"))
      (setq ret (open fl "w"))
      (mapcar
        '(lambda (x) (write-line x ret))
        (list "mip_msg : dialog { "
              (strcat "label=\"" zagl "\";")
              " :list_box {"
              "alignment=top ;"
              "width=51 ;"
              "allow_accept = true;"
              "tabs = \"16 32\";"
              "tab_truncate = true;"
              (if (> (length info-list) 26)
                "height= 26 ;"
                (strcat "height= " (itoa (+ 3 (length info-list))) ";")
              ) ;_ end of if
              "is_tab_stop = false ;"
              "key = \"info\";}"
              "ok_cancel;}"
        ) ;_ end of list
      ) ;_ end of mapcar
      (setq ret (close ret))
      (if (and (not (minusp (setq dcl_id (load_dialog fl))))
               (new_dialog "mip_msg" dcl_id)
          ) ;_ end of and
        (progn
          (start_list "info")
          (mapcar 'add_list info-list)
          (end_list)
          (set_tile "info" "0")
          (setq ret (car info-list))
          (action_tile
            "info"
            "(setq ret (nth (atoi $value) info-list))"
          ) ;_ end of action_tile
          (action_tile
            "cancel"
            "(progn(setq ret nil)(done_dialog 0))"
          ) ;_ end of action_tile
          (action_tile "accept" "(done_dialog 1)")
          (start_dialog)
        ) ;_ end of progn
      ) ;_ end of if
      (unload_dialog dcl_id)
      (vl-file-delete fl)
      ret
    ) ;_ end of defun

posetitel · 30.05.2023, 13:55

Спасибо, лисп работает, но если можно, попрошу небольшую отладку:
после выполнения лиспа остается открытый взарванный чертеж и открывается нормальный рабочий чертеж.
Если самому не закрыть взорванный, то повторно лисп не сработает.
Доработка - это закрыть сохраненный взорванный чертеж.
Идея то была как раз, чтобы когда выполнил всю работу с чертежом, сохранил его, взорвал для передачи, и тут как раз попалась на глаза досадная очепятка, вот чтобы не заходить заново в рабочий, просто еще разок взорвал, т.е. пересохранил прошлый взорванный и радуешься результату).
Понимаю, что это уже будет правка исходной идеи кода, т.к. первоначально как раз и оставался открытым взорванный чертеж (вот как раз на нем если попадаются на глаза опечатки, начинается поиск исходника, повторное открытие и т.д.)

doctorraz · 30.05.2023, 14:24

Цитата:

Сообщение от posetitel

Доработка - это закрыть сохраненный взорванный чертеж

Взорвать
Saveas
Undo

Похожие темы
Тема	Автор	Раздел	Ответов	Последнее сообщение
Поменяли плоттер. Как заменить разом плоттер на всех листах, в параметрах листов, на другой плоттер?	Palomnic	AutoCAD	5	14.12.2012 12:41
Динамические блоки при копировании перестают быть динамическими.	Voland	Динамические блоки	11	04.07.2012 10:51
ЛИСП слои цвета преобразование	Gotch	LISP	97	08.11.2011 10:22
Разбиение черечежа откоса на геологические блоки в VBA	Skyper	Программирование	1	18.03.2010 08:54
Взорвать все блоки файла сразу	Red Nova	AutoCAD	9	26.05.2009 11:16

08.11.2014, 21:48
Как взорвать все блоки на листах разом. zmejsan Регистрация: 27.06.2013 Сообщений: 58 Дорогие знатоки случилась вот такая штука с которой я не смог справиться самостоятельно: В модели работаю с блоками (обычными, динамическими) с таблицами и расчетами в них. А в листах имеются таблицы ссылающиеся на таблицы в модели и денамические блоки. С этим со всем работать умею только я. И в компании требуют это все взрывать перед сдачей. Работа трудоемкая и долгая. Нужно сделать так чтобы при нажатии 1 кнопки запустился процесс поиска и взрыва. Причем не просто взорвать блоки динамические командой автокада а командой экспрестулса. т.е. все отребуты при это перевести в текст. Надеюсь будут хоть какие нибудь идеи для сокращения моего времени. Все заранее спасибо!!!
Просмотров: 27922