[转贴]：利用ObjectDbx技术在当前图形中插入其它未打开的图形中的图块

halibt · 发表于 2003-7-29 19:55:59

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

;;利用ObjectDbx技术在当前图形中插入其它未打开的图形中的图块
;;
;; INS_BLK.LSP
;;
;; 作者: 赖云龙(龙龙仔)
;;
;; E_MAIL: [email]lai_wan_lung@pchome.com.tw[/email]
;;
;; 版权所有 (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)

;;利用ObjectDbx技术在当前图形中插入其它未打开的图形中的图块 
;; 
;; INS_BLK.LSP 
;; 
;; 作者: 赖云龙(龙龙仔) 
;; 
;; E_MAIL: [email]lai_wan_lung@pchome.com.tw[/email] 
;; 
;; 版权所有 (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;
}

;; 
;;储存档名: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;    
 }

halibt · 发表于 2003-8-1 17:01:49

既可以合并创建图块库，也能从库中调用插到图形中。做个简单演示。

halibt · 发表于 2003-8-1 17:04:20

这是做好的一个图库。

kxglsjs · 发表于 2004-3-16 17:24:05

我加载以后出现错误:
命令: ins_blk
; 错误: quit / exit abort

JOSDENNIS · 发表于 2004-3-22 08:56:37

這個程序我去年用看過. 呵呵. 我想請問問halibt大哥可不可以把你好個魚的dwg文傳到網上給我下載一會呀. 我很喜歡里面的那些魚. 謝了

halibt · 发表于 2004-3-29 12:18:18

最初由 JOSDENNIS 发布
[B]這個程序我去年用看過. 呵呵. 我想請問問halibt大哥可不可以把你好個魚的dwg文傳到網上給我下載一會呀. 我很喜歡里面的那些魚. 謝了 [/B]

那些鱼都在这里的。可惜图纸中心暂时关闭了
http://www.xdcad.net/forum/showthread.php?s=&threadid=57562

账号		自动登录	找回密码
密码			立即注册

[公告] [转贴]：利用ObjectDbx技术在当前图形中插入其它未打开的图形中的图块

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

相关帖子