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

wowoaicad

2. 利用ObjectDbx技术在当前图形中插入其它未打开的图形中的图块(mccad)
   
3. 
   
4. 以前，我们为了做图库，每一个图块均必须保存为一个图形文件，以便在编程时直接插入选定的图形，这样做出来的程序，图形文件的数量就会很多，因为有时你的图库内容很多。
   
5. 现在利用ObjectDbx技术可以将这些图块放在一个图形中，做到真正的图库，以下为程序内容：
   
6. 
   
7. 引用：ObjectDbx 1.0类型库(文件为：c:\program files\autocad 2002\AXDB15.TLB)
   
8. 插入模块1，输入以下代码：
   
9. 以下内容为程序代码:
   
10. 
    
11. Public Declare Function GetSaveFileName Lib "comdlg32.dll" Alias "GetSaveFileNameA" _
    
12.     (LPOPENFILENAME As OPENFILENAME) As Long
    
13. Public Declare Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" _
    
14.     (pOpenfilename As OPENFILENAME) As Long
    
15. Public Const OFN_PATHMUSTEXIST = &H800
    
16. Public Const OFN_FILEMUSTEXIST = &H1000
    
17. Public Const OFN_HIDEREADONLY = &H4 '隐蔽只读复选框
    
18. 
    
19. Public Type OPENFILENAME
    
20.     lStructSize As Long
    
21.     hwndOwner As Long '拥有对话框的窗口
    
22.     hInstance As Long
    
23.     lpstrFilter As String '装载文件过滤器的缓冲区
    
24.     lpstrCustomFilter As String
    
25.     nMaxCustFilter As Long
    
26.     nFilterIndex As Long
    
27.     lpstrFile As String
    
28.     nMaxFile As Long
    
29.     lpstrFileTitle As String
    
30.     nMaxFileTitle As Long
    
31.     lpstrInitialDir As String
    
32.     lpstrTitle As String '对话框的标题
    
33.     flags As Long
    
34.     nFileOffset As Integer
    
35.     nFileExtension As Integer
    
36.     lpstrDefExt As String
    
37.     lCustData As Long
    
38.     lpfnHook As Long
    
39.     lpTemplateName As String
    
40. End Type
    
41. 
    
42. Function GetFile(strTitle As String, strFilter As String, Optional strIniDir As String) As String
    
43. 
    
44. On Error Resume Next
    
45. Dim FileName As String
    
46. Dim OFileBox As OPENFILENAME
    
47. With OFileBox
    
48.     .lpstrTitle = strTitle '对话框标题
    
49.     .lpstrInitialDir = strIniDir '初始目录
    
50.     .lStructSize = Len(OFileBox)
    
51.     .hwndOwner = ThisDrawing.HWND
    
52.     .flags = OFN_PATHMUSTEXIST Or OFN_FILEMUSTEXIST Or OFN_HIDEREADONLY
    
53.     .lpstrFile = String$(255, 0)
    
54.     .nMaxFile = 255
    
55.     .lpstrFileTitle = String$(255, 0)
    
56.     .nMaxFileTitle = 255
    
57.     .lpstrFilter = strFilter  '过滤器
    
58.     .nFilterIndex = 1
    
59. End With
    
60. 
    
61. lntFile = GetOpenFileName(OFileBox) '执行打开对话框
    
62. If lntFile <> 0 Then
    
63.     FileName = Left(OFileBox.lpstrFile, InStr(OFileBox.lpstrFile, vbNullChar) - 1)
    
64.     GetFile = FileName
    
65. Else
    
66.     GetFile = ""
    
67. End If
    
68. 
    
69. End Function
    
70. 
    
71. 
    
72. 
    
73. 
    
74. 插入窗体userform1,自上而下插入以下控件：
    
75.   标签(Label1)
    
76.      文本框(TextBox1)
    
77.               命令按钮(CommandButton1)
    
78.   标签(Label2)
    
79.      组合框(ComboBox1)
    
80. 命令按钮(CommandButton2)  命令按钮(CommandButton3)
    
81. 
    
82. 然后在窗体的代码窗中输入以下代码：
    
83. 以下内容为程序代码:
    
84. 
    
85. Option Explicit
    
86.     Dim objDbx As AxDbDocument
    
87.     Dim elem As Object
    
88.     Dim blkName As String
    
89.     Dim dwgName As String
    
90.     Dim blkObj(0) As Object
    
91.     Dim pnt As Variant
    
92. 
    
93. Private Sub CommandButton1_Click()
    
94.     Me.TextBox1 = GetFile("打开图形", "图形文件(*.dwg)" & vbNullChar & "*.dwg")
    
95. End Sub
    
96. 
    
97. Private Sub CommandButton2_Click()
    
98.     blkName = Me.ComboBox1.SelText
    
