使用浏览到插入器的Lisp/DCL
早上好我希望在图形中插入块。我有一个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)
; ;
页:
[1]