[VBA程序]：一个关于选择集的问题

左权

请问那位大哥大姐知道怎么样将一个选中的多边形，根据它的顶点来建立一个不规则的选择集？？？*-*a 晕啊，请那位大哥行行好嘛，给我一个代码啊！！！兄弟真的急用啊！！！！！！！！

雪山飞狐(lzh)

找找以前的帖子

左权

我想要一段源代码。太急了.

gdzhou

sset1.SelectByPolygon acSelectionSetFence, pt, ft, fd
pt  是三维点数组

wjue311

干测绘的吧？
支持4楼的

左权

谢谢楼上的兄弟!!!

laoxie_1983

我刚好弄了个
On Error Resume Next
   Dim xzj As AcadSelectionSet
   If Not IsNull(ThisDrawing.SelectionSets.Item("st")) Then
     Set xzj = ThisDrawing.SelectionSets.Item("st")
     xzj.Delete
     End If
  Set xzj = ThisDrawing.SelectionSets.Add("st") '新建选择集
  'MsgBox xzj.Name
  xzj.Select acSelectionSetAll, , , ftype, fdata '选择街坊线
  Dim ty As AcadEntity
  For Each ty In xzj
  dds = (UBound(ty.Coordinates) + 1) / 2
  zb = ty.Coordinates
  jfmj = ty.Area
    ReDim ddzb(dds * 3 - 1)
    ReDim sjzb(dds - 1, 1)
    For i = 0 To dds - 1
    'MsgBox ty.Coordinates(2 * i)
    ddzb(3 * i) = zb(2 * i)
    ddzb(3 * i + 1) = zb(2 * i + 1)
    ddzb(3 * i + 2) = 0
    sjzb(i, 0) = zb(2 * i)
    sjzb(i, 1) = zb(2 * i + 1)
    Next i
   
    Dim zjxzj As AcadSelectionSet
   If Not IsNull(ThisDrawing.SelectionSets.Item("zjst")) Then
     Set zjxzj = ThisDrawing.SelectionSets.Item("zjst")
     zjxzj.Delete
     End If
  Set zjxzj = ThisDrawing.SelectionSets.Add("zjst") '新建选择集
jfh = tqjfh(ddzb)

Function tqjfh(xxzb) As String '提取街坊号
'On Error Resume Next
  Dim zjxzj As AcadSelectionSet
     If Not IsNull(ThisDrawing.SelectionSets.Item("zjst")) Then
     Set zjxzj = ThisDrawing.SelectionSets.Item("zjst")
     zjxzj.Delete
     End If
  Set zjxzj = ThisDrawing.SelectionSets.Add("zjst") '新建选择集
  ReDim gpCode(0 To 1) As Integer
    gpCode(0) = 0
    gpCode(1) = 8
    ReDim dataValue(0 To 1) As Variant
    dataValue(0) = "MTEXT"
    dataValue(1) = "街坊注记"
   
    Dim groupCode As Variant, dataCode As Variant
    groupCode = gpCode
    dataCode = dataValue
   
    zjxzj.SelectByPolygon acSelectionSetWindowPolygon, xxzb, groupCode, dataCode
    'zjxzj.SelectByPolygon acSelectionSetWindowPolygon, pointsArray, groupCode, dataCode
  jfh = "320506" + zjxzj.Item(0).TextString '
  If jfh = "" Then
     MsgBox "没有选中街坊号"
     End
  End If
  
  '以上提取街坊坐标和街坊号
tqjfh = jfh
End Function

yzg822

最好的途径还是看一下帮助吧，注意acSelectionSetWindowPolygon 与acSelectionSetWindowPolygon的区别。