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

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")

bdinoeosp21.jpg

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

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

copy


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

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

发表回复

精选推荐

浏览过的版块