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

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

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

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

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


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

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

加上这个代码：


Dim i As Integer<BR>For i = 0 To ThisDrawing.SelectionSets.Count - 1<BR>ThisDrawing.SelectionSets.Item(i).Clear<BR>ThisDrawing.SelectionSets.Item(i).Delete<BR>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()<BR>       Dim acadApp As AcadApplication<BR>       Dim ssetObj As AcadSelectionSet<BR>'       On Error Resume Next<BR>       Set acadApp = GetObject(, "autoCAD.Application")<BR>'       ThisDrawing.SelectionSets("hights").Delete<BR>       Set ssetObj = acadApp.ActiveDocument.SelectionSets.Add("hights")<BR>       AppActivate acadApp.Caption<BR>       Dim FType(0) As Integer<BR>       Dim FData(0) As Variant<BR>       FType(0) = 0<BR>       FData(0) = "line"<BR>       <BR>       Dim filterType As Variant<BR>       Dim filterData As Variant<BR>       filterType = FType<BR>       filterData = FData<BR>       ssetObj.Select acSelectionSetAll, , , filterType, filterData<BR>       AppActivate UserForm1.Caption<BR>       <BR>       Dim pickedObjs As AcadEntity<BR>       For Each pickedObjs In ssetObj<BR>                       pickedObjs.Highlight (True)<BR>                       pickedObjs.Update<BR>       Next<BR>       ssetObj.Delete<BR>End Sub


事先说明一点，已经打开了CAD图形，不过图形的保存位置同dvb工程的位置是不一样的，一直如此都未碰到问题。

my_computer 发表于 2004-2-26 15:05:00

我改了一下，好像可以了。关键不要使用update


Private Sub main()<BR>       Dim acadApp As AcadApplication<BR>       Dim ssetObj As AcadSelectionSet<BR>       On Error Resume Next<BR>       Set acadApp = GetObject(, "autoCAD.Application")<BR>       acadApp.ActiveDocument.SelectionSets("hights").Delete<BR>       Set ssetObj = acadApp.ActiveDocument.SelectionSets.Add("hights")<BR>       AppActivate acadApp.Caption<BR>       Dim FType(0) As Integer<BR>       Dim FData(0) As Variant<BR>       FType(0) = 0<BR>       FData(0) = "line"


       <BR>       Dim filterType As Variant<BR>       Dim filterData As Variant<BR>       filterType = FType<BR>       filterData = FData<BR>       ssetObj.Select acSelectionSetAll, , , filterType, filterData<BR>       'AppActivate userform1.Caption<BR>       <BR>       Dim pickedObjs As AcadEntity<BR>       For Each pickedObjs In ssetObj<BR>                       pickedObjs.Highlight (True)<BR>       Next<BR>       ssetObj.Delete<BR>End Sub<BR>
页: [1]
查看完整版本: 总是出现方法作用于对象失败，有谁指点一二吧！