乐筑天下

搜索
欢迎各位开发者和用户入驻本平台 尊重版权,从我做起,拒绝盗版,拒绝倒卖 签到、发布资源、邀请好友注册,可以获得银币 请注意保管好自己的密码,避免账户资金被盗
查看: 99|回复: 5

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

[复制链接]

3

主题

9

帖子

2

银币

初来乍到

Rank: 1

铜币
21
发表于 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

bdinoeosp21.jpg

回复

使用道具 举报

158

主题

2315

帖子

10

银币

顶梁支柱

Rank: 50Rank: 50

铜币
2951
发表于 2004-2-24 12:01:00 | 显示全部楼层
1.ActiveDocument是否存在,也就是说是否有打开了的图形中界面中。
2.选择集的名称只能是唯一的,如果你运行了第一次,第二次再运行此程序时,本身图形中已经存在了该名称的选择集,就会出错。所以必须对该名称进行判断。
回复

使用道具 举报

41

主题

657

帖子

9

银币

中流砥柱

Rank: 25

铜币
821
发表于 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
回复

使用道具 举报

158

主题

2315

帖子

10

银币

顶梁支柱

Rank: 50Rank: 50

铜币
2951
发表于 2004-2-24 12:48:00 | 显示全部楼层
最简单的新建空白选择集的函数:
  1. Function CreatSSet() As AcadSelectionSet
  2.        On Error Resume Next
  3.        ThisDrawing.SelectionSets("mccad").Delete
  4.        Set CreatSSet = ThisDrawing.SelectionSets.Add("mccad")
  5. End Function
回复

使用道具 举报

3

主题

9

帖子

2

银币

初来乍到

Rank: 1

铜币
21
发表于 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工程的位置是不一样的,一直如此都未碰到问题。
回复

使用道具 举报

12

主题

135

帖子

5

银币

初露锋芒

Rank: 3Rank: 3Rank: 3

铜币
183
发表于 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
回复

使用道具 举报

发表回复

您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

  • 微信公众平台

  • 扫描访问手机版

  • 点击图片下载手机App

QQ|关于我们|小黑屋|乐筑天下 繁体中文

GMT+8, 2025-3-15 13:01 , Processed in 0.421086 second(s), 67 queries .

© 2020-2025 乐筑天下

联系客服 关注微信 帮助中心 下载APP 返回顶部 返回列表