添加所有多段线图形到一个集合出错
我在一个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[变体](变体数组); 仅用于输入; 可选项
过滤器的值。
--------------------
过滤选择研究下后面的两个参数,或者在本论坛的随意找一个相关的帖子,就能找到你想要的
谢谢!不过我又出新问题了^_^
运行下面这段程序时,会出现“运行时错误,找不到主键”,我调试了发现是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
你哪是抄的别人的代码吧,还不全,isnull这里是自定义函数吧?
还是看这里吧
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 VarNull 取值为 True,而它们总取值为 False。这是因为任何包含 Null 的表达式本身就是 Null,所以为 False。
我找到了一个解决方法,在前面加了on error resume next 就行。但是我觉得这样不保险,我想另外找个方法,解决找不到selectionset.item("drawletter")的问题。
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]