如何多选不同扩展属性的实体

storyst

 Dim ssetObj As AcadSelectionSet 
    Dim mode As Integer
    Dim gpCode(0) As Integer
    Dim dataValue(0) As Variant
    Dim groupCode As Variant
    Dim dataCode   As Variant
    Dim obj As AcadLWPolyline
   
    On Error Resume Next
    If Not IsNull(ThisDrawing.SelectionSets("SSET")) Then
      Set ssetObj = ThisDrawing.SelectionSets("SSET")
      ssetObj.Delete
    End If
    Set ssetObj = ThisDrawing.SelectionSets.Add("SSET")
   
    mode = acSelectionSetAll
    gpCode(0) = 1000
    groupCode = gpCode
    dataValue(0) = "600601"
    dataCode = dataValue
    ssetObj.Select mode, , , groupCode, dataCode
      If ssetObj.Count <> 0 Then
         For Each obj In ssetObj
           obj.color=acRed
           obj.Update
         Next
      End If
我还有一个扩展属性是600602，即 dataValue(0) = "600602"。如何同时进行选择修改，使600602颜色为其他颜色？

王咣生

对扩展属性作过滤选择只能通过应用程序名过滤，而不能通过具体属性值过滤选择!

storyst

Sub b()
    Dim ssetObj As AcadSelectionSet
    Dim Pkobj As AcadEntity
   
    Dim i As Integer
   
    Dim mode As Integer
    Dim xType(0) As Integer
    Dim xData(1) As Variant
   
    Dim xTypeCode As Variant
    Dim xDataCode As Variant
   
    Dim dataValue(0) As Variant
   
    Dim obj As AcadLWPolyline
 
    Dim ObjCode As String

    On Error Resume Next
    If Not IsNull(ThisDrawing.SelectionSets("SSET")) Then
      Set ssetObj = ThisDrawing.SelectionSets("SSET")
      ssetObj.Delete
    End If
    Set ssetObj = ThisDrawing.SelectionSets.Add("SSET")
    
  
    mode = acSelectionSetAll
    xType(0) = 1000
    xData(0) = "600601"
    xData(1) = "600602"
   
    On Error Resume Next
     For i = 0 To 1
         xTypeCode = xType
  
         dataValue(0) = xData(i)
         xDataCode = dataValue
   
         ssetObj.Select mode, , , xTypeCode, xDataCode
 
       For Each Pkobj In ssetObj
         
          ObjCode = xData(i)
         
          Set obj = Pkobj

      If ssetObj.Count =0 Then
        exit  sub
      else          
          Select Case ObjCode
              Case "600601"

                   obj.ConstantWidth = 1

              Case "600602"

                  obj.ConstantWidth = 0.5

          End Select
      End If
        obj.Update
    
        Next
   
      Next
   
     MsgBox "结束!", vbInformation, "提示"
    
  End If
 
End Sub

版主，上面的程序我进行了修改，可是最终运行后的结果是两种实体的ConstantWidth都是0.5，在执行了第一个循环后继续执行第二个循环，然后就会将第一个的运算值变成由第二个值来赋予。如何在执行第一个case循环后再执行第二个case的时候不执行第一个case啊？即第一个的600601的扩展属性的实体的ConstantWidth不会再变化呢？

王咣生

你这样作选择集是不能得到预期的结果的:

ssetObj.Select mode, , , xTypeCode, xDataCode

对于扩展属性只能通过应用程序名作选择集!!

storyst

对于扩展属性只能通过应用程序名作选择集这句话我不理解。不过，我已经弄好啦，还是谢谢版主。

雪山飞狐_lzh

除优化多段线外，扩展属性只能用1001码过滤