vb连接cad插入dwg图块的问题

254619324

我的程序如下：
Public AcadApp As AcadApplication
Public AcadDoc As AcadDocument
'连接AutoCAD
Sub LinkAutoCad() '将autocad对象引用赋予acadapp,创建autocad对象

On Error Resume Next
Set AcadApp = GetObject(, "AutoCAD.Application")

If Err.Number Then
   Err.Clear
   Set AcadApp = CreateObject("AutoCAD.Application")
   If Err.Number Then
      MsgBox ("无法启动autocad,请确定是否安装autocad")
      Exit Sub
   End If
End If

AcadApp.Visible = True '界面可视
AcadApp.WindowState = AutoCAD.AcWindowState.acMax '界面最大化
AppActivate (AcadApp.Caption) '显示autocad界面

'遍历模型空间的所有成员，删除一切实体
'Dim entry As AutoCAD.AcadEntity
'For Each entry In acadApp.ActiveDocument.ModelSpace
'entry.Delete
'Next

End Sub

Private Sub Command1_Click()

On Error Resume Next

Call LinkAutoCad
Set AcadDoc = AcadApp.ActiveDocument

Dim Pnt As Variant
Dim File As String
Dim BlkRef As AcadBlockReference

'在指定的位置插入指定的图形
Pnt = AcadDoc.Utility.GetPoint(, "选择插入点：")
File = App.Path + "\Block\补强圈.dwg"

Set BlkRef = AcadDoc.ModelSpace.InsertBlock(Pnt, File, 1#, 1#, 1#, 0)

'更改图形的属性值
Dim VarAttr As Variant
For Each VarAttr In BlkRef.GetAttributes()
    Select Case UCase(VarAttr.TagString)
        Case "JH"
            VarAttr.TextString = Text1.Text
        Case "SL"
            VarAttr.TextString = Text2.Text
        Case "CZ"
            VarAttr.TextString = Text3.Text
        Case "NJ"
            VarAttr.TextString = Val(Text4.Text) + 10
   End Select

'插入之后更改属性的文字样式为当前图形的样式
AcadDoc.ActiveTextStyle.fontFile = "c:\windows\fonts\SIMFANG.ttf"  '仿宋体
VarAttr.Update
Next

Dim EntObjs As Variant
EntObjs = BlkRef.Explode '炸开块对象
BlkRef.Delete '删除原来的图块，只保留炸开的图元

Set BlkRef = Nothing
Set AcadDoc = Nothing
Set AcadApp = Nothing

End Sub

1、插入制定的dwg文件的功能是实现了，可是插入后cad就反应很慢了，不知道是什么原因？2、我想插入dwg文件后，把图块炸开，删除原来的图块，只保留炸开的图元，这个功能在vba中可以用，放在vb中就不行了，请高手指点一下啊

254619324

请高手来指导指导啊，求助。。。。。。。

sxz4494

现在有解决的方法吗