Topic: Select All visible entities in MSpace Viewport

[ChuckHardin]

Ok I know I should remember this one and NO i don't
have the CADencoding archive (wish I did) but...


How do you select all the entities that are visible in
the mspace viewport? This selects every block with
the REC_NUM attribute in the dwg. What do I need
to do?

Code: [Select]

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



[ChuckHardin]

I found a solution.
The code was found on the Autodesk forum.

Code: [Select]

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