99.     dwgName = Me.TextBox1.Value
    
100.     Me.Hide
     
101.      
     
102.     pnt = ThisDrawing.Utility.GetPoint(, "选择插入点：")
     
103.     Set blkObj(0) = objDbx.Blocks(blkName)
     
104.     objDbx.CopyObjects blkObj, ThisDrawing.ModelSpace
     
105.     ThisDrawing.ModelSpace.InsertBlock pnt, blkName, 1, 1, 1, 0
     
106.     Unload UserForm1
     
107.     Set elem = Nothing
     
108.     Set objDbx = Nothing
     
109.      
     
110. End Sub
     
111. 
     
112. Private Sub CommandButton3_Click()
     
113.     Unload UserForm1
     
114.     Set elem = Nothing
     
115.     Set objDbx = Nothing
     
116. 
     
117. End Sub
     
118. 
     
119. Private Sub TextBox1_Change()
     
120.     If Dir(Me.TextBox1.Value) <> "" Then
     
121.         objDbx.Open Me.TextBox1.Value
     
122.         For Each elem In objDbx.Blocks
     
123.             If Left(elem.Name, 1) <> "*" Then
     
124.                 Me.ComboBox1.AddItem elem.Name
     
125.             End If
     
126.         Next
     
127.     End If
     
128.          
     
129. End Sub
     
130. 
     
131. Private Sub UserForm_Initialize()
     
132.     Set objDbx = GetInterfaceObject("ObjectDBX.AxDbDocument")
     
133.     Me.CommandButton1.Caption = "浏览"
     
134.     Me.CommandButton2.Caption = "插入"
     
135.     Me.CommandButton3.Caption = "取消"
     
136.     Me.Label1.Caption = "选择图形："
     
137.     Me.Label2.Caption = "选择图块："
     
138.     Me.Caption = "插入外部图形中的图块示例"
     
139. End Sub
     
140. 
     
141. 
     
142. 然后在ThisDrawing代码窗中输入以下代码：
     
143. 以下内容为程序代码:
     
144. 
     
145. Sub InsBlk()
     
146.     Load UserForm1
     
147.     UserForm1.Show
     
148. End Sub
     
149. 
     
150. 
     
151. 
     
152. 这样就可以试试你的程序了。
     
153. 如果觉得麻烦，这个我已经打包成一个文件，大家拿去试试吧：
     
154. 
     

