• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 880
  • Last Modified:

vba or command-line for VPFreeze

I have tried th vplayer command but I cannot display a layer in the current viewport which is vpfrozen. I need to do this in VBA. A command-line equivalent would also do the job.
0
Saqib Husain, Syed
Asked:
Saqib Husain, Syed
  • 6
  • 2
1 Solution
 
borgunitCommented:
I have never actually used these but downloaded them a while back. Let us know.
Sub testVplayerOn()
'------------------------------------------------------------------------------
'Thaw layer in Pspace viewport
'
'
'------------------------------------------------------------------------------
Dim strLayer As String
Dim objPviewport As AcadPViewport
Dim pt1 As Variant
Dim strPrompt As String

On Error GoTo err_selectVPobjectsToFreeze

' set an undo mark in the drawing
ThisDrawing.StartUndoMark

If ThisDrawing.ActiveSpace = acModelSpace Then
    MsgBox "This program only works with PaperSpace Viewports" & vbCr & _
           "Please go to PaperSpace", vbCritical
    Exit Sub
End If
' let's get into Paper Space
ThisDrawing.MSpace = False

' Select a viewport
ThisDrawing.Utility.GetEntity objPviewport, pt1, "Select ViewPort:"

strPrompt = "Enter Layer Name to thaw in Veiw Port: "

' Ask the user for a layer to thaw in the Paperspace View port
strLayer = ThisDrawing.Utility.GetString(True, strPrompt)


' run the main program that does the grunt of the work
' yhea for vpLayer on!
VpLayerOn strLayer, objPviewport

' Place an end to the undo mark
ThisDrawing.EndUndoMark

' exit this sub
Exit Sub
' error handling
err_selectVPobjectsToFreeze:
MsgBox Err.description, vbInformation
Err.Clear
ThisDrawing.EndUndoMark

End Sub

' Next the VpLayerOn!

Sub VpLayerOn(strLayer As String, objPviewport As AcadPViewport)
    Dim XdataType As Variant
    Dim XdataValue As Variant
    Dim newXdataType As Variant
    Dim newXdataValue As Variant
    Dim i As Integer
    Dim counter As Integer
    Dim pt1 As Variant
    Dim varCenter As Variant
    Dim dblWidth As Double
    Dim dblHeight As Double
    Dim objViewPortNew As AcadPViewport

    ' 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
            ' Match the layer we are looking for and exit the sub --
            ' bingo we have the frozen layer location!
            If UCase(XdataValue(i)) = UCase(strLayer) Then Exit For
        End If
    Next

    ' Layer not found in this Mview
    If counter = 0 Then Exit Sub

    ' pull Width Height and Center from selected veiwport
    dblWidth = objPviewport.Width
    dblHeight = objPviewport.height
    varCenter = objPviewport.Center

    ' set the Xdata for the layer that is beeing frozen
    newXdataType = XdataType
    newXdataValue = XdataValue

    ' work throught the remaining array...
    For i = counter To UBound(XdataType)
        ReDim Preserve newXdataType(i - 1)
        ReDim Preserve newXdataValue(i - 1)
        newXdataType(i - 1) = XdataType(i)
        newXdataValue(i - 1) = XdataValue(i)

    Next

    'objViewPortNew.SetXData XdataType, XdataValue
    Set objViewPortNew = ThisDrawing.PaperSpace.AddPViewport(varCenter, dblWidth, dblHeight)
    ' Apply xdata to new Pviewport
    objViewPortNew.SetXData newXdataType, newXdataValue
    ' Put the new viewPort on the same layer as the original viewport
    objViewPortNew.layer = objPviewport.layer
    ' Refresh viewport!!
    ThisDrawing.MSpace = False
    objViewPortNew.Display (False)
    objViewPortNew.Display (True)
    ThisDrawing.Utility.Prompt ("Done!" & vbCr)

    ' Delete Old viewport
    objPviewport.Delete
End Sub

Open in new window

0
 
Saqib Husain, SyedEngineerAuthor Commented:
Hi borgunit

I had found this routine on the net with the difference that there it prompted for an object whose layer is to be thawn. I was in the process of modifying this routine when your solution came. I have to modify this as well because my drawing has a set of layers which have to be unfrozen in the viewport. This set is the layers NSL0001-1+250, PLV0001-1+250, TXT0001-1+250 having the right numerical portion same. I am sure this will be achievable. Thanks for the effort. Will close when I have successfully completed the modification.

Saqib
0
 
Saqib Husain, SyedEngineerAuthor Commented:
I do hve one observation on the code

in this part

    For i = counter To UBound(XdataType)
        ReDim Preserve newXdataType(i - 1)
        ReDim Preserve newXdataValue(i - 1)
        newXdataType(i - 1) = XdataType(i)
        newXdataValue(i - 1) = XdataValue(i)

    Next

I wonder why the redim statements are placed inside the loop. Would it not be better to place them befor the loop is entered?
0
Get expert help—faster!

Need expert help—fast? Use the Help Bell for personalized assistance getting answers to your important questions.

 
Saqib Husain, SyedEngineerAuthor Commented:
I tried to build my own routine getting a lead from the above snippet. I tried to modified the xdata for the existing viewport but it gave an error on the setxdata statement.

I then tried the above routine almost as-is where it creates a new layer with the same properties as the original layer. This allowed the setxdata to run through but then it made no change to the data because I added this statement below the setxdata line

    objViewPortNew.GetXData "ACAD",newXdataType, newXdataValue

and the change induced by the setxdata was not reflected back by the getxdata statement.

I am using Acad 2008
0
 
darrenmcwiCommented:
Did you still need assistance with this issue? Let us know and we'll try to help out.
0
 
Saqib Husain, SyedEngineerAuthor Commented:
I definitely do. I tried the routine and it did not work as mentioned in my last comment. I do understand it is not a neat solution and that it needs some sort of a refresh and I am unable to achieve it.

Saqib
0
 
darrenmcwiCommented:
Shouldn't be a problem. Make active, the viewport you want to control the layers in.

Then start the VPLAYER command.

Select the "R"eset option.

Enter the layer name you want to turn on and press ENTER.

Press ENTER two more times to exist the last two prompts and your layer should then be displayed.


Command: vplayer Enter an option [?/Freeze/Thaw/Reset/Newfrz/Vpvisdflt]: r
Enter layer name(s) to reset or <select objects>: layer1

Enter an option [All/Select/Current] <Current>:
Enter an option [?/Freeze/Thaw/Reset/Newfrz/Vpvisdflt]:

Open in new window

0
 
Saqib Husain, SyedEngineerAuthor Commented:
darrenmcwi,

I am sorry that I have not yet been able to test your solution. And that it is not fair to hold this any longer. So I am closing it and will come back if and when I test it.

Thanks

Saqib
0
 
Saqib Husain, SyedEngineerAuthor Commented:
Wow I thought I had closed this question. Sorry for that
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

Join & Write a Comment

Featured Post

Free Tool: Site Down Detector

Helpful to verify reports of your own downtime, or to double check a downed website you are trying to access.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

  • 6
  • 2
Tackle projects and never again get stuck behind a technical roadblock.
Join Now