正在检查块是否存在。。

Keith · 发表于 2008-3-10 10:10:38

Paul…让我看看我是否正确理解了你…a）你想知道一个块是否插入到图形中，b）你想填充一组文本框，如果是这样，使用Hendie提供的代码，sset1是保存AcadBlockReference的选择集。请记住，除非您绝对确定每个图形中只有一个该块的实例，否则该选择集中将有多个块
假设sset1中的图形中只有1个块

copy

If sset1.Count > 0 Then
   Set BlockX = sset1.Item(0)
   If BlockX.HasAttributes Then
      attribX = BlockX.GetAttributes
       For countz = LBound(attribX) To UBound(attribX)
           Select Case attribX(countz).TagString
               Case "FIX1"
                   fx1descTXT.text = attribX(countz).TextString
               Case "FIX2"
                   fx2descTXT.text = attribX(countz).TextString
               Case "FIX3"
                   fx3descTXT.text = attribX(countz).TextString
               Case "FIX4"
                   fx4descTXT.text = attribX(countz).TextString
               Case "FIX5"
                   fx5descTXT.text = attribX(countz).TextString
               Case "FIX6"
                   fx6descTXT.text = attribX(countz).TextString
               Case "FIX7"
                   fx7descTXT.text = attribX(countz).TextString
               Case "FIX8"
                   fx8descTXT.text = attribX(countz).TextString
               Case "FIX9"
                   fx9descTXT.text = attribX(countz).TextString
               Case "FIX10"
                   fx10descTXT.text = attribX(countz).TextString
               End Select
       Next 'End countx HasAttributes check loop..
   End If
End If

我希望这能把事情弄清楚

Keith · 发表于 2008-3-10 11:02:47

如果有#039；一个图形中有多个&#039；我需要将set BlockX和属性代码放入for next循环中。

Keith · 发表于 2008-3-10 13:34:11

大家干杯，让它像做梦一样工作。使用Hendie和039的组合；s和Keith#039；s代码，它的工作方式我需要它，但有#039；选择集总是有一件事，我陷入其中，永远记不起如何为其编码；检查集合是否首先存在的最佳方法和最简单方法；t完全不使用选择集，最后一个是很久以前的，所以可以&#039；我不记得我用过什么，但是，我&#039；我肯定我只是用了sset1。删除，但我可以#039；我不能让它工作，或者我把它放错地方了。。

Atook · 发表于 2008-3-10 14:07:16

我是这样做的。可能有更好和/或更优雅的方式…

copy

On Error Resume Next
Dim ss As AcadSelectionSet
Set ss = ThisDrawing.SelectionSets.Item("abcd")
If Err.Number  0 Then
    Set ss = ThisDrawing.SelectionSets.Add("abcd")
    Err.Clear
Else
    ss.Clear
End If

Atook · 发表于 2008-3-10 16:15:08

我可以&#039；我不记得我从哪里得到这个，它可能是来自另一个有RR的网站不久前…或者它可能是在其他地方

copy

Dim Mycollection As AcadSelectionSets
Dim SSet1 As AcadSelectionSet
' first check if any ss exist and if they do, delete them
        Set Mycollection = ThisDrawing.SelectionSets
             For Each SSet1 In Mycollection
                 If SSet1.Name = "MySS" Then
                     ThisDrawing.SelectionSets.Item("MySS").Delete
                     Exit For
                 End If
             Next

我通常将其放置在创建新选择集的零件之前

正在检查块是否存在。。

发表回复

精选推荐