automatisch switchen tussen viewports

[nootie]

ik heb een stukje vba-code gevonden op internet om automatisch te switchen tussen 2 viewports. Het enige probleem is dat nooit switch, maar steeds in dezelfde viewport aan het werken ben. Weet iemand een antwoord op dit probleem?

Code Selecteer Uitklappen

Sub SetupFullSizeTab()
Dim objVPLeft As AcadPViewport
Dim objVPRight As AcadPViewport
Dim objEnt As AcadEntity
Dim objLayout As AcadLayout
Dim bTest As Boolean
Dim xL As Double
Dim xR As Double

ThisDrawing.SetVariable "CTAB", "FULL SIZE"
For Each objEnt In ThisDrawing.ActiveLayout.Block
'this test skips the first object in the layout which is always _
the PS Vport of the layout itself
If bTest = True Then
If TypeOf objEnt Is AcadPViewport Then
If objVPLeft Is Nothing Then
Set objVPLeft = objEnt
Else
Set objVPRight = objEnt
xL = objVPLeft.Center(0)
xR = objVPRight.Center(0)
If xL > xR Then
Set objVPRight = objVPLeft
Set objVPLeft = objEnt
Exit For
Else
Exit For
End If
End If
End If
Else
bTest = True
End If
Next

''do whatever with the 2 viewports now
objVPLeft.DisplayLocked = False
objVPLeft.Display True
ThisDrawing.MSpace = True
ThisDrawing.ActivePViewport = objVPLeft
ThisDrawing.Application.ZoomExtents
objVPLeft.StandardScale = acVpCustomScale
objVPLeft.CustomScale = 0.25 / 12#
objVPLeft.DisplayLocked = True
objVPRight.DisplayLocked = False

ThisDrawing.ActivePViewport = objVPRight
ThisDrawing.Application.ZoomExtents
objVPRight.StandardScale = acVpCustomScale
objVPRight.CustomScale = 0.25 / 12#
objVPRight.DisplayLocked = True
ThisDrawing.MSpace = False

End Sub

[sschevers]

Nootie,

Je switcht met deze code niet tussen de viewport. Wat er gebeurt is dat de schaal van de 2 die aanwezig zijn op je layout wordt ingesteld en dat je viewport wordt gelocked.

stephan

[nootie]

Ja inderdaad, maar via deze code zou je denken dat de schaal van beide viewports wordt aangepast. Want ze activeren eerst de linkerviewport en dan de rechterviewport. Maar als ik mijn code doorloop wordt nooit mijn schaal aangepast van mijn rechterviewport. Met andere woorden hij verandert enkel de schaal in de viewport waar ik het laatst heb in gewerkt.

[sschevers]

Nootie,

Ik heb net je code doorgelopen en bij mij  werkt het als een zonnetje. Zelfs als ik de code start als ik een viewport actie  heb wordt de schaal van beide viewports aangepast.

ik kan je helaas niet verder helpen omdat ik de fout niet kan reproduceren.

Code Selecteer Uitklappen


Option Explicit

Sub SetupFullSizeTab()
   Dim objVPLeft As AcadPViewport
   Dim objVPRight As AcadPViewport
   Dim objEnt As AcadEntity
   Dim objLayout As AcadLayout
   Dim bTest As Boolean
   Dim xL As Double
   Dim xR As Double
   
   

   ThisDrawing.SetVariable "CTAB", "FULL SIZE"
   For Each objEnt In ThisDrawing.ActiveLayout.Block
      'this test skips the first object in the layout which is always _
       the PS Vport of the layout itself
      If bTest = True Then
         If TypeOf objEnt Is AcadPViewport Then
            If objVPLeft Is Nothing Then
               Set objVPLeft = objEnt
            Else
               Set objVPRight = objEnt
               xL = objVPLeft.Center(0)
               xR = objVPRight.Center(0)
               If xL > xR Then
                  Set objVPRight = objVPLeft
                  Set objVPLeft = objEnt
                  Exit For
               Else
                  Exit For
               End If
            End If
         End If
      Else
         bTest = True
      End If
   Next

     
   ''do whatever with the 2 viewports now
   objVPLeft.DisplayLocked = False
   objVPLeft.Display True
   objVPLeft.StandardScale = acVpCustomScale
   objVPLeft.CustomScale = 1 / 100
   objVPLeft.DisplayLocked = True
   objVPRight.DisplayLocked = False

   objVPRight.StandardScale = acVpCustomScale
   objVPRight.CustomScale = 1 / 50
   objVPRight.DisplayLocked = True
   

End Sub


Ik heb het activeren van de viewports verwijderd. dit is namelijk niet nodig om de schaal aan te passen. Hopelijk kun je er wat mee

greetz stephan

[nootie]

Ok, ik zal dit eens proberen met een andere versie van Autocad. Mss lukt dit wel.

[nootie]

Ik heb dit nu uitgetest met een andere versie van Autocad, maar ook daar heb ik hetzelfde probleem.

Nu moet ik er wel bijvertellen dat ik bij deze zin: "ThisDrawing.SetVariable "CTAB", "FULL SIZE"" altijd een foutmelding verkrijgt. Hierdoor laat ik deze zin niet mee in de code draaien. Zou dit eventueel het probleem kunnen zijn.

Kunt u eventueel nog eens de code doorlopen zonder deze zin. Zodat we kunnen zien of het eventueel aan deze zin ligt.
Maar hoe komt het dat u wel deze zin kan doorlopen zonder foutmelding en ik niet?

[HofCAD]

Ik heb dit nu uitgetest met een andere versie van Autocad, maar ook daar heb ik hetzelfde probleem.

Nu moet ik er wel bijvertellen dat ik bij deze zin: "ThisDrawing.SetVariable "CTAB", "FULL SIZE"" altijd een foutmelding verkrijgt. Hierdoor laat ik deze zin niet mee in de code draaien. Zou dit eventueel het probleem kunnen zijn.

Kunt u eventueel nog eens de code doorlopen zonder deze zin. Zodat we kunnen zien of het eventueel aan deze zin ligt.
Maar hoe komt het dat u wel deze zin kan doorlopen zonder foutmelding en ik niet?

Beste Nootie,

CTAB, Returns the name of the current (model or layout) tab in the drawing.
Dus bij CTAB mag ingeven worden: Model en de Layoutnamen bijv. Layout1, Layout2
als deze bestaan.

Met vriendelijke groet, HofCAD CSI.

[nootie]

Probleem is opgelost.

Het probleem lag hem aan het vinden van de 2 viewporten. Ook al stonden er maar 2 op mijn paperspace, toch vond hij zogezegd nog altijd een andere viewport. Hierdoor wilde hij die éne viewport niet veranderen in schaal, maar met een klein stukje code erbij is het inmiddels wel gelukt om de 2 juiste viewports te vinden.


Alvast bedankt