- 积分
- 753
- 明经币
- 个
- 注册时间
- 2011-10-12
- 在线时间
- 小时
- 威望
-
- 金钱
- 个
- 贡献
-
- 激情
-
|
我的程序如下:
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中就不行了,请高手指点一下啊
|
|