添加所有多段线图形到一个集合出错

baneit319 · 发表于 2015-4-14 14:28:50

我在一个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

zzyong00 · 发表于 2015-4-14 22:10:27

你既然能输出myset.Count，为什么就不能输出更多的信息，看看都有什么？？
下面代码、加在你的代码后面

Dim obj As AcadObject
For Each obj In myset
Debug.Print obj.ObjectName
Next obj

zzyong00 · 发表于 2015-4-14 22:12:52

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[变体](变体数组); 仅用于输入; 可选项
过滤器的值。
--------------------
过滤选择研究下后面的两个参数，或者在本论坛的随意找一个相关的帖子，就能找到你想要的

baneit319 · 发表于 2015-4-18 10:10:29

zzyong00 发表于 2015-4-14 22:12
object.Select Mode[, Point1][, Point2][, FilterType][, FilterData]

Object

谢谢！不过我又出新问题了^_^
运行下面这段程序时，会出现“运行时错误，找不到主键”，我调试了发现是If  EndIf 这段出的错，我猜是找不到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

zzyong00 · 发表于 2015-4-18 19:28:18

baneit319 发表于 2015-4-18 10:10
谢谢！不过我又出新问题了^_^
运行下面这段程序时，会出现“运行时错误，找不到主键”，我调试了发现是 ...

你哪是抄的别人的代码吧，还不全，isnull这里是自定义函数吧？
还是看这里吧http://bbs.mjtd.com/thread-111783-1-1.html

baneit319 · 发表于 2015-4-19 12:09:50

zzyong00 发表于 2015-4-18 19:28
你哪是抄的别人的代码吧，还不全，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。

baneit319 · 发表于 2015-4-19 12:49:43

zzyong00 发表于 2015-4-18 19:28
你哪是抄的别人的代码吧，还不全，isnull这里是自定义函数吧？
还是看这里吧http://bbs.mjtd.com/thread ...

我找到了一个解决方法，在前面加了on error resume next 就行。但是我觉得这样不保险，我想另外找个方法，解决找不到selectionset.item("drawletter")的问题。

zzyong00 · 发表于 2015-4-19 14:27:42

本帖最后由 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")
if myset.Count=0 then exit sub
For Each obj In myset
Debug.Print obj.ObjectName
Next obj
myset.Item(0).Highlight True
End Sub

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") 
if  myset.Count=0 then exit sub 
  For Each obj In myset 
    Debug.Print obj.ObjectName 
  Next obj 
  myset.Item(0).Highlight True 
End Sub

baneit319 · 发表于 2015-4-19 19:13:50

谢谢，这个问题解决了

账号		自动登录	找回密码
密码			注册

添加所有多段线图形到一个集合出错

点评

点评