Topic: sometimes it works...sometimes it doesn't

[Matersammichman]

I'm befuzzled and bamboozled...sometimes this code works...sometimes it doesn't...any code corrections to make this function all the time would be greatly appreciated. TIA :ugly:


Private Sub cmdChangeVPortLayer_Click()
Dim vport As AcadPViewport
Dim oLayout As AcadLayout
Dim newLayer As AcadLayer
Set newLayer = ThisDrawing.Layers.Add("Viewport")
ThisDrawing.ActiveLayer = newLayer
ThisDrawing.ActiveLayer.Plottable = False
ThisDrawing.ActiveLayer.color = acGreen
Me.hide

'On Error Resume Next
For Each oLayout In ThisDrawing.Layouts
  If oLayout.Name <> "Model" Then
    For Each vport In oLayout.Block
      'change the vports to reside on layer "Viewport"
        If vport.Layer <> "Viewport" Then
      vport.Layer = "Viewport"

Else
End If
Next 'choke
End If
Next
End Sub

[Glenn R]

One thing a lot of people don't know, is that PAPERSPACE ITSELF IS A VIEWPORT...

[Keith™]

It looks like it "should" work, but of course you could also enumerate the PS objects or create a selection set of all viewport objects in paperspace. One thing that may be at issue is irregular shape viewports. Programmatically, they are viewports masked by closed polygons or circles, and may not be recognized.

[Bryco]

I seem to remember that Glenn bloke helping me with the same question.
The paperspace viewport is always made before the individual vps so you can use it's id.

Code: [Select]

Public Sub PViewportsLayer(pLayout As AcadLayout)
     Dim pEnt As AcadEntity, id As Long
     For Each pEnt In pLayout.Block
        If TypeOf pEnt Is AcadPViewport Then
            If id = 0 Then
                id = pEnt.ObjectID
            Else
                If pEnt.ObjectID > id Then
                   pEnt.Layer = "Viewport"
                End If
            End If
        End If
    Next
    Set pEnt = Nothing
    Set pLayout = Nothing
End Sub

Sub Thang()
    Dim l As AcadLayout
    ThisDrawing.LAYERS.Add ("Viewport")
    For Each l In ThisDrawing.Layouts
        If l.ModelType = False Then
            PViewportsLayer l
        End If
    Next
End Sub

[Cathy]

    For Each vport In oLayout.Block

I know it looks like this will just iterate through the viewports in the block, but it iterates through every single thing in the block, lines, polylines, block references, you name it.   If something in the block is not a AcadPViewport you will probably get a error 13, type mismatch.   

[Matersammichman]

Bryco,
Can't get it to work. I want it to be called up on command (under a cmb) not as a sub. Can you advise?
Can anyone else further this?

[Bryco]

Not quite sure what you mean but if you are running it from a form just change the name from sub Thang to Private Sub cmdChangeVPortLayer_Click() and it should be fine. Since the Public Sub PViewportsLayer is public it can be in the form or in a module.

[Matersammichman]

Nope. Still doesn't work in ADT2005. :realmad:

[Bryco]

Does it give you an error?
I dont have adt
what exactly does "I want it to be called up on command " mean.