总是出现方法作用于对象失败，有谁指点一二吧！

eeprotect

Dim acadApp As AcadApplication
Dim ssetObj As AcadSelectionSet
Set acadApp = GetObject(, "AutoCAD.Application")
Set ssetObj = acadApp.ActiveDocument.SelectionSets.Add("test")

mccad

1.ActiveDocument是否存在，也就是说是否有打开了的图形中界面中。


2.选择集的名称只能是唯一的，如果你运行了第一次，第二次再运行此程序时，本身图形中已经存在了该名称的选择集，就会出错。所以必须对该名称进行判断。

myfreemind

加上这个代码： Dim i As Integer
For i = 0 To ThisDrawing.SelectionSets.Count - 1
ThisDrawing.SelectionSets.Item(i).Clear
ThisDrawing.SelectionSets.Item(i).Delete
Next

mccad

最简单的新建空白选择集的函数：

2. Function CreatSSet() As AcadSelectionSet
3.        On Error Resume Next
4.        ThisDrawing.SelectionSets("mccad").Delete
5.        Set CreatSSet = ThisDrawing.SelectionSets.Add("mccad")
6. End Function

Function CreatSSet() As AcadSelectionSet        On Error Resume Next        ThisDrawing.SelectionSets("mccad").Delete        Set CreatSSet = ThisDrawing.SelectionSets.Add("mccad") End Function

eeprotect

也不知道是为什么，现在倒是又不出现方法作用于对象失败的错误了，而是程序没有反应，我的目的是想把图形中选择的实体对象高亮显示，并把坐标信息倒出来，可第一步就实现不了。 Private Sub SelectLayer()
Dim acadApp As AcadApplication
Dim ssetObj As AcadSelectionSet
' On Error Resume Next
Set acadApp = GetObject(, "autoCAD.Application")
' ThisDrawing.SelectionSets("hights").Delete
Set ssetObj = acadApp.ActiveDocument.SelectionSets.Add("hights")
AppActivate acadApp.Caption
Dim FType(0) As Integer
Dim FData(0) As Variant
FType(0) = 0
FData(0) = "line"

Dim filterType As Variant
Dim filterData As Variant
filterType = FType
filterData = FData
ssetObj.Select acSelectionSetAll, , , filterType, filterData
AppActivate UserForm1.Caption

Dim pickedObjs As AcadEntity
For Each pickedObjs In ssetObj
pickedObjs.Highlight (True)
pickedObjs.Update
Next
ssetObj.Delete
End Sub 事先说明一点，已经打开了CAD图形，不过图形的保存位置同dvb工程的位置是不一样的，一直如此都未碰到问题。

my_computer

我改了一下，好像可以了。关键不要使用update Private Sub main()
Dim acadApp As AcadApplication
Dim ssetObj As AcadSelectionSet
On Error Resume Next
Set acadApp = GetObject(, "autoCAD.Application")
acadApp.ActiveDocument.SelectionSets("hights").Delete
Set ssetObj = acadApp.ActiveDocument.SelectionSets.Add("hights")
AppActivate acadApp.Caption
Dim FType(0) As Integer
Dim FData(0) As Variant
FType(0) = 0
FData(0) = "line"
Dim filterType As Variant
Dim filterData As Variant
filterType = FType
filterData = FData
ssetObj.Select acSelectionSetAll, , , filterType, filterData
'AppActivate userform1.Caption

Dim pickedObjs As AcadEntity
For Each pickedObjs In ssetObj
pickedObjs.Highlight (True)
Next
ssetObj.Delete
End Sub