添加所有多段线图形到一个集合出错
我在一个dwg文件中只画了两个封闭的多段线图形，为什么运行下面这段话后msgbox显示是181，而不是2？图上只有2个，如果要只选中这两个多段线图形到集合，该怎么改？谢谢！Dim myset As AcadSelectionSet
ThisDrawing.SelectionSets("drawletter").Delete
Set myset = ThisDrawing.SelectionSets.Add("drawletter")
myset.Select acSelectionSetAll
MsgBox myset.Count
你既然能输出myset.Count，为什么 就不能输出更多的信息，看看都有什么 ？？
下面代码、加在你的代码后面
Dim obj As AcadObject
For Each obj In myset
Debug.Print obj.ObjectName
Next obj object.Select Mode[, Point1][, Point2][, FilterType][, FilterData]
Object
SelectionSet
使用该方法的对象。
Mode
AcSelect 常数; 仅用于输入
acSelectionSetWindow
acSelectionSetCrossing
acSelectionSetPrevious
acSelectionSetLast
acSelectionSetAll
Point1
Variant[变体] (双精度数组); 仅用于输入; 可选项
指定 Point1 的三维 WCS 坐标，或坐标数组。查看模式定义以正确使用 Point1。
Point2
Variant[变体] (三元素双精度数组); 仅用于输入; 可选项
指定 Point2 的三维 WCS 坐标。查看模式定义以正确使用 Point2。
FilterType
Variant[变体](整数数组); 仅用于输入; 可选项
指定使用的过滤器类型的 DXF 组码。
FilterData
Variant[变体](变体数组); 仅用于输入; 可选项
过滤器的值。
--------------------
过滤选择研究下后面的两个参数，或者在本论坛的随意找一个相关的帖子，就能找到你想要的 zzyong00 发表于 2015-4-14 22:12 static/image/common/back.gif
object.Select Mode[, Point1][, Point2][, FilterType][, FilterData]
Object
谢谢！不过我又出新问题了^_^
运行下面这段程序时，会出现“运行时错误，找不到主键”，我调试了发现是IfEndIf 这段出的错，我猜是找不到item("drawletter")这个集，因为如果我先添加上一个drawletter集后，运行这段话就不会有错误提示了。请教下怎么改比较好？
第二个问题，我发现下面这段话运行时把布局视图里的多段线也添加到drawletter里了，但是我是只想把绘图窗口里的多段线添加到drawletter里的，这个怎么办？
谢谢！
Sub kk()
Dim myset As AcadSelectionSet
Dim obj As AcadObject
Dim FilterType(0) As Integer
Dim FilterData(0) As Variant
If Not IsNull(ThisDrawing.SelectionSets.Item("drawletter")) Then
Set myset = ThisDrawing.SelectionSets.Item("drawletter")
myset.Delete
End If
Set myset = ThisDrawing.SelectionSets.Add("drawletter")
FilterType(0) = 0
FilterData(0) = "*POLYLINE"
myset.Select acSelectionSetAll, , , FilterType, FilterData
MsgBox myset.Count
For Each obj In myset
Debug.Print obj.ObjectName
Next obj
myset.Item(0).Highlight True
End Sub
baneit319 发表于 2015-4-18 10:10 static/image/common/back.gif
谢谢！不过我又出新问题了^_^
运行下面这段程序时，会出现“运行时错误，找不到主键”，我调试了发现是 ...
你哪是抄的别人的代码吧，还不全，isnull这里是自定义函数吧？
还是看这里吧http://bbs.mjtd.com/thread-111783-1-1.html zzyong00 发表于 2015-4-18 19:28 static/image/common/back.gif
你哪是抄的别人的代码吧，还不全，isnull这里是自定义函数吧？
还是看这里吧http://bbs.mjtd.com/thread ...
IsNull不是自定义的，我在help里查了，是有这个函数的，我以前的excel Vba 里用了也是有IsNull这个函数的。
应该不是错在 IsNull, 而是错在第一次运行时，找不到selectionsets.item("drawletter")这个。
下面是IsNull的用法
IsNull 函数
返回 Boolean 值，指出表达式是否不包含任何有效数据 (Null)。
语法
IsNull(expression)
必要的 expression 参数是一个 Variant，其中包含数值表达式或字符串表达式。
说明
如果 expression 为 Null，则 IsNull 返回 True；否则 IsNull 返回 False。如果 expression 由多个变量组成，则表达式的任何作为变量组成成分的 Null 都会使整个表达式返回 True。
Null 值指出 Variant 不包含有效数据。Null 与 Empty 不同，后者指出变量尚未初始化。Null 与长度为零的字符串 (““) 也不同，长度为零的字符串指的是空串。
重要 使用 IsNull 函数是为了确定表达式是否包含 Null 值的。在某些情况下，希望表达式取值为 True，比如希望 If Var = Null 和 If Var <> Null 取值为 True，而它们总取值为 False。这是因为任何包含 Null 的表达式本身就是 Null，所以为 False。
zzyong00 发表于 2015-4-18 19:28 static/image/common/back.gif
你哪是抄的别人的代码吧，还不全，isnull这里是自定义函数吧？
还是看这里吧http://bbs.mjtd.com/thread ...
我找到了一个解决方法，在前面加了on error resume next 就行。但是我觉得这样不保险，我想另外找个方法，解决找不到selectionset.item("drawletter")的问题。 本帖最后由 zzyong00 于 2015-4-19 14:32 编辑
Private Sub SelectLots(ByVal Ssetname As String, _
ByVal objName As String, _
Optional strPrompt As String = "请选择单行文本，可以框选" & vbCrLf)
'Ssetname 新建选择集的名
'objName 要选择对象的名，可以文字对象，也可以是直线或其它任何acad实体
'strPrompt 选择时提示的文字
Dim sSetObj As AcadSelectionSet, flag As Boolean
For Each sSetObj In ThisDrawing.SelectionSets
If sSetObj.name = Ssetname Then
flag = True
Exit For
End If
Next
If flag Then sSetObj.Delete '创建集合，如集存在，则删除，新建
Set sSetObj = ThisDrawing.SelectionSets.Add(Ssetname)
Dim gpCode(0) As Integer
Dim dataValue(0) As Variant
gpCode(0) = 0
dataValue(0) = objName
Dim groupCode As Variant, dataCode As Variant
groupCode = gpCode
dataCode = dataValue
ThisDrawing.Utility.Prompt strPrompt
sSetObj.SelectOnScreen groupCode, dataCode
End Sub
Sub kk()
Dim myset As AcadSelectionSet
Dim obj As AcadObject
SelectLots "drawletter", "*POLYLINE"
Set myset = ThisDrawing.SelectionSets("drawletter")
ifmyset.Count=0 then exit sub
For Each obj In myset
Debug.Print obj.ObjectName
Next obj
myset.Item(0).Highlight True
End Sub 谢谢，这个问题解决了
页:
[1]