smudgeco
08-06-2006, 12:55 PM
I'm sure I'm missing something fundamental here, but I'm doing my first VBA's. I've done a bit in VB, but I haven't worked with objects inside a program. I've hit a snag, and I can't seem to find what I'm looking for.
I want to cycle thru a drawing paperspace and find any viewports. Only one of them will be 1" high, so when the program hits that one, I want it to select that item. So far, most everything in the program works, except when it finds the item, I'm not using the right coding to get it to select that item for use. After I select the proper viewport, I want to make it the Active Viewport, then open it up, zoom to a certain set of coordinates, close the viewport and lock it.
I'm sure there's a sample of the selection process somewhere. I found this one:
Sub Check()
Dim Ent As AcadEntity
Dim i As Integer
For Each Ent In ThisDrawing.ModelSpace
Select Case Ent.ObjectName
Case "AcDbBlockReference"
MsgBox "Found a block"
Case "AcDbText"
MsgBox "Text Found"
End Select
Next
End Sub
It shows how to cycle thru the drawing, and lets you know when it finds something, but it doesn't tell how to select that item.
Here's what I have so far.
By this time, I'd gone thru several methods trying to select the item, so I don't know if this part is even coherent. I was grasping at straws by this time.
Sub ResetTitleBlock()
Dim VP As AcadObject
Dim AVP As AcadViewport
Dim SelSet As AcadSelectionSet
Dim strHeight As String
Dim dblHeight As Double
Dim Counter As Integer
' Make sure this drawing contains paper space viewports before continuing
If ThisDrawing.PaperSpace.Count = 0 Then
MsgBox "There are no paper space viewports in the current drawing."
Exit Sub
End If
Counter = 0
For Each VP In ThisDrawing.PaperSpace
If VP.ObjectName <> "AcDbViewport" Then GoTo Nexter
dblHeight = Round(VP.Height, 4)
Select Case dblHeight
Case 1.0625
'*************************BEGINNING SELECTION PROBLEM*******
MsgBox "FOUND"
' SelSet.Clear
SelSet.Select (acSelectionSetLast)
Counter = SelSet.Count
Set AVP = SelSet.Item(Counter - 1)
' Set AVP = VP
MsgBox AVP.ObjectName
'*********************END SELECTION PROBLEM***************
GoTo MoveAlong
Case Else
GoTo Nexter
End Select
Nexter:
Next
MoveAlong:
ThisDrawing.MSpace = True
ThisDrawing.ActiveViewport = AVP
ThisDrawing.SendCommand "ZOOM" & vbCr & "0,0" & vbCr & "4.4022,1.0625" & vbCr
ThisDrawing.MSpace = False
'AVP.DisplayLocked = True
'ThisDrawing.SendCommand "-VPORTS" & vbCr & "LOCK" & vbCr & "ON" & vbCr & "PREVIOUS" & vbCr
End Sub
Like I said, I'm sure I'm missing something fundamental. Some things work for viewports, and other things work for PViewports. I still gotta look into that stuff.
Any ideas would be greatly appreciated.
I want to cycle thru a drawing paperspace and find any viewports. Only one of them will be 1" high, so when the program hits that one, I want it to select that item. So far, most everything in the program works, except when it finds the item, I'm not using the right coding to get it to select that item for use. After I select the proper viewport, I want to make it the Active Viewport, then open it up, zoom to a certain set of coordinates, close the viewport and lock it.
I'm sure there's a sample of the selection process somewhere. I found this one:
Sub Check()
Dim Ent As AcadEntity
Dim i As Integer
For Each Ent In ThisDrawing.ModelSpace
Select Case Ent.ObjectName
Case "AcDbBlockReference"
MsgBox "Found a block"
Case "AcDbText"
MsgBox "Text Found"
End Select
Next
End Sub
It shows how to cycle thru the drawing, and lets you know when it finds something, but it doesn't tell how to select that item.
Here's what I have so far.
By this time, I'd gone thru several methods trying to select the item, so I don't know if this part is even coherent. I was grasping at straws by this time.
Sub ResetTitleBlock()
Dim VP As AcadObject
Dim AVP As AcadViewport
Dim SelSet As AcadSelectionSet
Dim strHeight As String
Dim dblHeight As Double
Dim Counter As Integer
' Make sure this drawing contains paper space viewports before continuing
If ThisDrawing.PaperSpace.Count = 0 Then
MsgBox "There are no paper space viewports in the current drawing."
Exit Sub
End If
Counter = 0
For Each VP In ThisDrawing.PaperSpace
If VP.ObjectName <> "AcDbViewport" Then GoTo Nexter
dblHeight = Round(VP.Height, 4)
Select Case dblHeight
Case 1.0625
'*************************BEGINNING SELECTION PROBLEM*******
MsgBox "FOUND"
' SelSet.Clear
SelSet.Select (acSelectionSetLast)
Counter = SelSet.Count
Set AVP = SelSet.Item(Counter - 1)
' Set AVP = VP
MsgBox AVP.ObjectName
'*********************END SELECTION PROBLEM***************
GoTo MoveAlong
Case Else
GoTo Nexter
End Select
Nexter:
Next
MoveAlong:
ThisDrawing.MSpace = True
ThisDrawing.ActiveViewport = AVP
ThisDrawing.SendCommand "ZOOM" & vbCr & "0,0" & vbCr & "4.4022,1.0625" & vbCr
ThisDrawing.MSpace = False
'AVP.DisplayLocked = True
'ThisDrawing.SendCommand "-VPORTS" & vbCr & "LOCK" & vbCr & "ON" & vbCr & "PREVIOUS" & vbCr
End Sub
Like I said, I'm sure I'm missing something fundamental. Some things work for viewports, and other things work for PViewports. I still gotta look into that stuff.
Any ideas would be greatly appreciated.