?
Solved

vba or command-line for VPFreeze

Posted on 2009-12-20
9
Medium Priority
?
834 Views
Last Modified: 2013-12-04
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
Comment
Question by:Saqib Husain, Syed
  • 6
  • 2
9 Comments
 
LVL 10

Expert Comment

by:borgunit
ID: 26095471
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
 
LVL 43

Author Comment

by:Saqib Husain, Syed
ID: 26095592
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
 
LVL 43

Author Comment

by:Saqib Husain, Syed
ID: 26095600
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
New feature and membership benefit!

New feature! Upgrade and increase expert visibility of your issues with Priority Questions.

 
LVL 43

Author Comment

by:Saqib Husain, Syed
ID: 26098896
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
 
LVL 11

Expert Comment

by:darrenmcwi
ID: 26474490
Did you still need assistance with this issue? Let us know and we'll try to help out.
0
 
LVL 43

Author Comment

by:Saqib Husain, Syed
ID: 26474820
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
 
LVL 11

Accepted Solution

by:
darrenmcwi earned 2000 total points
ID: 26480848
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
 
LVL 43

Author Comment

by:Saqib Husain, Syed
ID: 27597747
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
 
LVL 43

Author Comment

by:Saqib Husain, Syed
ID: 27879710
Wow I thought I had closed this question. Sorry for that
0

Featured Post

New feature and membership benefit!

New feature! Upgrade and increase expert visibility of your issues with Priority Questions.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

If, like me, you find yourself repeatedly and tediously joining many segments (lines, arcs) in other people's drawings back into polylines that can be used more effectively in Computer Aided Machining and Laser Cutting, then this article is for you!…
In this article, we will see the basic design consideration while designing a Multi-tenant web application in a simple manner. Though, many frameworks are available in the market to develop a multi - tenant application, but do they provide data, cod…
This Micro Tutorial will teach you how to add a cinematic look to any film or video out there. There are very few simple steps that you will follow to do so. This will be demonstrated using Adobe Premiere Pro CS6.
We’ve all felt that sense of false security before—locking down external access to a database or component and feeling like we’ve done all we need to do to secure company data. But that feeling is fleeting. Attacks these days can happen in many w…
Suggested Courses

850 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question