选择MSpace Viewport中的所有可见实体

Public Sub TestThis()
Dim intcnt As Integer
Dim objSelSet As AcadSelectionSet
Dim varData(0 To 1) As Variant
Dim intType(0 To 1) As Integer
Dim objEnt As AcadEntity
Dim strRecNumbers As String
Dim varRecNum As Variant
Dim objBlkRef As AcadBlockReference
Dim varPnt As Variant
 ThisDrawing.MSpace = True
 intType(0) = 0: varData(0) = "INSERT"
 intType(1) = 2: varData(1) = BlockAttributeFilter("REC_NUM")
 Set objSelSet = ThisDrawing.PickfirstSelectionSet
 objSelSet.Select Mode:=acSelectionSetAll, FilterType:=intType, FilterData:=varData
''Try this if all else fails
' dblLL(0) = varLowerLeft(0) - 100
' dblLL(1) = varLowerLeft(1) - 100
'
' dblUR(0) = varUpperRight(0) + 100
' dblUR(1) = varUpperRight(1) + 100
'
' objSelSet.Select acSelectionSetWindow, dblLL, dblUR, intType, varData
 For Each objEnt In objSelSet
      If TypeOf objEnt Is AcadBlockReference Then
           Set objBlkRef = objEnt
           strRecNumbers = IIf(strRecNumbers = "", AttString(objBlkRef, "REC_NUM"), strRecNumbers & "|" & AttString(objBlkRef, "REC_NUM"))
      End If
 Next
 
 varRecNum = Split(strRecNumbers, "|")
 
 ThisDrawing.MSpace = False
 
 'Now create the pole list with framing and locations
 'Do a SQL for each Rec_Num|Pri_Unit|Location
 For intcnt = LBound(varRecNum) To UBound(varRecNum)
      Debug.Print varRecNum(intcnt)
 Next
End Sub
Public Function BlockAttributeFilter(strAttTag As String) As String
Dim objBlk As AcadBlock
Dim strFilter As String
Dim objBlkEnt As AcadEntity
Dim objAtt As AcadAttribute
 For Each objBlk In ThisDrawing.Blocks
      If Left(objBlk.Name, 1)  "*" Then
      For Each objBlkEnt In objBlk
           If TypeOf objBlkEnt Is AcadAttribute Then
                Set objAtt = objBlkEnt
                If objAtt.TagString = strAttTag Then
                     strFilter = IIf(strFilter = "", objBlk.Name, strFilter & "," & objBlk.Name)
                End If
           End If
      Next objBlkEnt
      End If
 Next objBlk
 BlockAttributeFilter = strFilter
End Function

Public Sub TestThis()
Dim intcnt As Integer
Dim objSelSet As AcadSelectionSet
Dim varData(0 To 1) As Variant
Dim intType(0 To 1) As Integer
Dim objEnt As AcadEntity
Dim strRecNumbers As String
Dim varRecNum As Variant
Dim objBlkRef As AcadBlockReference
Dim varPnt As Variant
Dim dblLL(0 To 2) As Double
Dim dblUR(0 To 2) As Double
Dim varLowerLeft As Variant
Dim varUpperRight As Variant
 
 ThisDrawing.MSpace = True
 intType(0) = 0: varData(0) = "INSERT"
 intType(1) = 2: varData(1) = BlockAttributeFilter("REC_NUM")
 If MSpaceWindow(varLowerLeft, varUpperRight) = True Then
      dblLL(0) = varLowerLeft(0)
      dblLL(1) = varLowerLeft(1)
      dblUR(0) = varUpperRight(0)
      dblUR(1) = varUpperRight(1)
      'Select the blocks
      Set objSelSet = ThisDrawing.PickfirstSelectionSet
      objSelSet.Select acSelectionSetWindow, dblLL, dblUR, intType, varData
      'Loop through them for the Rec_Num
      For Each objEnt In objSelSet
           If TypeOf objEnt Is AcadBlockReference Then
                Set objBlkRef = objEnt
                strRecNumbers = IIf(strRecNumbers = "", AttString(objBlkRef, "REC_NUM"), strRecNumbers & "|" & AttString(objBlkRef, "REC_NUM"))
           End If
      Next
      'Split for easy stepping
      varRecNum = Split(strRecNumbers, "|")
      'Now create the pole list with framing and locations
      'Do a SQL for each Rec_Num|Pri_Unit|Location
      For intcnt = LBound(varRecNum) To UBound(varRecNum)
           Debug.Print varRecNum(intcnt)
      Next
 End If
 
 ThisDrawing.MSpace = False
End Sub
'//*****************************//'
'//****Code from Autodesk Forum*****//'
'//*****************************//'
Public Function MSpaceWindow(varLowerLeft As Variant, varUpperRight As Variant) As Boolean
Dim varCenter As Variant
Dim dblHeight As Double
Dim dblWidth As Double
Dim varMinp As Variant
Dim varMaxp As Variant
Dim dblVPHeight As Double
Dim dblVPWidth As Double
On Error GoTo Err_Control
 ThisDrawing.MSpace = True
 ThisDrawing.SetVariable "CVPORT", 2
 
 'view center in WCS
 varCenter = ThisDrawing.GetVariable("VIEWCTR")
 
 'convert in to DCS
 varCenter = ThisDrawing.Utility.TranslateCoordinates(varCenter, acWorld, acDisplayDCS, 0)
 
 'height of the viewport in DCS
 dblHeight = ThisDrawing.GetVariable("VIEWSIZE")
 varMinp = varCenter: varMaxp = varCenter
 
 'calculate the width of the viewport in DCS
 dblVPHeight = ThisDrawing.ActivePViewport.Height
 dblVPWidth = ThisDrawing.ActivePViewport.Width
 dblWidth = dblVPWidth * dblHeight / dblVPHeight 
 'calculate bounding view boundary in DCS
 varMinp(0) = varCenter(0) - dblWidth / 2
 varMinp(1) = varCenter(1) - dblHeight / 2
 
 varMaxp(0) = varCenter(0) + dblWidth / 2
 varMaxp(1) = varCenter(1) + dblHeight / 2
 
 varMinp = ThisDrawing.Utility.TranslateCoordinates(varMinp, acDisplayDCS, acWorld, 0)
 varMaxp = ThisDrawing.Utility.TranslateCoordinates(varMaxp, acDisplayDCS, acWorld, 0)
 
 'Set the Returns 
 varLowerLeft = varMinp
 varUpperRight = varMaxp
 
 MSpaceWindow = True
Exit_Here:
 Exit Function
  
Err_Control:
 Select Case Err.Number
      Case Else
           MsgBox Err.Description
           MSpaceWindow = False
           Resume Exit_Here
 End Select
End Function