Custom programming solutions, applications and training!

  Freeze Layer(s) in PaperSpace Viewport
Contract CADD Group - Phone: (604) 591-1140 Email:

Looking for CADD expertise? 
Looking for Web Solutions?   

Think Contract CADD Group!

Phone: (604) 591-1140
Toll Free: 1 866 433-2233

CORBIMITE Web Solutions
CORBIMITE Web Solutions

Code for freezing layer(s) in a PaperSpace Viewport (mview)

Creative Commons License
This work is licensed under a Creative Commons Attribution-ShareAlike 2.5 License.

Paste this code into the code window of a form.
Then on the form create a button and from the button call the sub


Option Explicit 

Public Sub selectVPobjectsToFreeze()

Dim objEntity As AcadObject
Dim strLayer As String
PT1 As Variant
Dim newSS As AcadSelectionSet
Dim vLayers() As Variant

On Error GoTo err_selectVPobjectsToFreeze


If ThisDrawing.ActiveSpace = acModelSpace Then
    MsgBox "This program only works with PaperSpace Viewports" & vbCr & _
    "Please go to PaperSpace", vbCritical
   Exit Sub
End If

ThisDrawing.MSpace = True
Set newSS = ThisDrawing.SelectionSets.Add("Vplayers")
ThisDrawing.Utility.Prompt ("Select Objects layers to freeze in the viewport:" & vbCr)

For Each objEntity In newSS
    strLayer = objEntity.Layer
    VpLayerOff (strLayer)



Exit Sub

MsgBox Err.Description, vbInformation
End Sub


Sub ViewPortUpdate()
' Update the viewport...
Dim objPViewport As AcadObject

Set objPViewport = ThisDrawing.ActivePViewport
ThisDrawing.MSpace =
objPViewport.Display (False)
objPViewport.Display (
ThisDrawing.MSpace =
ThisDrawing.Utility.Prompt ("Done!" & vbCr)
End Sub

Sub VpLayerOff(strLayer As String)
' make the layer non displayable (freeze) in the current Viewport
Dim objEntity As AcadObject
Dim objPViewport As AcadObject
Dim objPViewport2 As AcadObject
Dim XdataType As Variant
Dim XdataValue As Variant
Dim I As Integer
Counter As Integer
PT1 As Variant

' Get the active ViewPort
Set objPViewport = ThisDrawing.ActivePViewport

' Get the Xdata from the Viewport
objPViewport.GetXData "ACAD", XdataType, XdataValue

For I = LBound(XdataType) To UBound(XdataType)
   ' Look for frozen Layers in this viewport
   If XdataType(I) = 1003 Then
      ' Set the counter AFTER the position of the Layer frozen layer(s)
       Counter = I + 1
      ' If the layer is already in the frozen layers xdata of this viewport the
      ' exit this sub program

      If XdataValue(I) = strLayer Then Exit Sub

' If no frozen layers exist in this viewport then
' find the Xdata location 1002 and place the frozen layer infront of the "}"
' found at Xdata location 1002
Counter = 0 Then
For I = LBound(XdataType) To UBound(XdataType)
       If XdataType(I) = 1002 Then Counter = I - 1

' set the Xdata for the layer that is beeing frozen
XdataType(Counter) = 1003
XdataValue(Counter) = strLayer

ReDim Preserve XdataType(Counter + 1)
ReDim Preserve XdataValue(Counter + 1)

' put the first "}" back into the xdata array
XdataType(Counter + 1) = 1002
XdataValue(Counter + 1) = "}"

' Keep the xdata Array and add one more to the array
ReDim Preserve XdataType(Counter + 2)
ReDim Preserve XdataValue(Counter + 2)

' put the second "}" back into the xdata array
XdataType(Counter + 2) = 1002
XdataValue(Counter + 2) = "}"

' Reset the Xdata on to the viewport
objPViewport.SetXData XdataType, XdataValue

' notice that at this point NOTHING happens in the viewport to visibly show
' any changes to the viewport.
' flipping to a different layout or turning the Mview Off and On will display the
' Xdata changes to the viewport.
' See sub ViewPortUpdate for how to update the Viewport.

End Sub


CORBIMITE Web Solutions CORBIMITE Web Solutions CORBIMITE Web Solutions
CORBIMITE Web Solutions
CORBIMITE Web Solutions

CORBIMITE Web Solutions
Website created By Frank Zander
Phone: (604) 591-1140
Copyright 2006 
Contract CADD Group
All rights reserved.

Contract CADD Group is an Autodesk Developer Network member.

Please give us Feedback!
Send your comments and  suggestions to:
Frank Zander
Revised: May 03, 2009.

Back Back Top of Page