[VBA]利用ObjectDBX技术导入其它图形中的图层设置和文字样式设置

mccad · 发表于 2003-11-11 10:15

利用ObjectDBX技术，我们可以做很多以前从没有听说的事情，这也许在国内还没有人去试过吧。
在VBA和LISP专栏中，大家可以看到我们利用该技术来插入其它图形中的图块，这应该算是复杂的编程方法，一些简单一点的就是通过该技术修改未打开图形的一些对象属性等，或查找一些有用的信息等。
你可以通过该技术打得到未打开图形的图形特性(也就是图形特性框中显示的内容)。
在这里我们再介绍一些很好用的技术，标题已经写了。
我们在做软件时可以附一个模板给用户，按以前的做法，一定要要求用户使用你指定的模块做为图形样板，这样才能做到你软件的准确性。
后来有些程序就是什么图层、标注样式、文字样式等都是通过程序来生成。
现在没有这个必要了，我们可以通过一个模板，把你的设置的东西全部放到模板文件中，然后通过ObjectDBX技术直接从模板里面取出放引入到当前图形中。
其实代码很简单：

'插入外部图形配置好的图层
Sub InsLayer()
Dim objDbx As AxDbDocument
Dim objLayer(0) As Object
Set objDbx = GetInterfaceObject("ObjectDBX.AxDbDocument.16")
objDbx.Open "c:\1.dwg"
Set objLayer(0) = objDbx.Layers("3")
objDbx.CopyObjects objLayer, ThisDrawing.ModelSpace
Set objDbx = Nothing
End Sub
'插入外部图形配置好的文字样式
Sub InsStyle()
Dim objDbx As AxDbDocument
Dim objStyle(0) As Object
Set objDbx = GetInterfaceObject("ObjectDBX.AxDbDocument.16")
objDbx.Open "c:\1.dwg"
Set objStyle(0) = objDbx.TextStyles("hztxt")
objDbx.CopyObjects objStyle, ThisDrawing.ModelSpace
Set objDbx = Nothing
End Sub

使用以上代码时注意如果当前图形中存在相同名称的样式时，则不能导入，但也不会出错，所以在导入前先判断同名的样式是否存在，存在时则不要导入。

例子中只举了引入图层和引入文字样式的例子，其它如标注样式、线型均可以通过这个方法来做，特别是线型，如果你线型中存在有特殊定义的东西，用导入的方法比直接编程要方便得多。

mccad · 发表于 2003-11-11 12:26

另外，在导入图层时，如果图层中有配套的线型也会同时被导入。而不必先编程导入线型。

龙龙仔 · 发表于 2003-11-17 08:19

;;for vlisp
;;注意:R2004以下要先注册OBJECTDBX
;;注册方法在论坛找找
;;(INSLAYER "1234.DWG" "3")
(defun INSLAYER (DWGNAME LAYER / DBXDOC)
  (vl-load-com)
  (if (> (atoi (getvar "AcadVer")) 15)
(setq DBXDOC (vla-getinterfaceobject
   (vlax-get-acad-object)
   "ObjectDBX.AxDbDocument.16"
   )
)
(setq DBXDOC (vla-getinterfaceobject
   (vlax-get-acad-object)
   "ObjectDBX.AxDbDocument"
   )
)
  )
  (vla-open DBXDOC (findfile DWGNAME))
  (vla-copyobjects
DBXDOC
(vlax-safearray-fill
   (vlax-make-safearray
vlax-vbobject
'(0 . 0)
   )
   (list (vla-item (vla-get-layers DBXDOC) LAYER))
)
(vla-get-modelspace
   (vla-get-activedocument (vlax-get-acad-object))
)
  )
  (vlax-release-object DBXDOC)
  (princ)
)

;;(INSSTYLE "1234.DWG" "DAYUXP")
(defun INSSTYLE (DWGNAME STYLE / DBXDOC)
  (vl-load-com)
  (if (> (atoi (getvar "AcadVer")) 15)
(setq DBXDOC (vla-getinterfaceobject
   (vlax-get-acad-object)
   "ObjectDBX.AxDbDocument.16"
   )
)
(setq DBXDOC (vla-getinterfaceobject
   (vlax-get-acad-object)
   "ObjectDBX.AxDbDocument"
   )
)
  )
  (vla-open DBXDOC (findfile DWGNAME))
  (vla-copyobjects
DBXDOC
(vlax-safearray-fill
   (vlax-make-safearray
vlax-vbobject
'(0 . 0)
   )
   (list (vla-item (vla-get-textstyles DBXDOC) STYLE))
)
(vla-get-modelspace
   (vla-get-activedocument (vlax-get-acad-object))
)
  )
  (vlax-release-object DBXDOC)
  (princ)
)

QQ糖 · 发表于 2003-11-19 22:03

ObjectDBX 是一个新颖的技术，值得研究一下

tonyhuangg · 发表于 2004-9-13 10:42

一些简单一点的就是通过该技术修改未打开图形的一些对象属性等，或查找一些有用的信息等。能举例吗？

tonyhuangg · 发表于 2004-9-13 16:37

objectdbx直接打开dwg文件

我正准备在vb中用objectdbx在不打开autocad情况下读取dwg里图框里的文字信息，能举一例子详细说明用哪些方法和属性可以成功吗，

nxy_918 · 发表于 2005-2-2 21:16

建议斑竹将此帖子置顶

cczjw · 发表于 2009-2-6 21:39

当运行到第3语句：
3 Dim objDbx As AxDbDocument 时报“用户定义类型未定义”错，请问是何原因？如何解决？谢谢！

cheng5276 · 发表于 2011-6-19 16:12

tonyhuangg 发表于 2004-9-13 16:37
objectdbx直接打开dwg文件

我正准备在vb中用objectdbx在不打开autocad情况下读取dwg里图框里的文字信息 ...

我也想做这个。缺少DBX的基本资料，无从下手

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