Как вставить блок из файла? (Страница 1 из 2)

(defun INSBLOCK ( name name_fil / atr atd cmd)
  (if(not(tblsearch "Block" name))
    (if(copyblock name name_fil)(command "Insert" name pause 1 1 0))
    (command "Insert" name pause 1 1 0)
  )
)

;* This is present to **** from Fatty aka Oleg Jr aka fixo *
;|Эта программа позволяет вставлять блоки из другого
чертежа в текущий чертеж
Блоки должны быть скомпонованы по отдельным рисункам
соответственно каждому из заданных типов
Эти рисунки должны располагаться в одной отдельной
папке пользовательской директории
Файлы блоков поименованы с одинаковой общей частью имени в данном случае
"tornillo-" (винт) далее к корневой части имени по выбору
из диалога добавляется окончание, например "com" т.е. определяется
имя файла "tornillo-com" и ищется библиотечный файл "tornillo-com.dwg"
с интересующими нас блоками (винт с кругл. голов.), после этого блок
вставляется с запросомточки вставки в натуральных размерах. Просьба
рассматривать как один из путей решения, а не как окончательный вариант,
поскольку рутина написана "вслепую" без конкретного теста на блоки
и представляет собой черновой вариант.Общий тест проведен на ACAD2005.
;;;This program makes it possible to put blocks from another drawing
;;;in the current drawing blocks they must be arranged according
;;;to the separate drawings of the respectively assigned types
;;;these drawings they must be located in one separate folder
;;;of the user directory
;;;Este programa permite poner bloques de otros que dibujan
;;;en los bloques del dibujo actual que deben ser arreglados
;;;segun los dibujos separados de los tipos respectivamente
;;;asignados estos dibujos deben ser situados en una carpeta
;;;separada del directorio de usuario|;
;        Черновой вариант        ;
         ////////////   ////////////
        ////////////   /////////////
              /////   /////    /////
             /////   /////    /////
            /////   //////////////
           /////   /////////////
          /////   ///// ////
         /////   /////  ////
     ////////   /////   //////    ////
    ///////    /////    /////    ////
;;==========================================================;
;; * | TORNILLO-LIBRARY.lsp | Copyright (c) 2005 Oleg Jr | *;
;;==========================================================;
;                                ;
(defun initax ()
(vl-load-com)
(or acapp (setq acapp (vlax-get-acad-object)))
(or adoc (setq adoc (vla-get-activedocument acapp)))
(cond  ((= (vlax-variant-value
(vla-getvariable adoc "TILEMODE")) 1)
    (or acsp (setq acsp (vla-get-modelspace adoc))))
       ((= (vlax-variant-value
(vla-getvariable adoc "TILEMODE")) 0)
    (or acsp (setq acsp (vla-get-paperspace adoc))))))
;                                ;
(defun make-torn-dial ()
(setq fname (vl-filename-mktemp "tornillos.dcl"))
;;;(setq fname (strcat (getvar "dwgprefix") "tornillos.dcl"))
(setq fn (open fname "w"))
(write-line "libres : dialog {"  fn)
(write-line
(strcat "label = " "\""  "TORNILLOS, TUERCAS Y ARANDELAS" "\"" ";") fn)
(write-line ": column {" fn)
(write-line ": boxed_column {" fn)
(write-line ": text {label = \"TORNILLOS ALLEN\";}"  fn)
(write-line ": button {label = \"CILINDRICA COM\";key=\"com\";}"  fn)
(write-line ": button {label = \"CILINDRICA BAJA\";key=\"baja\";}"  fn)
(write-line ": button {label = \"BOTON\";key=\"bot\";}"  fn)
(write-line ": button {label = \"AVELLANADO\";key=\"avel\";}"  fn)
(write-line ": button {label = \"PRISIONERO\";key=\"pris\";}}"  fn)
(write-line ": boxed_column {" fn)
(write-line ": text {label = \"TORNILLOS HEXAGONAL\";}"  fn)
(write-line ": button {label = \"HEXAGONAL\";key=\"hexa\";}}"  fn)
(write-line ": boxed_column {" fn)
(write-line ": text {label = \"TUERCAS\";}"  fn)
(write-line ": button {label = \"TUERCAS\";key=\"tuer\";}}"  fn)
(write-line ": boxed_column {" fn)
(write-line ": text {label = \"ARANDELLAS\";}"  fn)
(write-line ": button {label = \"PLAIN\";key=\"plai\";}"  fn)
(write-line ": button {label = \"SPLIT\";key=\"spli\";}}}"  fn)
(write-line "spacer;" fn)
(write-line ": row {" fn)
(write-line "ok_cancel;}}" fn)
(close fn)
)
;                                ;
(defun get-block-file (name)
  (strcat "C:\\MyLisp\\tornillo-" name ".dwg"))
