Get the Model Space scale factor

Hi,

I have a drawing with two viewports in Model space.

In one of the viewports the user zooms onto an object using any of the normal zoom functions. How can I, in VBA, get the final scale factor the user zoomed in to and then apply it to the second viewport so that the two viewports have the same zoom factor.

The second part would appear to be solved with:

ZoomScaled Zoomfactor, acZoomScaledRelative

but I can't seem to get the scale factor.

Does anyone have any ideas?

Perhaps the CustomScale property?

Tyke,

Divide the model space VIEWSIZE by the height of the paper space viewport

You will have to switch back and forth from paper space to model space to collect the data. -David

Each viewport holds somehow the scale it is probably part of a table list for each view port once you read it then its easy to copy this, its just simple lisp for drawing a mview replace the sc value with other mview scale value.

(setq sc (getstring "\nScale for this window 1: "))
(setq sc3 (strcat "1/" sc "xp"))
(command "_.zoom" "all")
(setq zc (getpoint "\nPoint to centre of view in Viewport:"))
(command "_.zoom" "_center" zc sc3)

I did a Entsel on a vport and looked up my lisp book (yeah real pages) and assoc etc

(setq obj (car (entsel "\npick vport boundary ")))
(setq tpp1 (entget obj))
(setq pt3 (cdr (assoc 40 tpp1))) ; Height
(setq pt4 (cdr (assoc 41 tpp1))) ; width
(setq pt5 (cdr (assoc 42 tpp1))) ; scale
(princ pt5)

Hope this helps

Some of my last reply is correct found that the variable "viewsize" changes depending on the viewport scale also found out how to work out scale.

Vport scale 1;50 (metric)

height of vport 418.645

viewsize 20.932

418.645/20.932 =20 1000/50 =20

Its a little harder for ft scales but can be worked out.

OK guys we have a partial solution. It copies the view in one viewport to the other, with the same view scale.

One quirk it still has is that the views in both viewports jump a quarter of the screen width to the left.

Sub CopyViewPort()
   
   Dim objViewPort As AcadViewport
   Dim objCurrentViewport As AcadViewport
   Dim vpCentre(0 To 1) As Double
   Dim dblViewSize As Double
   Dim dblCVPHeight As Double
   Dim dblCVPWidth As Double
   Dim dblCVPScale As Double
   
   Set objCurrentViewport = ThisDrawing.ActiveViewport
   
   Set objViewPort = ThisDrawing.ActiveViewport
   
   ' get centre of current viewport
   vpCentre(0) = ThisDrawing.GetVariable("ViewCtr")(0)
   vpCentre(1) = ThisDrawing.GetVariable("ViewCtr")(1)
   
   'get current vp scale
   dblCVPHeight = objCurrentViewport.Height
   dblCVPWidth = objCurrentViewport.Width
   dblCVPScale = dblCVPWidth / dblCVPHeight
   
   ' get sysvar ViewSize
   dblViewSize = ThisDrawing.GetVariable("ViewSize")
   
   For Each objViewPort In ThisDrawing.Viewports
       ThisDrawing.ActiveViewport = objViewPort
       objViewPort.Center = vpCentre
       objViewPort.Height = dblViewSize
       objViewPort.Width = dblViewSize * dblCVPScale
   Next
   
   ThisDrawing.ActiveViewport = objCurrentViewport
   
   ' regen in all viewports
   ThisDrawing.Regen acAllViewports
   
End Sub

Thanks for all of your help and I hope someone can make use of it.

Got the glitch sorted out.

By moving objViewPort.Center = vpCentre

to after

objViewPort.Height = dblViewSize

objViewPort.Width = dblViewSize * dblCVPScale

then we have no problems.

So the code snippet is now:

objViewPort.Height = dblViewSize

objViewPort.Width = dblViewSize * dblCVPScale

objViewPort.Center = vpCentre

Thanks again for your help.