选择MSpace Viewport中的所有可见实体
好的，我知道我应该记住这一个，不，我没有CADencoding存档（希望我有），但是…
如何选择在
mspace视口中可见的所有实体？这将选择dwg中具有REC_NUM属性的每个块。我需要
做什么
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
**** Hidden Message ***** 我找到了一个解决方案。
该代码是在欧特克论坛上找到的。
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
页:
[1]