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

eeprotect 发表于 2004-2-24 10:45:00

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

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

mccad 发表于 2004-2-24 12:01:00

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

myfreemind 发表于 2004-2-24 12:10:00

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

mccad 发表于 2004-2-24 12:48:00

最简单的新建空白选择集的函数：
Function CreatSSet() As AcadSelectionSet
       On Error Resume Next
       ThisDrawing.SelectionSets("mccad").Delete
       Set CreatSSet = ThisDrawing.SelectionSets.Add("mccad")
End Function

eeprotect 发表于 2004-2-24 15:19:00

也不知道是为什么，现在倒是又不出现方法作用于对象失败的错误了，而是程序没有反应，我的目的是想把图形中选择的实体对象高亮显示，并把坐标信息倒出来，可第一步就实现不了。
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 发表于 2004-2-26 15:05:00

我改了一下，好像可以了。关键不要使用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

查看完整版本: 总是出现方法作用于对象失败，有谁指点一二吧！