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

龙龙仔 · 发表于 2003-7-25 09:58:00

;;利用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)

;;利用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;
}

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

meflying · 发表于 2003-7-25 12:07:00

好东西！

spring · 发表于 2003-7-25 12:35:00

龙龙仔 · 发表于 2003-7-25 17:09:00

整个图檔不就等于INSERT了吗?

Ea · 发表于 2003-7-30 21:16:00

和DSX的 DWGSCAN 程序有什么区别？

龙龙仔 · 发表于 2003-7-31 08:10:00

;;;************************************************************************
;;; 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,但很多人不懂连续操作(图檔间的开闭及对象的读写)

wolaikk · 发表于 2003-7-31 19:29:00

怎么用啊？

fawn_lgc · 发表于 2003-9-29 10:21:00

该函数有何实际用途？

zjfkmr008 · 发表于 2003-10-4 22:48:00

最好给个插图啊````

小虾好理解啊`

QQ糖 · 发表于 2003-10-23 20:02:00

龙龙仔发表于2003-7-31 8:10:00;;;************************************************************************
;;; Filename: DBX-DwgScan.LSP
;;; Author: David Stein
;;; Date: April 2002
;;; Purpose:

请问这个文件在哪里能找到啊？谢谢

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

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

评分

為甚麼不能插入整個圖檔