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?
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
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
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.
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.
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
Ok, ik zal dit eens proberen met een andere versie van Autocad. Mss lukt dit wel.
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?
Citaat van: nootie op vr 28 05 2010, 08:45:44
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.
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