;                                ;
(defun run-torn-dial ()
(setq dcl_ex (load_dialog fname))
(new_dialog "libres" dcl_ex)
(action_tile "com" (strcat
"(progn "
"(setq file_name (get-block-file \"com\"))"
"(done_dialog))"
))
(action_tile "baja" (strcat
"(progn "
"(setq file_name (get-block-file \"baja\"))"
"(done_dialog))"
))
  (action_tile "bot" (strcat
"(progn "
"(setq file_name (get-block-file \"bot\"))"
"(done_dialog))"
))
  (action_tile "avel" (strcat
"(progn "
"(setq file_name (get-block-file \"avel\"))"
"(done_dialog))"
))
  (action_tile "pris" (strcat
"(progn "
"(setq file_name (get-block-file \"pris\"))"
"(done_dialog))"
))
  (action_tile "hexa" (strcat
"(progn "
"(setq file_name (get-block-file \"hexa\"))"
"(done_dialog))"
))
  (action_tile "tuer" (strcat
"(progn "
"(setq file_name (get-block-file \"tuer\"))"
"(done_dialog))"
))
  (action_tile "plai" (strcat
"(progn "
"(setq file_name (get-block-file \"plai\"))"
"(done_dialog))"
))
  (action_tile "spli" (strcat
"(progn "
"(setq file_name (get-block-file \"spli\"))"
"(done_dialog))"
))
(action_tile "accept" "(done_dialog 1)")
(action_tile "cancel" "(done_dialog 0)")
(start_dialog)
(unload_dialog dcl_ex)
(done_dialog)
(vl-file-delete fname)
)
;                                ;
;;;Например (setq file_name (strcat "C:\\MyLisp\\tornillo-" "com" ".dwg"))
(defun get-names-from-another (file_name)
  (if file_name
    (progn
      (setq another_doc
         (vla-getinterfaceobject
           acapp
           "ObjectDBX.AxDbDocument.16"
         )
      )
      (vla-open another_doc file_name)
      (setq another_blocks (vla-get-blocks another_doc))
      (vlax-for    blk another_blocks
    (setq another_block_names
           (cons (vla-get-name blk)
             another_block_names
           )
    )
      )
      (vl-catch-all-error-p
    (vl-catch-all-apply
      (function (lambda ()
              (if (not (vlax-object-released-p another_doc))
            (vlax-release-object another_doc)
              )
            )
      )
    )
      )
    )
  )
  (if another_block_names
    (vl-remove-if
      (function    (lambda    (x)
          (vl-string-search "_Space" x)
        )
      )
      (reverse another_block_names)
    )
  )
)
;                                ;
(defun make-torn-bibl-dial ()
(gc)
(setq fname (vl-filename-mktemp "blk-list-box.dcl"))
;;;(setq fname
;;;(strcat (getvar "DWGPREFIX") "blk-list-box.dcl"))
(setq fn (open fname "w"))
(write-line "setlist : dialog { label = \"SELLECCIONE EL TIPO :\";" fn)
(write-line "spacer_1;" fn)
(write-line ": list_box {" fn)
(write-line (strcat "key = " "\"" "alist" "\"" ";")  fn)
(write-line "alignment = centered; width = 10; height = 12;}" fn)
(write-line "spacer_1;" fn)
(write-line "ok_cancel; " fn)
(write-line "spacer_1;" fn)
(write-line ": text_part {" fn)
(write-line (strcat "value = " "\"" "Designed by Oleg Jr" "\"" ";") fn)
(write-line "alignment = left; }" fn)
(write-line ": text_part {" fn)
(write-line (strcat "value = " "\"" "* From man to man *" "\"" ";") fn)
(write-line "alignment = left; }" fn)
(write-line "}" fn)
(close fn)
)
(defun keep (v)
(setq name (nth (atoi v) blk_list)))
;                                ;
(defun run-torn-bibl-dial ()
(setq dcl_id (load_dialog fname))
(if (not (new_dialog "setlist" dcl_id))
(exit)
)
(start_list "alist")
(mapcar 'add_list blk_list)
(end_list)
(action_tile "alist" "(keep $value)")
(action_tile "accept" "(done_dialog)(setq pick T)")
(action_tile "cancel" "(done_dialog)(setq pick nil)")
(start_dialog)
(unload_dialog dcl_id)
(done_dialog)
(vl-file-delete fname)
)
;                                ;
(defun insert-from-another (file_name name)
  (if name
    (progn
      (setq this_drawing_blocks
         (vla-get-blocks
           (vla-get-activedocument
         (vlax-get-acad-object)
           )
         )
      )
      (setq another_doc
         (vla-getinterfaceobject
           acapp
           "ObjectDBX.AxDbDocument.16"
         )
      )
      (vla-open another_doc file_name)
      (setq another_blocks (vla-get-blocks another_doc))
      (vl-catch-all-error-p
    (vl-catch-all-apply
      (function (lambda ()
              (vla-copyobjects
            another_doc
            (vlax-safearray-fill
              (vlax-make-safearray vlax-vbobject '(0 . 0))
              (list (vla-item another_blocks name))
            )
            this_drawing_blocks
              )
            )
      )
    )
      )
      (vl-catch-all-error-p
    (vl-catch-all-apply
      (function (lambda ()
              (if (not (vlax-object-released-p another_doc))
            (vlax-release-object another_doc)
              )
            )
      )
    )
      )
      (if (vla-item this_drawing_blocks name)
    (progn
      (setq    insert_point
         (getpoint "\nSpecify block insertion point\n")
      )
      (if (not (vl-catch-all-error-p
             (vl-catch-all-apply
               (function (lambda ()
                   (vla-Insertblock
                     acsp
                     (vlax-3d-point insert_point)
                     name
                     1
                     1
                     1
                     0
                   )
                 )
               )
             )
           )
          )
        (princ (strcat "\nBlock "
               name
               " is inserted"
           )
        )
        (princ "\nThere is problem with block insertion")
      )
    )
    (princ (strcat "\nBlock "
               name
               " is not found in database"
           )
    )
      )
      (vl-catch-all-error-p
    (vl-catch-all-apply
      (function
        (lambda ()
          (mapcar (function    (lambda    (x)
                  (if (not (vlax-object-released-p x))
                    (vlax-release-object x)
                  )
                )
              )
              (list this_drawing_blocks
                another_block_list
                another_blocks
              )
          )
        )
      )
    )
      )
    )
  )
  (princ)
)
;                                ;
(prompt "\nType BT to execute block library routine...")
(prompt "\nВвести в командной строеке BT для загрузки программы...\n")
;                                ;
(defun C:bt ()
(initax)
(make-torn-dial)
(run-torn-dial)
(alert file_name)
(setq blk_list nil)
(setq blk_list (get-names-from-another file_name))
(if blk_list
  (progn
    (make-torn-bibl-dial)
    (run-torn-bibl-dial)
    (insert-from-another file_name name)
    )
 (princ "\nThere is problem with access to another file")
 )
 (vla-zoomextents (vla-get-application adoc))
 (vla-regen adoc acactiveviewport)
 (princ)
 )
;                                ;
;|Bonus: Можно также заменить функцию get-block-file на интерактивный
 поиск файла библиотеки блоков через браузер:    |;
;|    Credited from Toni Tanzillo, edited 3/2/05 by Oleg Jr    |;
(defun my-get-path    (;|title|; ;|path|; / sh fld fld_obj answer)
  ;|title - текст сообщения в заголовке браузера м.б. задан как глобал
  path - стартовая директория поиска м.б. задана как глобал|;
  (vl-load-com)
  (setq    sh (vla-getinterfaceobject
         (vlax-get-acad-object)
         "Shell.Application"
       )
  )
  (setq    fld (vlax-invoke-method
          sh
          'BrowseForFolder
          vlax-vbdefaultbutton1
          "ВЫБРАТЬ ДИРЕКТОРИЮ ИЛИ ПАПКУ БИБЛИОТЕКИ БЛОКОВ:";=>title
          vlax-vbdefaultbutton3
          "C:\\MyLisp\\";=>path
         )
  )
  (vlax-release-object sh)
  (if fld
    (progn
      (setq fld_obj (vlax-get-property fld 'Self))
      (setq answer (vlax-get-property fld_obj 'Path))
      (vlax-release-object fld)
      (vlax-release-object fld_obj)
      answer
    )
  )
)
;;;Вызов:(my-get-path ;|title|; ;|path|; )