[求助]AutoCAD & Excel Excel运行AutoCAD 的代码
我要做一个Excel和Autocad连接的问题,用excel打开cad并替换一些cad中的文字和标注文字。Excel和CAD各自的代码已经写好,但是不知道如何用excel运行cad的代码,看了一些帖子没弄清楚。于是我把cad的代码弄到了excel里面,做了一些修改(在thisdrawing前面加了autocad.application.),但却无法运行。红色的代码提示“对象不支持该属性或方法”,刚接触vba不久,清楚的朋友可否指点一下?
代码如下:
Public Sub DrawingTextReplace()
'尺寸修改
Dim strResult As String
Dim Obj As AcadEntity
Dim oDim As AcadDimension
For Each Obj In AutoCAD.Application.ThisDrawing.ModelSpace
If (Obj.ObjectName = "AcDbAlignedDimension" Or Obj.ObjectName = "AcDbRotatedDimension") Then
Set oDim = Obj
If InStr(oDim.TextOverride, "L=") > 0 Then oDim.TextOverride = "L=1000"
End If
Next Obj
'文字修改
Dim TextSelect As AcadSelectionSet
Dim FilterType(0 To 3) As Integer
Dim FilterData(0 To 3)
Dim adText As Object
On Error Resume Next
FilterType(0) = -4
FilterData(0) = "<or"
FilterType(1) = 0
FilterData(1) = "text"
FilterType(2) = 0
FilterData(2) = "mtext"
FilterType(3) = -4
FilterData(3) = "or>"
If Not IsNull(AutoCAD.Application.ThisDrawing.SelectionSets.Item("TextSelect")) Then
Set TextSelect = AutoCAD.Application.ThisDrawing.SelectionSets.Item("TextSelect")
TextSelect.Delete
End If
Set TextSelect = AutoCAD.Application.ThisDrawing.SelectionSets.Add("TextSelect")
TextSelect.Select acSelectionSetAll, , , FilterType, FilterData
For Each adText In TextSelect
If InStr(adText.TextString, "大庆") Then adText.TextString = "克拉玛依"
Next
End Sub
不知道你有没有在VBA IDE里面将有关的类库导入,CAD和EXCEL的VBA类库是不同的,互相使用时一定要先导入。 程序开始处应先建立一个CAD应用程序级的实例,再通过这个实例引用其子类方法或属性等操作。 多谢你的关注~
和CAD相关的库我已经导入了,你说的“程序开始处应先建立一个CAD应用程序级的实例”指的是要用类似于
Dim App As Object
Set App = GetObject(, "AutoCad.Application")
的语句么? 回复 cuiweimei 的帖子
有点模糊的理解~那和下面的,比如说
For Each Obj In AutoCAD.Application.ThisDrawing.ModelSpace
怎么“连接”呢
晕了,Thisdrawing在VBA里是可以作为独立对象直接使用的,但是作为子对象应该这么写
autocad.application.activedocument.modelspace 本帖最后由 紫罗兰 于 2010-12-17 15:41 编辑
回复 xinghesnak 的帖子
多谢指点!程序按照你说得改了一下,但还是达不到预期的目的,真是不知道怎么回事,能再帮着看一下么?~ 下面是改之后的部分代码:
Public Sub DrawingTextReplace()
'尺寸修改
Dim Obj As AcadEntity
Dim oDim As AcadDimension
For Each Obj In AutoCAD.Application.ActiveDocument.ModelSpace
If (Obj.ObjectName = "AcDbRotatedDimension"Then
Set oDim = Obj
If InStr(oDim.TextOverride, "L=") > 0 Then oDim.TextOverride = "L=1000"
End If
End Sub
把所有的thisdrawing换成activedocument
并且请注意Mtext的.textstring返回值并不一定是你想要的
他还含有字体数据需要进一步过滤具体参见CAD帮助
这两天回头看看大家的回帖才明白一些,应该是这样的:
Public Sub DrawingTextReplace()
Dim App As AcadApplication
On Error Resume Next
Set App = CreateObject("AutoCad.Application")
。。。。
。。。。
Dim Obj As AcadEntity
Dim oDim As AcadDimension
For Each Obj In App.ActiveDocument.ModelSpace
If (Obj.ObjectName = "AcDbRotatedDimension"Then
Set oDim = Obj
If InStr(oDim.TextOverride, "L=") > 0 Then oDim.TextOverride = "L=1000"
End If
End Sub
真是才疏学浅。。多谢cuiweimei,chmenf087 和xinghesnak 的帮助!
页:
[1]