利用ObjectDbx技术在当前图形中插入其它未打开的图形中的图块(mccad)<br /> <br /> 以前，我们为了做图库，每一个图块均必须保存为一个图形文件，以便在编程时直接插入选定的图形，这样做出来的程序，图形文件的数量就会很多，因为有时你的图库内容很多。 <br /> 现在利用ObjectDbx技术可以将这些图块放在一个图形中，做到真正的图库，以下为程序内容： <br /> <br /> 引用：ObjectDbx 1.0类型库(文件为：c:\program files\autocad 2002\AXDB15.TLB) <br /> 插入模块1，输入以下代码： <br /> 以下内容为程序代码:<br /> <br /> Public Declare Function GetSaveFileName Lib "comdlg32.dll" Alias "GetSaveFileNameA" _ <br />     (LPOPENFILENAME As OPENFILENAME) As Long <br /> Public Declare Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" _ <br />     (pOpenfilename As OPENFILENAME) As Long <br /> Public Const OFN_PATHMUSTEXIST = &H800 <br /> Public Const OFN_FILEMUSTEXIST = &H1000 <br /> Public Const OFN_HIDEREADONLY = &H4 '隐蔽只读复选框 <br /> <br /> Public Type OPENFILENAME <br />     lStructSize As Long <br />     hwndOwner As Long '拥有对话框的窗口 <br />     hInstance As Long <br />     lpstrFilter As String '装载文件过滤器的缓冲区 <br />     lpstrCustomFilter As String <br />     nMaxCustFilter As Long <br />     nFilterIndex As Long <br />     lpstrFile As String <br />     nMaxFile As Long <br />     lpstrFileTitle As String <br />     nMaxFileTitle As Long <br />     lpstrInitialDir As String <br />     lpstrTitle As String '对话框的标题 <br />     flags As Long <br />     nFileOffset As Integer <br />     nFileExtension As Integer <br />     lpstrDefExt As String <br />     lCustData As Long <br />     lpfnHook As Long <br />     lpTemplateName As String <br /> End Type <br /> <br /> Function GetFile(strTitle As String, strFilter As String, Optional strIniDir As String) As String <br /> <br /> On Error Resume Next <br /> Dim FileName As String <br /> Dim OFileBox As OPENFILENAME <br /> With OFileBox <br />     .lpstrTitle = strTitle '对话框标题 <br />     .lpstrInitialDir = strIniDir '初始目录 <br />     .lStructSize = Len(OFileBox) <br />     .hwndOwner = ThisDrawing.HWND <br />     .flags = OFN_PATHMUSTEXIST Or OFN_FILEMUSTEXIST Or OFN_HIDEREADONLY <br />     .lpstrFile = String$(255, 0) <br />     .nMaxFile = 255 <br />     .lpstrFileTitle = String$(255, 0) <br />     .nMaxFileTitle = 255 <br />     .lpstrFilter = strFilter  '过滤器 <br />     .nFilterIndex = 1 <br /> End With <br /> <br /> lntFile = GetOpenFileName(OFileBox) '执行打开对话框 <br /> If lntFile <> 0 Then <br />     FileName = Left(OFileBox.lpstrFile, InStr(OFileBox.lpstrFile, vbNullChar) - 1) <br />     GetFile = FileName <br /> Else <br />     GetFile = "" <br /> End If <br /> <br /> End Function <br /> <br /> <br /> <br /> <br /> 插入窗体userform1,自上而下插入以下控件： <br />   标签(Label1) <br />      文本框(TextBox1) <br />               命令按钮(CommandButton1) <br />   标签(Label2) <br />      组合框(ComboBox1) <br /> 命令按钮(CommandButton2)  命令按钮(CommandButton3) <br /> <br /> 然后在窗体的代码窗中输入以下代码： <br /> 以下内容为程序代码:<br /> <br /> Option Explicit <br />     Dim objDbx As AxDbDocument <br />     Dim elem As Object <br />     Dim blkName As String <br />     Dim dwgName As String <br />     Dim blkObj(0) As Object <br />     Dim pnt As Variant <br /> <br /> Private Sub CommandButton1_Click() <br />     Me.TextBox1 = GetFile("打开图形", "图形文件(*.dwg)" & vbNullChar & "*.dwg") <br /> End Sub <br /> <br /> Private Sub CommandButton2_Click() <br />     blkName = Me.ComboBox1.SelText <br />     dwgName = Me.TextBox1.Value <br />     Me.Hide <br />      <br />     pnt = ThisDrawing.Utility.GetPoint(, "选择插入点：") <br />     Set blkObj(0) = objDbx.Blocks(blkName) <br />     objDbx.CopyObjects blkObj, ThisDrawing.ModelSpace <br />     ThisDrawing.ModelSpace.InsertBlock pnt, blkName, 1, 1, 1, 0 <br />     Unload UserForm1 <br />     Set elem = Nothing <br />     Set objDbx = Nothing <br />      <br /> End Sub <br /> <br /> Private Sub CommandButton3_Click() <br />     Unload UserForm1 <br />     Set elem = Nothing <br />     Set objDbx = Nothing <br /> <br /> End Sub <br /> <br /> Private Sub TextBox1_Change() <br />     If Dir(Me.TextBox1.Value) <> "" Then <br />         objDbx.Open Me.TextBox1.Value <br />         For Each elem In objDbx.Blocks <br />             If Left(elem.Name, 1) <> "*" Then <br />                 Me.ComboBox1.AddItem elem.Name <br />             End If <br />         Next <br />     End If <br />          <br /> End Sub <br /> <br /> Private Sub UserForm_Initialize() <br />     Set objDbx = GetInterfaceObject("ObjectDBX.AxDbDocument") <br />     Me.CommandButton1.Caption = "浏览" <br />     Me.CommandButton2.Caption = "插入" <br />     Me.CommandButton3.Caption = "取消" <br />     Me.Label1.Caption = "选择图形：" <br />     Me.Label2.Caption = "选择图块：" <br />     Me.Caption = "插入外部图形中的图块示例" <br /> End Sub <br /> <br /> <br /> 然后在ThisDrawing代码窗中输入以下代码： <br /> 以下内容为程序代码:<br /> <br /> Sub InsBlk() <br />     Load UserForm1 <br />     UserForm1.Show <br /> End Sub <br /> <br /> <br /> <br /> 这样就可以试试你的程序了。 <br /> 如果觉得麻烦，这个我已经打包成一个文件，大家拿去试试吧： <br /> <br />

binbin

我有个相同功能的ARX程序,没有界面的,是函数,下面是他的头文件
BOOL        InsertBlock(const char* pBlockName,
                                                                AcGePoint3d Base_point = AcGePoint3d(0.0,0.0,0.0),
                                                                double ScaleFactorX = 1.0,
                                                                double ScaleFactorY = 1.0,
                                                                double angle = 0.0,
                                                                BOOL bExplore = TRUE,
                                                                const char* pFileName = _T(""));

comejava

binbin,可以把你的arx程序发上来让我们学习一下吗?

oyxx_1023

楼主是不是发错地方了