获取指定目录的DWG文件的所有块名（含匿名块）列表

sysu-沼泽

--------------------2019.6.15更新--------------------
根据satan421的提示，使用ObjectDBX获取，在实际运行时会出现“; 错误: Automation 错误。未提供说明。”的错误提示。以下是代码，不知是哪里出了问题？

1. (defun GetBlksNameList
   
2.        (DwgName / cadver id dbx I objCount BlkNameList)
   
3.   (vl-load-com)
   
4. 
   
5.   (setq cadver (substr (getvar "acadver") 1 2))
   
6.   ;; get cad version No.
   
7.   (setq id (strcat "objectdbx.AxDbDocument." cadver))
   
8.   ;; creat prog id
   
9.   (setq dbx (vlax-create-object id))
   
10.   ;; creat dbx object
    
11.   (vla-open dbx DwgName)
    
12. 
    
13.   ;;;前三个舍弃
    
14.   (setq  I   3
    
15.   objCount (vla-get-Count (vla-get-Blocks dbx))
    
16.   )
    
17.   (setq BlkNameList nil)
    
18.   (while (>= (- objCount 1) 4)
    
19.     (setq BlockObj (vla-Item (vla-get-blocks dbx) I)
    
20.     I     (1+ I)
    
21.     )
    
22.     (setq BlkNameList (cons (vla-get-name BlockObj) BlkNameList))
    
23.   )
    
24.   (vlax-release-object dbx)
    
25.   BlkNameList
    
26. 
    
27. )

(defun GetBlksNameList<br />        (DwgName / cadver id dbx I objCount BlkNameList)<br />   (vl-load-com)<br /> <br />   (setq cadver (substr (getvar "acadver") 1 2))<br />   ;; get cad version No.<br />   (setq id (strcat "objectdbx.AxDbDocument." cadver))<br />   ;; creat prog id<br />   (setq dbx (vlax-create-object id))<br />   ;; creat dbx object<br />   (vla-open dbx DwgName)<br /> <br />   ;;;前三个舍弃<br />   (setq  I   3<br />   objCount (vla-get-Count (vla-get-Blocks dbx))<br />   )<br />   (setq BlkNameList nil)<br />   (while (>= (- objCount 1) 4)<br />     (setq BlockObj (vla-Item (vla-get-blocks dbx) I)<br />     I     (1+ I)<br />     )<br />     (setq BlkNameList (cons (vla-get-name BlockObj) BlkNameList))<br />   )<br />   (vlax-release-object dbx)<br />   BlkNameList<br /> <br /> )

--------------------2019.6.14原帖--------------------

RT，在当前CAD文件中，需要获取另外一个文件夹目录中某个DWG文件的所有块名列表。在网上搜索到有一部分代码是：

1. (DEFUN GetBlockNames (/ BlockInfo BlkLst Blk)
   
2.     (SETQ BlockInfo (TBLNEXT "BLOCK" T))
   
3.     ;; get the first block in the block table record
   
4.     ;; loop through all block records, get block name
   
5.     ;; ignore anonymous blocks, dim's, xref's, etc...
   
6.     ;; add the block name to the list 'BlkLst
   
7.     ;; goto next block
   
8.     (WHILE BlockInfo
   
9.         (SETQ blk (CDR (ASSOC 2 BlockInfo)))
   
10.         (IF (NOT (WCMATCH blk "`*U*,`*D*,`*X*,`*T*,_*,*|*,A$*"))
    
11.             (SETQ BlkLst (APPEND BlkLst (LIST blk)))
    
12.         )
    
13.         (SETQ BlockInfo (TBLNEXT "BLOCK"))
    
14.     )
    
15.     BlkLst
    
16. )

(DEFUN GetBlockNames (/ BlockInfo BlkLst Blk)<br />     (SETQ BlockInfo (TBLNEXT "BLOCK" T))<br />     ;; get the first block in the block table record<br />     ;; loop through all block records, get block name<br />     ;; ignore anonymous blocks, dim's, xref's, etc...<br />     ;; add the block name to the list 'BlkLst<br />     ;; goto next block<br />     (WHILE BlockInfo<br />         (SETQ blk (CDR (ASSOC 2 BlockInfo)))<br />         (IF (NOT (WCMATCH blk "`*U*,`*D*,`*X*,`*T*,_*,*|*,A$*"))<br />             (SETQ BlkLst (APPEND BlkLst (LIST blk)))<br />         )<br />         (SETQ BlockInfo (TBLNEXT "BLOCK"))<br />     )<br />     BlkLst<br /> )

刚测试该代码可以获取当前文件的所有块名。但不知需要获取其他文件的块名如何操作？在此请教下大家~

satan421

ObjectDBX.

sysu-沼泽

satan421 发表于 2019-6-15 08:45
ObjectDBX.

多谢，但我在用的时候有错误提示，可否方便看下？已在原帖中更新~

nzl1116

既然有错误提示，应该能找到哪一个表达式出错

nzl1116

我猜是在vla-open后就出错。

satan421

sysu-沼泽 发表于 2019-6-15 12:15
多谢，但我在用的时候有错误提示，可否方便看下？已在原帖中更新~

(setq        dbx (vla-getinterfaceobject
              (vlax-get-acad-object)
              id
            )
  )

林霄云

可能是 vla-open 要打开的文件，已经打开。