[编程交流] 使用浏览到插入器的Lisp/DCL

;* ВСТАВКА БЛОКОВ ИЗ БИБЛИОТЕКИ * ВЫЗОВ: NBB *
;                4/11/05                8:20 AM                ;
     ////////////   ////////////   
    ////////////   /////////////   
          /////   /////    /////    
         /////   /////    /////   
        /////   //////////////   
       /////   /////////////   
      /////   ///// ////  
     /////   /////  ////      
 ////////   /////   //////    ////
///////    /////    /////    ////
;;;;=========================================================
;;;;  | my-block-lib-dcl.lsp | Copyright (c) 2005 Oleg Jr |  
;;;;=========================================================
(defun make-lib-dial ()
(setq fname (vl-filename-mktemp "libris.dcl"))
;;; (setq fname (strcat (getvar "dwgprefix") "librys.dcl")) 
(setq fn (open fname "w"))
(write-line "libres : dialog {"  fn)
(write-line (strcat "label = " """  "LIST OF LIBRARIES" """ ";") fn)
(write-line ": row {" fn)
(write-line ": column {" fn)  
(write-line ": list_box {" fn)
(write-line (strcat "label = " """ "Select File"  """ ";")  fn)  
(write-line (strcat "key = " """ "dwg_list" """ ";")  fn)
(write-line "width = 20; height = 8;}"  fn)
(write-line "}" fn)  
(write-line ": column {" fn)     
(write-line ": list_box { label = "Select Block";" fn)
(write-line (strcat "key = " """ "slides" """ ";")  fn)
(write-line "width = 16; height = 8;}" fn)
(write-line "}" fn)
(write-line "}" fn)
(write-line ": column {" fn)  
(write-line (strcat ": text_part {value = "  """ "  Block Image" """ ";") fn)
(write-line "alignment = children_alignment; }" fn) 
(write-line (strcat ": image { key = " """ "dwg_image" """ ";")  fn)
(write-line "color = graphics_foreground;" fn)
(write-line "width = 36; height = 12;}" fn) 
(write-line "}" fn)  
(write-line "spacer;" fn)  
(write-line "ok_cancel; " fn) 
(write-line "}" fn)  
(close fn)
)
;;;(make-lib-dial);ok
;        Function from Tony Tanzillo        ;
(defun my-browse-folder (msg path / sh fld folderobject result)
(vl-load-com)
(setq sh (vla-getInterfaceObject (vlax-get-acad-object)
"Shell.Application"))
(setq fld (vlax-invoke-method sh 'BrowseForFolder
0
msg ; dialogue box message
512 ; BIF_NONEWFOLDERBUTTON Bruno Toniutti
path ; path start
)
)
(vlax-release-object sh)
(if fld
(progn
(setq folderobject (vlax-get-property fld 'Self))
(setq result (vlax-get-property FolderObject 'Path))
(vlax-release-object fld)
(vlax-release-object folderobject )
result
)
)
)
;                                        ;
(defun my-block-files (path / lst)
(setq lst 
(vl-directory-files path  "*.dwg" 1))
lst
)
;                                        ;
(defun set_list (name lst)
(start_list name)
(mapcar 'add_list lst)
(end_list))
;                                        ;
(defun set_val (name val)
 (set_tile name val))
;                                        ;
(defun set_image (val)  
(start_image "dwg_image")
(fill_image 0 0
 (dimx_tile "dwg_image")
 (dimy_tile "dwg_image") -2)
(slide_image 0 0
 (dimx_tile "dwg_image")
 (dimy_tile "dwg_image") val)
(end_image)
)
;                                        ;
(defun add_blocks (lib_name path / )
(setq pat (vl-string-right-trim ".dwg" lib_name)
     sld_lst (acad_strlsort       
     (vl-remove-if (function not)
     (mapcar (function (lambda (x)(if
     (wcmatch  (substr x 1 (strlen pat)) pat) x)))
     (vl-directory-files path "*.sld" 1))))))
;                                        ;
(defun run-lib-dial () 
(setq blk_lst nil)
(setq path (my-browse-folder
     "Select Library Folder"
     "D:\\AUTOLISP\\SAPR\"));<--change path here
(setq blk_lst (my-block-files path))  
(setq dcl_ex (load_dialog fname))
(new_dialog "libres" dcl_ex)  
(set_list "dwg_list" blk_lst)
 
(action_tile "dwg_list" (strcat
"(progn "
"(setq lib_name (nth (atoi $value) blk_lst))"
"(setq sld_lst (add_blocks lib_name path))"
"(set_list "slides" sld_lst))")) 
(action_tile "slides" (strcat
"(progn "
 "(setq sld (nth (atoi $value) sld_lst))"
 "(set_image  (strcat path "\\\\"
 (vl-string-subst "" ".sld"  sld))))" ))
(action_tile "accept" "(done_dialog 1)")
(action_tile "cancel" "(done_dialog 0)")
(setq knock (start_dialog))
(unload_dialog dcl_ex)
(done_dialog)
(vl-file-delete fname)
)
                                                        ;
(defun c:nbb ()
 
(vl-load-com)
 
(make-lib-dial)
(run-lib-dial)
(if (= knock 1)
(progn
(command "_.insert" (strcat path "\" lib_name))
(command)
(setq blk (vl-string-subst "" ".sld" sld))
(if (tblsearch "block" blk)  
(vl-cmdf "_.insert" blk
        (getpoint "\nPick Point:") 1 1 0)
(progn
(vla-eval (vlax-get-acad-object)
(strcat "MsgBox "" (strcat "Block: " blk  " not found ") """ ", "
"vbcritical" ", " """ "NOTE:" """))
(princ)))))
(princ))
;
;                                                                ;
(prompt "\n\t\t***\tStart command with NBB to run\t***")
(princ)
;                                        ;