[LISP]利用ObjectDbx技术在当前图形中插入其它未打开的图形中的图块
;;利用ObjectDbx技术在当前图形中插入其它未打开的图形中的图块;;
;; INS_BLK.LSP
;;
;; 作者: 赖云龙(龙龙仔)
;;
;; E_MAIL: lai_wan_lung@pchome.com.tw
;;
;; 版权所有 (C) 2003
;;
;; 本软件免费可供进行任何用途需求的拷贝、修改及发行, 但请遵循下述原则:
;;
;; 1)上列的版权通告必须出现在每一份拷贝里。
;; 2)相关的说明文档也必须载有版权通告及本项许可通告。
;;
;; 本软件仅提供作为应用上的参考, 而未声明或隐含任何保证; 对于任何特殊
;; 用途之适应性, 以及商业销售所隐含作出的保证, 在此一概予以否认。
(vl-load-com)
(defun C:INS_BLK (/ DWGNAME NAME1 APP
DCL_FILE DCL_NAME DCL_FLAG BLK_LIST
OK_ID DCL_TOG
)
(defun REGISTEROBJECTDBX (/ DBXSERVER) ;by Tony Tanzillo
(cond
((vl-registry-read
"HKEY_CLASSES_ROOT\\ObjectDBX.AxDbDocument\\CLSID"
)
)
((not (setq DBXSERVER (findfile "AxDb15.dll")))
(alert "Error: Can't locate ObjectDBX Library (AxDb15.dll)")
)
(t
(startapp "regsvr32.exe" (strcat "/s \"" DBXSERVER "\""))
(or
(vl-registry-read
"HKEY_CLASSES_ROOT\\ObjectDBX.AxDbDocument\\CLSID"
)
(alert
"Error: Failed to register ObjectDBX ActiveX services."
)
)
)
)
)
(defun INS (ENT / SB)
(if (/= "" DWGNAME)
(progn
(prompt (strcat "\n从图档"
DWGNAME
"插入图块"
(getvar "insname")
"\n"
)
)
(setq SB (vla-item DBXBLOCKS ENT))
(vla-copyobjects
DBXDOC
(vlax-safearray-fill
(vlax-make-safearray
vlax-vbobject
'(0 . 0)
)
(list SB)
)
(vla-get-modelspace DOC)
)
(vlax-release-object SB)
)
(prompt
(strcat "\n从图档" NAME1 "插入图块" (getvar "insname") "\n")
)
)
(command "_.INSERT" "")
)
(defun DWG_SEL (FLAG / STR1 STR2 BLK BLK_NO BLK_NO_TEXT)
(if (= FLAG 1)
(setq DBXBLOCKS (vla-get-blocks DOC))
(progn
(setq
DWGNAME (getfiled "选取图档" (getvar "dwgprefix") "dwg" 8)
)
(if (equal (strcase NAME1) (strcase DWGNAME))
(setq DBXBLOCKS (vla-get-blocks DOC)
DWGNAME ""
)
(progn
(vla-open DBXDOC DWGNAME)
(setq DBXBLOCKS (vla-get-blocks DBXDOC))
)
)
)
)
(setq BLK_LIST '())
(vlax-for BLK DBXBLOCKS
(if (and (not (wcmatch (substr (vla-get-name BLK) 1 1) "`*"))
(= (vla-get-isxref BLK) :vlax-false)
)
(setq BLK_LIST
(append BLK_LIST (list (vla-get-name BLK)))
)
)
)
(if (/= BLK_LIST '())
(setq BLK_LIST (acad_strlsort BLK_LIST))
)
(start_list "dcl_blk_list")
(mapcar 'add_list BLK_LIST)
(end_list)
(setq BLK_NO (length BLK_LIST))
(setq BLK_NO_TEXT
(strcat "图档中的图块\n 共计"
(itoa BLK_NO)
"个"
)
)
(set_tile "dcl_blk_no" BLK_NO_TEXT)
(set_tile "dcl_blk_list" "0")
(FILL_BLK_NAME)
(if (/= "" DWGNAME)
(set_tile "txt_2"
(if (< (strlen DWGNAME) 90)
(progn
(setq STR1 (substr DWGNAME 1 44)
STR2 (substr DWGNAME 45)
)
(strcat STR1 "\n" STR2)
)
(progn
(setq STR1 (substr DWGNAME 1 40)
STR2 (vl-filename-base
(strcase (strcat DWGNAME
(vl-filename-extension DWGNAME)
)
)
)
)
(strcat STR1 "....\n...." STR2)
)
)
)
(set_tile "txt_2"
(if (< (strlen NAME1) 90)
(progn
(setq STR1 (substr NAME1 1 44)
STR2 (substr NAME1 45)
)
(strcat STR1 "\n" STR2)
)
(progn
(setq STR1 (substr NAME1 1 44)
STR2 (vl-filename-base
(strcase (strcat NAME1
(vl-filename-extension NAME1)
)
)
)
)
(strcat STR1 "\n...." STR2)
)
)
)
)
)
(defun FILL_BLK_NAME (/ BLK_ID FILL_NAME)
(setq BLK_ID (get_tile "dcl_blk_list"))
(setq BLK_ID (atoi BLK_ID))
(if (/= BLK_LIST '())
(progn
(setq FILL_NAME (nth BLK_ID BLK_LIST))
(setvar "insname" FILL_NAME)
(set_tile "dcl_blk_name" FILL_NAME)
)
(progn
(setvar "insname" "")
(set_tile "dcl_blk_name" "")
)
)
)
(setq NAME1 (strcat (getvar "dwgprefix") (getvar "dwgname")))
(setq DWGNAME "")
(setq APP (vlax-get-acad-object))
(setq DOC (vla-get-activedocument APP))
(if (= "15" (substr (getvar "acadver") 1 2))
(progn
(if (not (REGISTEROBJECTDBX))
(exit)
)
(setq
DBXDOC (vla-getinterfaceobject APP "ObjectDBX.AxDbDocument")
)
)
(setq
DBXDOC (vla-getinterfaceobject APP "ObjectDBX.AxDbDocument.16")
)
)
(setq DCL_FILE "ins_blk"
DCL_NAME "blk_1"
)
(setq DCL_FLAG (load_dialog DCL_FILE))
(if (< DCL_FLAG 0)
(exit)
)
(if (not (new_dialog DCL_NAME DCL_FLAG))
(exit)
)
(DWG_SEL 1)
(set_tile "dcl_blk_list" "0")
(FILL_BLK_NAME)
(action_tile "key_insert" "(dwg_sel 0)")
(action_tile "cancel" "(done_dialog 0)")
(action_tile
"accept"
"(done_dialog 1)"
)
(setq OK_ID (start_dialog))
(unload_dialog DCL_FLAG)
(if (and (= 1 OK_ID) (/= "" (getvar "insname")))
(INS (getvar "insname"))
)
(vlax-release-object APP)
(vlax-release-object DOC)
(vlax-release-object DBXDOC)
(vlax-release-object DBXBLOCKS)
(setq DBXDOC NIL
DBXBLOCKS NIL
DOC NIL
)
(princ)
)
(prompt "\nType INS_BLK")
(princ)
;;
;;储存档名:INS_BLK.DCL
;;
blk_1: dialog {
label = "插入图块";
spacer;
: row {
: list_box {
label = "列示图块名称 : ";
key = "dcl_blk_list";
fixed_width = true;
width = 25;
height = 8;
allow_accept = true;
action = "(fill_blk_name)";
}
: text_part {
label = " ";
key = "dcl_blk_no";
fixed_width = true;
width = 12;
height = 3;
}
}
spacer;
: text_part {
key = "txt_2";
height = 2;
}
: button {
label = "浏览";
key = "key_insert";
}
: boxed_column {
: row{
: text_part {
label = "插入图块的名称: ";
key = "txt_1";
fixed_width = true;
width = 16;
}
: text_part {
key = "dcl_blk_name";
fixed_width = true;
width = 20;
}
}
spacer;
}
spacer;
ok_cancel;
} 好东西！
為甚麼不能插入整個圖檔
整个图檔不就等于INSERT了吗? 和DSX的 DWGSCAN 程序有什么区别？ ;;;************************************************************************;;; Filename: DBX-DwgScan.LSP
;;; Author: David Stein
;;; Date: April 2002
;;; Purpose:ObjectDBX Drawing Scan Example for Visual LISP Developers Bible book
;;; Copyright (C)2002 David M. Stein, All Rights Reserved.
;;;************************************************************************
;;; Usage: (DWGSCAN tablename itemname drawings)
;;;
;;; Where:
;;; tablename = string name of table (ex. Blocks, Ltypes, DimStyles, etc.)
;;; itemname= string name of item to search for
;;; drawings= list of drawing filenames (full paths included for each)
;;;
;;; Returns: A list of filenames that contain the itemname being searched for.
;;;************************************************************************
;;; For use with AutoCAD 2000, 2000i and 2002 or related vertical products
;;; only.Will NOT work with R14, any LT or Inventor products.
;;; Must be compiled as a separate-namespace VLX application
;;;************************************************************************
dwgscan只是list table,但很多人不懂连续操作(图檔间的开闭及对象的读写) 怎么用啊？ 该函数有何实际用途？ 最好给个插图啊````
小虾好理解啊` 龙龙仔发表于2003-7-31 8:10:00static/image/common/back.gif;;;************************************************************************
;;; Filename: DBX-DwgScan.LSP
;;; Author: David Stein
;;; Date: April 2002
;;; Purpose:
请问这个文件在哪里能找到啊？谢谢