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

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

利用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:00

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

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

;;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:00

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

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

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

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

<DIV><FONT face=宋体 size=2>objectdbx直接 打开dwg文件</FONT></DIV><BR>
<DIV><FONT face=宋体 size=2></FONT>        </DIV><BR>
<DIV><FONT face=宋体 size=2>我正准备在vb中用objectdbx在不打开autocad情况下读取dwg里图框里的文字信息，能举一例子详细说明用哪些方法和属性可以成功吗，</FONT></DIV>

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

建议斑竹将此帖子置顶

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

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

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

tonyhuangg 发表于 2004-9-13 16:37 static/image/common/back.gif
objectdbx直接 打开dwg文件
       
我正准备在vb中用objectdbx在不打开autocad情况下读取dwg里图框里的文字信息 ...

我也想做这个。缺少DBX的基本资料，无从下手
页: [1]
查看完整版本: [VBA]利用ObjectDBX技术导入其它图形中的图层设置和文字样式设置